tools/sfdc/Gate68k.pl

   1
   2 ### Class Gate68k: Create a AmigaOS gatestub file #############################
   3
   4 BEGIN {
   5     package Gate68k;
   6     use vars qw(@ISA);
   7     @ISA = qw( Gate );
   8
   9     sub new {
  10         my $proto  = shift;
  11         my $class  = ref($proto) || $proto;
  12         my $self   = $class->SUPER::new( @_ );
  13         bless ($self, $class);
  14         return $self;
  15     }
  16
  17     sub function_start {
  18         my $self      = shift;
  19         my %params    = @_;
  20         my $prototype = $params{'prototype'};
  21         my $sfd       = $self->{SFD};
  22
  23         print "$prototype->{return}\n";
  24         print "$gateprefix$prototype->{funcname}(";
  25     }
  26
  27     sub function_arg {
  28         my $self      = shift;
  29         my %params    = @_;
  30         my $prototype = $params{'prototype'};
  31         my $argtype   = $params{'argtype'};
  32         my $argname   = $params{'argname'};
  33         my $argreg    = $params{'argreg'};
  34         my $argnum    = $params{'argnum'};
  35         my $sfd       = $self->{SFD};
  36
  37         if ($argnum != 0) {
  38             print ",\n";
  39         }
  40
  41         print " $prototype->{___args}[$argnum] __asm(\"$argreg\")";
  42     }
  43
  44     sub function_end {
  45         my $self      = shift;
  46         my %params    = @_;
  47         my $prototype = $params{'prototype'};
  48         my $sfd       = $self->{SFD};
  49
  50         if ($libarg ne 'none' && !$prototype->{nb}) {
  51             if ($prototype->{numargs} > 0 ) {
  52                 print ",\n";
  53             }
  54
  55             print "     $sfd->{basetype} _base __asm(\"a6\")";
  56         }
  57         elsif ($prototype->{numargs} == 0) {
  58             print "void";
  59         }
  60
  61         if ($self->{PROTO}) {
  62             print ");\n";
  63         }
  64         else {
  65             print ")\n";
  66             print "{\n";
  67
  68             print "  return $libprefix$prototype->{funcname}(";
  69
  70             if ($libarg eq 'first' && !$prototype->{nb}) {
  71                 print "_base";
  72                 print $prototype->{numargs} > 0 ? ", " : "";
  73             }
  74
  75             print join (', ', @{$prototype->{___argnames}});
  76
  77             if ($libarg eq 'last' && !$prototype->{nb}) {
  78                 print $prototype->{numargs} > 0 ? ", " : "";
  79                 print "_base";
  80             }
  81
  82             print ");\n";
  83             print "}\n";
  84         }
  85     }
  86 }