tools/sfdc/Stub68k.pl

   1
   2 ### Class Stub68k: Create a 68k stub file #####################################
   3
   4 BEGIN {
   5     package Stub68k;
   6     use vars qw(@ISA);
   7     @ISA = qw( Stub );
   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         if ($prototype->{type} eq 'function') {
  24             print "\n";
  25             print "{\n";
  26
  27             if (!$prototype->{nb}) {
  28                 print "  BASE_EXT_DECL\n";
  29             }
  30             if (!$prototype->{nr}) {
  31                 print "  register $prototype->{return} _res __asm(\"d0\");\n";
  32             }
  33             if (!$prototype->{nb}) {
  34                 print "  register $sfd->{basetype} _base __asm(\"a6\") " .
  35                     "= BASE_NAME;\n";
  36             }
  37         }
  38         else {
  39             $self->SUPER::function_start (@_);
  40         }
  41     }
  42
  43     sub function_arg {
  44         my $self      = shift;
  45         my %params    = @_;
  46         my $prototype = $params{'prototype'};
  47         my $argtype   = $params{'argtype'};
  48         my $argname   = $params{'argname'};
  49         my $argreg    = $params{'argreg'};
  50         my $argnum    = $params{'argnum'};
  51         my $sfd       = $self->{SFD};
  52
  53         if ($$prototype{'type'} eq 'function') {
  54             if ($argreg eq 'a4' || $argreg eq 'a5') {
  55                 $argreg = 'd7';
  56             }
  57
  58             print "  register $prototype->{args}[$argnum] __asm(\"$argreg\") " .
  59                 "= $argname;\n";
  60         }
  61         else {
  62             $self->SUPER::function_arg (@_);
  63         }
  64     }
  65
  66     sub function_end {
  67         my $self      = shift;
  68         my %params    = @_;
  69         my $prototype = $params{'prototype'};
  70         my $sfd       = $self->{SFD};
  71
  72
  73         if ($$prototype{'type'} eq 'function') {
  74             my $regs      = join(',', @{$$prototype{'regs'}});
  75             my $a4        = $regs =~ /a4/;
  76             my $a5        = $regs =~ /a5/;
  77
  78             if ($a4 && $a5 && !$quiet) {
  79                 print STDERR "$$prototype{'funcname'} uses both a4 and a5 " .
  80                     "for arguments. This is not going to work.\n";
  81             }
  82
  83             if ($a4) {
  84                 print "  __asm volatile (\"exg d7,a4\\n\\tjsr a6@(-" .
  85                     "$prototype->{bias}:W)\\n\\texg d7,a4\"\n";
  86             }
  87             elsif ($a5) {
  88                 print "  __asm volatile (\"exg d7,a5\\n\\tjsr a6@(-" .
  89                     "$prototype->{bias}:W)\\n\\texg d7,a5\"\n";
  90             }
  91             else {
  92                 print "  __asm volatile (\"jsr a6@(-$prototype->{bias}:W)\"\n";
  93             }
  94             print "  : " .
  95                 ($prototype->{nr} ? "/* No output */" : '"=r" (_res)') . "\n";
  96             print "  : ";
  97             if (!$prototype->{nb}) {
  98                 print '"r" (_base)';
  99             }
 100
 101             for my $i (0 .. $prototype->{numargs} - 1) {
 102                 if ($i != 0 || !$prototype->{nb}) {
 103                     print ", ";
 104                 }
 105
 106                 print '"r" (' . $prototype->{argnames}[$i] . ')';
 107             }
 108
 109             print "\n";
 110             print '  : "d0", "d1", "a0", "a1", "fp0", "fp1", "cc", "memory");';
 111             print "\n";
 112
 113             if (!$prototype->{nr}) {
 114                 print "  return _res;\n";
 115             }
 116
 117             print "}\n";
 118         }
 119         else {
 120             $self->SUPER::function_end (@_);
 121         }
 122     }
 123 }