tools/sfdc/Gate.pl

   1
   2 ### Class Gate: Create a generic gate file ####################################
   3
   4 BEGIN {
   5     package Gate;
   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         $self->{PROTO}    = $params{'proto'};
  14         $self->{LIBPROTO} = $params{'libproto'};
  15         bless ($self, $class);
  16         return $self;
  17     }
  18
  19     sub header {
  20         my $self = shift;
  21         my $sfd  = $self->{SFD};
  22
  23         if ($self->{PROTO}) {
  24             print "/* Automatically generated header! Do not edit! */\n";
  25             print "\n";
  26             print "#ifndef _GATEPROTO_$$sfd{'BASENAME'}_H\n";
  27             print "#define _GATEPROTO_$$sfd{'BASENAME'}_H\n";
  28         }
  29         elsif ($self->{LIBPROTO}) {
  30             print "/* Automatically generated header! Do not edit! */\n";
  31             print "\n";
  32             print "#ifndef _LIBPROTO_$$sfd{'BASENAME'}_H\n";
  33             print "#define _LIBPROTO_$$sfd{'BASENAME'}_H\n";
  34         }
  35         else {
  36             print "/* Automatically generated gatestubs! Do not edit! */\n";
  37         }
  38         print "\n";
  39
  40         foreach my $inc (@{$$sfd{'includes'}}) {
  41             print "#include $inc\n";
  42         }
  43
  44         foreach my $td (@{$$sfd{'typedefs'}}) {
  45             print "typedef $td;\n";
  46         }
  47
  48         print "\n";
  49         print "#define _sfdc_strarg(a) _sfdc_strarg2(a)\n";
  50         print "#define _sfdc_strarg2(a) #a\n";
  51
  52         print "\n";
  53         print "#ifdef __cplusplus\n";
  54         print "extern \"C\" {\n";
  55         print "#endif /* __cplusplus */\n";
  56         print "\n";
  57     }
  58
  59     sub function {
  60         my $self     = shift;
  61         my %params    = @_;
  62         my $prototype = $params{'prototype'};
  63         my $sfd       = $self->{SFD};
  64
  65         if ($prototype->{type} eq 'function') {
  66             $self->function_proto (prototype => $prototype);
  67             $self->function_start (prototype => $prototype);
  68             for my $i (0 .. $$prototype{'numargs'} - 1 ) {
  69                 $self->function_arg (prototype => $prototype,
  70                                      argtype   => $$prototype{'argtypes'}[$i],
  71                                      argname   => $$prototype{'___argnames'}[$i],
  72                                      argreg    => $$prototype{'regs'}[$i],
  73                                      argnum    => $i );
  74             }
  75             $self->function_end (prototype => $prototype);
  76
  77             print "\n";
  78         }
  79         elsif ($prototype->{type} eq 'cfunction') {
  80             $self->function_proto (prototype => $prototype);
  81
  82             if (!$self->{LIBPROTO}) {
  83                 print_gateproto ($sfd, $prototype);
  84                 print ";\n\n";
  85             }
  86
  87             if (!$self->{PROTO} && !$self->{LIBPROTO}) {
  88                 print "__asm(\".globl \" _sfdc_strarg(" .
  89                     "$gateprefix$prototype->{funcname}) );\n";
  90                 print "__asm(\".type  \" _sfdc_strarg(" .
  91                     "$gateprefix$prototype->{funcname}) \"" .
  92                     ", \@function\");\n";
  93                 print "__asm(_sfdc_strarg(".
  94                     "$gateprefix$prototype->{funcname}) \":\");\n";
  95                 print "#if defined(__mc68000__) || defined(__i386__)\n";
  96                 print "__asm(\"jmp $libprefix$prototype->{funcname}\");\n";
  97                 print "#else\n";
  98                 print "# error \"Unknown CPU\"\n";
  99                 print "#endif\n";
 100                 print "\n";
 101             }
 102         }
 103     }
 104
 105     sub footer {
 106         my $self = shift;
 107         my $sfd  = $self->{SFD};
 108
 109         print "\n";
 110         print "#ifdef __cplusplus\n";
 111         print "}\n";
 112         print "#endif /* __cplusplus */\n";
 113
 114         if ($self->{PROTO}) {
 115             print "\n";
 116             print "#endif /* _GATEPROTO_$$sfd{'BASENAME'}_H */\n";
 117         }
 118         elsif ($self->{LIBPROTO}) {
 119             print "\n";
 120             print "#endif /* _LIBPROTO_$$sfd{'BASENAME'}_H */\n";
 121         }
 122     }
 123
 124
 125     # Helper functions
 126
 127     sub function_proto {
 128         my $self     = shift;
 129         my %params   = @_;
 130         my $prototype = $params{'prototype'};
 131         my $sfd      = $self->{SFD};
 132
 133         if (!$self->{PROTO}) {
 134             if ($prototype->{type} eq 'varargs') {
 135                 print_libproto($sfd, $prototype->{real_prototype});
 136             }
 137             else {
 138                 print_libproto($sfd, $prototype);
 139             }
 140             print ";\n\n";
 141         }
 142     }
 143
 144     sub function_start {
 145         my $self      = shift;
 146         my %params    = @_;
 147         my $prototype = $params{'prototype'};
 148         my $sfd       = $self->{SFD};
 149
 150         if (!$self->{LIBPROTO}) {
 151             print_gateproto ($sfd, $prototype);
 152         }
 153
 154         if ($self->{PROTO}) {
 155             print ";\n";
 156         }
 157         elsif (!$self->{LIBPROTO}) {
 158             print "\n";
 159             print "{\n";
 160             print "  return $libprefix$prototype->{funcname}(";
 161
 162             if ($libarg eq 'first' && !$prototype->{nb}) {
 163                 print "_base";
 164                 print $prototype->{numargs} > 0 ? ", " : "";
 165             }
 166         }
 167     }
 168
 169     sub function_arg {
 170         my $self      = shift;
 171
 172         if (!$self->{PROTO} && !$self->{LIBPROTO}) {
 173             my %params    = @_;
 174             my $argname   = $params{'argname'};
 175             my $argnum    = $params{'argnum'};
 176
 177             print $argnum > 0 ? ", " : "";
 178             print $argname;
 179         }
 180     }
 181
 182     sub function_end {
 183         my $self      = shift;
 184
 185         if (!$self->{PROTO} && !$self->{LIBPROTO}) {
 186             my %params    = @_;
 187             my $prototype = $params{'prototype'};
 188             my $sfd       = $self->{SFD};
 189
 190             if ($libarg eq 'last' && !$prototype->{nb}) {
 191                 print $prototype->{numargs} > 0 ? ", " : "";
 192                 print "_base";
 193             }
 194
 195             print ");\n";
 196             print "}\n";
 197         }
 198     }
 199
 200
 201     sub print_gateproto {
 202         my $sfd       = shift;
 203         my $prototype = shift;
 204
 205         print "$prototype->{return}\n";
 206         print "$gateprefix$prototype->{funcname}(";
 207
 208         if ($libarg eq 'first' && !$prototype->{nb}) {
 209             print "$sfd->{basetype} _base";
 210             print $prototype->{numargs} > 0 ? ", " : "";
 211         }
 212
 213         print join (', ', @{$prototype->{___args}});
 214
 215         if ($libarg eq 'last' && !$prototype->{nb}) {
 216             print $prototype->{numargs} > 0 ? ", " : "";
 217             print "$sfd->{basetype} _base";
 218         }
 219
 220         if ($libarg eq 'none' && $prototype->{numargs} == 0) {
 221             print "void";
 222         }
 223
 224         print ")";
 225     }
 226
 227     sub print_libproto {
 228         my $sfd       = shift;
 229         my $prototype = shift;
 230
 231         print "$prototype->{return}\n";
 232         print "$libprefix$prototype->{funcname}(";
 233
 234         if ($libarg eq 'first' && !$prototype->{nb}) {
 235             print "$sfd->{basetype} _base";
 236             print $prototype->{numargs} > 0 ? ", " : "";
 237         }
 238
 239         print join (', ', @{$prototype->{___args}});
 240
 241         if ($libarg eq 'last' && !$prototype->{nb}) {
 242             print $prototype->{numargs} > 0 ? ", " : "";
 243             print "$sfd->{basetype} _base";
 244         }
 245
 246         if ($libarg eq 'none' && $prototype->{numargs} == 0) {
 247             print "void";
 248         }
 249
 250         print ")";
 251     }
 252 }