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         my $numargs   = $$prototype{'numargs'};
  42
  43         if ($prototype->{nb}) {
  44             $numargs--;
  45         }
  46         if ($$prototype{'type'} eq 'function') {
  47             printf "    AROS_LC%d%s(%s, %s, \\\n",
  48             $numargs,
  49             $$prototype{'return'} eq 'void'
  50                 || $$prototype{'return'} eq 'VOID' ? "NR" : "",
  51             $$prototype{'return'}, $$prototype{'funcname'};
  52         }
  53         else {
  54             $self->SUPER::function_start (@_);
  55         }
  56     }
  57
  58
  59     sub function_arg {
  60         my $self      = shift;
  61         my %params    = @_;
  62         my $prototype = $params{'prototype'};
  63
  64         if ($$prototype{'type'} eq 'function') {
  65             my $argreg    = uc $params{'argreg'};
  66
  67             if ($argreg ne 'A6') {
  68                 my $argtype   = $params{'argtype'};
  69                 my $argname   = $params{'argname'};
  70
  71                 print " AROS_LCA($argtype, ($argname), $argreg), \\\n";
  72             }
  73         }
  74         else {
  75             $self->SUPER::function_arg (@_);
  76         }
  77     }
  78
  79     sub function_end {
  80         my $self      = shift;
  81         my %params    = @_;
  82         my $prototype = $params{'prototype'};
  83         my $sfd       = $self->{SFD};
  84
  85         if ($$prototype{'type'} eq 'function') {
  86             if( !$prototype->{nb}) {
  87                 print " $$sfd{'basetype'}, (___base), ";
  88             }
  89             else {
  90                 my $bt = "/* bt */";
  91                 my $bn = "/* bn */";
  92
  93                 for my $i (0 .. $#{$prototype->{regs}}) {
  94                     if ($prototype->{regs}[$i] eq 'a6') {
  95                         $bt = $prototype->{argtypes}[$i];
  96                         $bn  =$prototype->{___argnames}[$i];
  97                         last;
  98                     }
  99                 }
 100
 101                 print " $bt, $bn, ";
 102             }
 103
 104             print $$prototype{'bias'} / 6;
 105             print ", $sfd->{Basename})\n";
 106         }
 107         else {
 108             $self->SUPER::function_end (@_);
 109         }
 110     }
 111 }