tools/sfdc/GateMOS.pl

   1
   2 ### Class GateMOS: Create a MorphOS gatestub file #############################
   3
   4 BEGIN {
   5     package GateMOS;
   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 header {
  18         my $self = shift;
  19
  20         $self->SUPER::header (@_);
  21
  22         print "#include <emul/emulregs.h>\n";
  23         print "\n";
  24     }
  25
  26     sub function_start {
  27         my $self      = shift;
  28         my %params    = @_;
  29         my $prototype = $params{'prototype'};
  30         my $sfd       = $self->{SFD};
  31
  32         print "$prototype->{return}\n";
  33         print "$gateprefix$prototype->{funcname}(void)";
  34
  35         if ($self->{PROTO}) {
  36             print ";\n";
  37         }
  38         else {
  39             print "\n";
  40             print "{\n";
  41         }
  42     }
  43
  44     sub function_arg {
  45         my $self      = shift;
  46
  47         if (!$self->{PROTO}) {
  48             my %params    = @_;
  49             my $prototype = $params{'prototype'};
  50             my $argtype   = $params{'argtype'};
  51             my $argname   = $params{'argname'};
  52             my $argreg    = $params{'argreg'};
  53             my $argnum    = $params{'argnum'};
  54             my $sfd       = $self->{SFD};
  55
  56             print "  $prototype->{___args}[$argnum] = ($argtype) REG_" .
  57                 (uc $argreg) . ";\n";
  58         }
  59     }
  60
  61     sub function_end {
  62         my $self      = shift;
  63
  64         if (!$self->{PROTO}) {
  65             my %params    = @_;
  66             my $prototype = $params{'prototype'};
  67             my $sfd       = $self->{SFD};
  68
  69             if ($libarg ne 'none' && !$prototype->{nb}) {
  70                 print "  $sfd->{basetype} _base = ($sfd->{basetype}) ".
  71                     "REG_A6;\n";
  72             }
  73
  74             print "  return $libprefix$prototype->{funcname}(";
  75
  76             if ($libarg eq 'first' && !$prototype->{nb}) {
  77                 print "_base";
  78                 print $prototype->{numargs} > 0 ? ", " : "";
  79             }
  80
  81             print join (', ', @{$prototype->{___argnames}});
  82
  83             if ($libarg eq 'last' && !$prototype->{nb}) {
  84                 print $prototype->{numargs} > 0 ? ", " : "";
  85                 print "_base";
  86             }
  87
  88             print ");\n";
  89             print "}\n";
  90         }
  91     }
  92 }