tools/sfdc/StubAmithlon.pl

   1
   2 ### Class StubAmithlon: Create a Amithlon stub file ###########################
   3
   4 BEGIN {
   5     package StubAmithlon;
   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 header {
  18         my $self = shift;
  19
  20         $self->SUPER::header (@_);
  21
  22         print "#ifndef __INLINE_MACROS_H\n";
  23         print "#define __INLINE_MACROS_H\n";
  24         print "\n";
  25         print "#ifndef __INLINE_MACROS_H_REGS\n";
  26         print "#define __INLINE_MACROS_H_REGS\n";
  27         print "\n";
  28         print "#include <exec/types.h>\n";
  29         print "\n";
  30         print "struct _Regs {\n";
  31         print " ULONG d0;\n";
  32         print " ULONG d1;\n";
  33         print " ULONG d2;\n";
  34         print " ULONG d3;\n";
  35         print " ULONG d4;\n";
  36         print " ULONG d5;\n";
  37         print " ULONG d6;\n";
  38         print " ULONG d7;\n";
  39         print " ULONG a0;\n";
  40         print " ULONG a1;\n";
  41         print " ULONG a2;\n";
  42         print " ULONG a3;\n";
  43         print " ULONG a4;\n";
  44         print " ULONG a5;\n";
  45         print " ULONG a6;\n";
  46         print " ULONG a7;\n";
  47         print "};\n";
  48         print "\n";
  49         print "#endif /* __INLINE_MACROS_H_REGS */\n";
  50         print "\n";
  51         print "ULONG _CallLib68k(struct _Regs*,LONG) " .
  52             "__attribute__((__regparm__(3)));\n";
  53         print "\n";
  54         print "#endif /* __INLINE_MACROS_H */\n";
  55         print "\n";
  56     }
  57
  58     sub function_start {
  59         my $self      = shift;
  60         my %params    = @_;
  61         my $prototype = $params{'prototype'};
  62         my $sfd       = $self->{SFD};
  63
  64         if ($prototype->{type} eq 'function') {
  65             print "\n";
  66             print "{\n";
  67
  68             if (!$prototype->{nb}) {
  69                 print "  BASE_EXT_DECL\n";
  70             }
  71             if (!$prototype->{nr}) {
  72                 print "  $prototype->{return} _res;\n";
  73             }
  74
  75             print "  struct _Regs _regs;\n";
  76         }
  77         else {
  78             $self->SUPER::function_start (@_);
  79         }
  80     }
  81
  82     sub function_arg {
  83         my $self      = shift;
  84         my %params    = @_;
  85         my $prototype = $params{'prototype'};
  86         my $argtype   = $params{'argtype'};
  87         my $argname   = $params{'argname'};
  88         my $argreg    = $params{'argreg'};
  89         my $argnum    = $params{'argnum'};
  90
  91         if ($$prototype{'type'} eq 'function') {
  92             printf "  __asm(\"movl %%1,%%0\":\"=m\"(_regs.%s)" .
  93                 ":\"ri\"((ULONG)%s));\n", $argreg, $argname;
  94         }
  95         else {
  96             $self->SUPER::function_arg (@_);
  97         }
  98     }
  99
 100     sub function_end {
 101         my $self      = shift;
 102         my %params    = @_;
 103         my $prototype = $params{'prototype'};
 104         my $sfd       = $self->{SFD};
 105
 106
 107         if ($$prototype{'type'} eq 'function') {
 108             if (!$prototype->{nb}) {
 109                 print "  __asm(\"movl %1,%0\":\"=m\"(_regs.a6)" .
 110                     ":\"ri\"((ULONG)(BASE_NAME)));\n";
 111             }
 112
 113             print "  ";
 114
 115             if (!$prototype->{nr}) {
 116                 print "_res = ($prototype->{return}) ";
 117             }
 118
 119             print "_CallLib68k(&_regs,-$prototype->{bias});\n";
 120
 121             if (!$prototype->{nr}) {
 122                 print "  return _res;\n";
 123             }
 124
 125             print "}\n";
 126         }
 127         else {
 128             $self->SUPER::function_end (@_);
 129         }
 130     }
 131 }