tools/sfdc/MacroAROS.pl

   1
   2 ### Class MacroAROS: Implements AROS macro files ##############################
   3
   4 BEGIN {
   5     package MacroAROS;
   6     use vars qw(@ISA);
   7     @ISA = qw( Macro );
   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         my $sfd  = $self->{SFD};
  20
  21         $self->SUPER::header (@_);
  22
  23         print "#ifndef AROS_LIBCALL_H\n";
  24         print "#include <aros/libcall.h>\n";
  25         print "#endif /* !AROS_LIBCALL_H */\n";
  26         print "\n";
  27
  28         if ($$sfd{'base'} ne '') {
  29             print "#ifndef $self->{BASE}\n";
  30             print "#define $self->{BASE} $$sfd{'base'}\n";
  31             print "#endif /* !$self->{BASE} */\n";
  32             print "\n";
  33         }
  34     }
  35
  36     sub function_start {
  37         my $self      = shift;
  38         my %params    = @_;
  39         my $prototype = $params{'prototype'};
  40         my $sfd       = $self->{SFD};
  41
  42         if ($$prototype{'type'} eq 'function') {
  43             printf "    AROS_LC%d%s(%s, %s, \\\n",
  44             $$prototype{'numargs'}, $prototype->{nb} ? "I" : "",
  45             $$prototype{'return'}, $$prototype{'funcname'};
  46         }
  47         else {
  48             $self->SUPER::function_start (@_);
  49         }
  50     }
  51
  52
  53     sub function_arg {
  54         my $self      = shift;
  55         my %params    = @_;
  56         my $prototype = $params{'prototype'};
  57
  58         if ($$prototype{'type'} eq 'function') {
  59             my $argtype   = $params{'argtype'};
  60             my $argname   = $params{'argname'};
  61             my $argreg    = $params{'argreg'};
  62
  63             print "     AROS_LCA($argtype, ($argname), " . uc $argreg . "), \\\n";
  64         }
  65         else {
  66             $self->SUPER::function_arg (@_);
  67         }
  68     }
  69
  70     sub function_end {
  71         my $self      = shift;
  72         my %params    = @_;
  73         my $prototype = $params{'prototype'};
  74         my $sfd       = $self->{SFD};
  75
  76         if ($$prototype{'type'} eq 'function') {
  77             if( !$prototype->{nb}) {
  78                 print " $$sfd{'basetype'}, (___base), ";
  79             }
  80             else {
  81                 my $bt = "/* bt */";
  82                 my $bn = "/* bn */";
  83
  84                 for my $i (0 .. $#{$prototype->{regs}}) {
  85                     if ($prototype->{regs}[$i] eq 'a6') {
  86                         $bt = $prototype->{argtypes}[$i];
  87                         $bn  =$prototype->{___argnames}[$i];
  88                         last;
  89                     }
  90                 }
  91
  92                 print " $bt, $bn, ";
  93             }
  94
  95             print $$prototype{'bias'} / 6;
  96             print ", $sfd->{Basename})\n";
  97         }
  98         else {
  99             $self->SUPER::function_end (@_);
 100         }
 101     }
 102 }