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