
### Class GateAROS: Create an AROS gatestub file ##############################

BEGIN {
    package GateAROS;
    use vars qw(@ISA);
    @ISA = qw( Gate );

    sub new {
	my $proto  = shift;
	my $class  = ref($proto) || $proto;
	my $self   = $class->SUPER::new( @_ );
	bless ($self, $class);
	return $self;
    }

    sub header {
	my $self = shift;
	my $sfd  = $self->{SFD};
	
	$self->SUPER::header (@_);

	print "#include <aros/libcall.h>\n";
	print "\n";
    }

    sub function {
	my $self     = shift;
	my %params    = @_;
	my $prototype = $params{'prototype'};
	my $sfd       = $self->{SFD};

	if ($prototype->{type} eq 'cfunction') {
	    print "#define $gateprefix$prototype->{funcname} " .
		"AROS_SLIB_ENTRY(" .
		"$gateprefix$prototype->{funcname},$sfd->{Basename},".
		($prototype->{bias}/6).")\n\n";
	}

	$self->SUPER::function (@_);
    }
	
    sub function_start {
	my $self      = shift;
	my %params    = @_;
	my $prototype = $params{'prototype'};
	my $sfd       = $self->{SFD};
	my $nb        = $prototype->{nb} || $libarg eq 'none';

	# AROS macros cannot handle function pointer arguments :-(

	for my $i (0 .. $prototype->{numargs} - 1) {
	    if ($prototype->{argtypes}[$i] =~ /\(\*\)/) {
		my $typedef  = $prototype->{argtypes}[$i];
		my $typename = "$sfd->{Basename}_$prototype->{funcname}_fp$i";

		$typedef =~ s/\(\*\)/(*_$typename)/;
		    
		print "typedef $typedef;\n";
	    }
	}

	if ($self->{PROTO}) {
	    printf "AROS_LD%d%s(", $prototype->{numargs}, $nb ? "I" : "";
	}
	else {
	    printf "AROS_LH%d%s(", $prototype->{numargs}, $nb ? "I" : "";
	}
	print "$prototype->{return}, $gateprefix$prototype->{funcname},\n";
    }

    sub function_arg {
	my $self      = shift;
	my %params    = @_;
	my $prototype = $params{'prototype'};
	my $argtype   = $params{'argtype'};
	my $argname   = $params{'argname'};
	my $argreg    = $params{'argreg'};
	my $argnum    = $params{'argnum'};
	my $sfd       = $self->{SFD};

	if ($argtype =~ /\(\*\)/) {
	    $argtype = "_$sfd->{Basename}_$prototype->{funcname}_fp$argnum";
	}

	if ($self->{PROTO}) {
	    print "	AROS_LDA($argtype, $argname, " . (uc $argreg) . "),\n";
	}
	else {
	    print "	AROS_LHA($argtype, $argname, " . (uc $argreg) . "),\n";
	}	    
    }
    
    sub function_end {
	my $self      = shift;
	my %params    = @_;
	my $prototype = $params{'prototype'};
	my $sfd       = $self->{SFD};

	my $bt = "/* bt */";
	my $bn = "/* bn */";

	if ($prototype->{nb}) {
	    for my $i (0 .. $#{$prototype->{regs}}) {
		if ($prototype->{regs}[$i] eq 'a6') {
		    $bt = $prototype->{argtypes}[$i];
		    $bn  =$prototype->{___argnames}[$i];
		    last;
		}
	    }
	}
	else {
	    $bt = $sfd->{basetype};
	    $bn = "_base";
	}

	printf "	$bt, $bn, %d, $sfd->{Basename})",
	$prototype->{bias} / 6;

	if ($self->{PROTO}) {
	    print ";\n";
	    print "#define $gateprefix$prototype->{funcname} " .
		"AROS_SLIB_ENTRY(" .
		"$gateprefix$prototype->{funcname},$sfd->{Basename},".($prototype->{bias}/6).")\n";
	}
	else {
	    print "\n";
	    print "{\n";
	    print "  AROS_LIBFUNC_INIT\n";
	    print "  return $libprefix$prototype->{funcname}(";

	    if ($libarg eq 'first' && !$prototype->{nb}) {
		print "_base";
		print $prototype->{numargs} > 0 ? ", " : "";
	    }

	    print join (', ', @{$prototype->{___argnames}});
	
	    if ($libarg eq 'last' && !$prototype->{nb}) {
		print $prototype->{numargs} > 0 ? ", " : "";
		print "_base";
	    }
	
	    print ");\n";
	    print "  AROS_LIBFUNC_EXIT\n";
	    print "}\n";
	}
    }
}
