tools/sfdc/GateAmithlon.pl

   1
   2 ### Class GateAmithlon: Create an Amithlon gatestub file ######################
   3
   4 BEGIN {
   5     package GateAmithlon;
   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 "#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 "#endif /* __INLINE_MACROS_H */\n";
  52         print "\n";
  53     }
  54
  55     sub function_proto {
  56         my $self      = shift;
  57         my %params    = @_;
  58         my $prototype = $params{'prototype'};
  59         my $sfd       = $self->{SFD};
  60
  61         $self->SUPER::function_proto (@_);
  62
  63         print_gateproto($sfd, $prototype);
  64         print ";\n\n";
  65     }
  66
  67     sub function_start {
  68         my $self      = shift;
  69
  70         if (!$self->{PROTO}) {
  71             my %params    = @_;
  72             my $prototype = $params{'prototype'};
  73             my $sfd       = $self->{SFD};
  74
  75             print "$prototype->{return}\n";
  76             print "$gateprefix$prototype->{funcname}(struct _Regs* _regs)\n";
  77             print "{\n";
  78         }
  79     }
  80
  81     sub function_arg {
  82         my $self      = shift;
  83
  84         if (!$self->{PROTO}) {
  85             my %params    = @_;
  86             my $prototype = $params{'prototype'};
  87             my $argtype   = $params{'argtype'};
  88             my $argname   = $params{'argname'};
  89             my $argreg    = $params{'argreg'};
  90             my $argnum    = $params{'argnum'};
  91             my $sfd       = $self->{SFD};
  92
  93             print "  $prototype->{___args}[$argnum] = ($argtype) ({long r;" .
  94                 "__asm(\"movl %1,%0\":\"=r\"(r):\"m\"(_regs->$argreg));" .
  95                 "r;});\n";
  96         }
  97     }
  98
  99     sub function_end {
 100         my $self      = shift;
 101
 102         if (!$self->{PROTO}) {
 103             my %params    = @_;
 104             my $prototype = $params{'prototype'};
 105             my $sfd       = $self->{SFD};
 106
 107             if ($libarg ne 'none' && !$prototype->{nb}) {
 108                 print "  $sfd->{basetype} _base = ($sfd->{basetype}) " .
 109                     "({long r;" .
 110                     "__asm(\"movl %1,%0\":\"=r\"(r):\"m\"(_regs->a6));" .
 111                     "r;});\n";
 112             }
 113
 114             print "  return $libprefix$prototype->{funcname}(";
 115
 116             if ($libarg eq 'first' && !$prototype->{nb}) {
 117                 print "_base";
 118                 print $prototype->{numargs} > 0 ? ", " : "";
 119             }
 120
 121             print join (', ', @{$prototype->{___argnames}});
 122
 123             if ($libarg eq 'last' && !$prototype->{nb}) {
 124                 print $prototype->{numargs} > 0 ? ", " : "";
 125                 print "_base";
 126             }
 127
 128             print ");\n";
 129             print "}\n";
 130         }
 131     }
 132
 133     sub print_gateproto {
 134         my $sfd       = shift;
 135         my $prototype = shift;
 136
 137         print "$prototype->{return}\n";
 138         print "$gateprefix$prototype->{funcname}" .
 139             "(struct _Regs* _regs) __attribute__((regparm(3)))";
 140     }
 141 }