tools/sfdc/SASPragmas.pl

   1
   2 ### Class SASPragmas: Create a SAS/C pragmas file #############################
   3
   4 BEGIN {
   5     package SASPragmas;
   6
   7     sub new {
   8         my $proto  = shift;
   9         my %params = @_;
  10         my $class  = ref($proto) || $proto;
  11         my $self   = {};
  12         $self->{SFD} = $params{'sfd'};
  13         bless ($self, $class);
  14         return $self;
  15     }
  16
  17     sub header {
  18         my $self = shift;
  19         my $sfd  = $self->{SFD};
  20
  21         my $id = $$sfd{'id'};
  22         my $v  = $id;
  23         my $d  = $id;
  24
  25         $v =~ s/^\$[I]d: .*? ([0-9.]+).*/$1/;
  26         $d =~ s,^\$[I]d: .*? [0-9.]+ (\d{4})/(\d{2})/(\d{2}).*,($3.$2.$1),;
  27
  28         print "/* Automatically generated header! Do not edit! */\n";
  29         print "#ifndef PRAGMAS_$sfd->{BASENAME}_PRAGMAS_H\n";
  30         print "#define PRAGMAS_$sfd->{BASENAME}_PRAGMAS_H\n";
  31         print "\n";
  32         print "/*\n";
  33         print "**       \$VER: $$sfd{'basename'}_pragmas.h $v $d\n";
  34         print "**\n";
  35         print "**       Direct ROM interface (pragma) definitions.\n";
  36         print "**\n";
  37         print "**       $$sfd{'copyright'}\n";
  38         print "**           All Rights Reserved\n";
  39         print "*/\n";
  40         print "\n";
  41
  42         print "#if defined(LATTICE) || defined(__SASC) || defined(_DCC)\n";
  43         print "#ifndef __CLIB_PRAGMA_LIBCALL\n";
  44         print "#define __CLIB_PRAGMA_LIBCALL\n";
  45         print "#endif /* __CLIB_PRAGMA_LIBCALL */\n";
  46         print "#else /* __MAXON__, __STORM__ or AZTEC_C */\n";
  47         print "#ifndef __CLIB_PRAGMA_AMICALL\n";
  48         print "#define __CLIB_PRAGMA_AMICALL\n";
  49         print "#endif /* __CLIB_PRAGMA_AMICALL */\n";
  50         print "#endif /* */\n";
  51         print "\n";
  52         print "#if defined(__SASC_60) || defined(__STORM__)\n";
  53         print "#ifndef __CLIB_PRAGMA_TAGCALL\n";
  54         print "#define __CLIB_PRAGMA_TAGCALL\n";
  55         print "#endif /* __CLIB_PRAGMA_TAGCALL */\n";
  56         print "#endif /* __MAXON__, __STORM__ or AZTEC_C */\n";
  57         print "\n";
  58     }
  59
  60     sub function {
  61         my $self      = shift;
  62         my %params    = @_;
  63         my $prototype = $params{'prototype'};
  64         my $sfd       = $self->{SFD};
  65
  66         # Don't process private functions
  67         if ($prototype->{private}) {
  68             return;
  69         }
  70
  71         my $regs = '';
  72
  73         foreach my $reg (@{$prototype->{regs}}) {
  74             my $num;
  75
  76             if ($reg =~ /^d[0-7]$/) {
  77                 ($num) = $reg =~ /^d(.)/;
  78             }
  79             elsif ($reg =~ /^a[0-9]$/) {
  80                 ($num) = $reg =~ /^a(.)/;
  81                 $num += 8;
  82             }
  83             else {
  84                 die;
  85             }
  86
  87             $regs = sprintf "%x$regs", $num;
  88         }
  89
  90         $regs .= '0'; #Result in d0
  91         $regs .= $prototype->{numregs};
  92
  93         if ($prototype->{type} eq 'function') {
  94             # Always use libcall, since access to 4 is very expensive
  95
  96             print "#ifdef __CLIB_PRAGMA_LIBCALL\n";
  97             print " #pragma libcall $sfd->{base} $prototype->{funcname} ";
  98             printf "%x $regs\n", $prototype->{bias};
  99             print "#endif /* __CLIB_PRAGMA_LIBCALL */\n";
 100             print "#ifdef __CLIB_PRAGMA_AMICALL\n";
 101             printf " #pragma amicall($sfd->{base}, 0x%x, $prototype->{funcname}(",
 102                 $prototype->{bias};
 103             print join (',', @{$prototype->{regs}}) . "))\n";
 104             print "#endif /* __CLIB_PRAGMA_AMICALL */\n";
 105         }
 106         elsif ($prototype->{type} eq 'varargs') {
 107             print "#ifdef __CLIB_PRAGMA_TAGCALL\n";
 108             print " #ifdef __CLIB_PRAGMA_LIBCALL\n";
 109             print "  #pragma tagcall $sfd->{base} $prototype->{funcname} ";
 110             printf "%x $regs\n", $prototype->{bias};
 111             print " #endif /* __CLIB_PRAGMA_LIBCALL */\n";
 112             print " #ifdef __CLIB_PRAGMA_AMICALL\n";
 113             printf "  #pragma tagcall($sfd->{base}, 0x%x, $prototype->{funcname}(",
 114                 $prototype->{bias};
 115             print join (',', @{$prototype->{regs}}) . "))\n";
 116             print " #endif /* __CLIB_PRAGMA_AMICALL */\n";
 117             print "#endif /* __CLIB_PRAGMA_TAGCALL */\n";
 118         }
 119         elsif ($prototype->{type} eq 'cfunction') {
 120             # Do nothing
 121         }
 122         else {
 123             print STDERR "$prototype->{funcname}: Unsupported function " .
 124                 "type.\n";
 125             die;
 126         }
 127     }
 128
 129     sub footer {
 130         my $self = shift;
 131         my $sfd  = $self->{SFD};
 132
 133         print "\n";
 134         print "#endif /* PRAGMAS_$sfd->{BASENAME}_PRAGMAS_H */\n";
 135     }
 136 }