tools/sfdc/FD.pl

   1
   2 ### Class FD: Create an old-style FD file #####################################
   3
   4 BEGIN {
   5     package FD;
   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->{BIAS}    = -1;
  14         $self->{PRIVATE} = -1;
  15         $self->{VERSION} = 1;
  16         bless ($self, $class);
  17         return $self;
  18     }
  19
  20     sub header {
  21         my $self = shift;
  22         my $sfd  = $self->{SFD};
  23
  24         print "* \"$$sfd{'libname'}\"\n";
  25         print "* Automatically generated FD! Do not edit!\n";
  26         print "##base _$$sfd{'base'}\n";
  27         $self->{BIAS}    = -1;
  28         $self->{PRIVATE} = -1;
  29         $self->{VERSION} = 1;
  30     }
  31
  32     sub function {
  33         my $self      = shift;
  34         my %params    = @_;
  35         my $prototype = $params{'prototype'};
  36         my $sfd       = $self->{SFD};
  37
  38         if ($prototype->{type} eq 'function' ||
  39             $prototype->{type} eq 'cfunction') {
  40             if ($self->{BIAS} != $$prototype{'bias'}) {
  41                 $self->{BIAS} = $$prototype{'bias'};
  42                 print "##bias $self->{BIAS}\n";
  43             }
  44
  45             if ($self->{PRIVATE} != $$prototype{'private'}) {
  46                 $self->{PRIVATE} = $$prototype{'private'};
  47                 print $self->{PRIVATE} == 1 ? "##private\n" : "##public\n";
  48             }
  49
  50             if ($self->{VERSION} != $$prototype{'version'}) {
  51                 $self->{VERSION} = $$prototype{'version'};
  52
  53                 print "*--- functions in V$self->{VERSION} or higher ---\n";
  54             }
  55
  56             if ($$prototype{'comment'} ne '') {
  57                 my $comment = $$prototype{'comment'};
  58
  59                 $comment =~ s/^/\*/m;
  60
  61                 print "$comment\n";
  62             }
  63
  64             print "$$prototype{'funcname'}(";
  65             print join (',', @{$$prototype{'argnames'}});
  66             print ")(";
  67
  68             if ($prototype->{type} eq 'function') {
  69                 print join (',', @{$$prototype{'regs'}});
  70             }
  71             elsif ($prototype->{type} eq 'cfunction') {
  72                 print "base," unless $prototype->{nb};
  73                 print "$prototype->{subtype}";
  74             }
  75             else {
  76                 die;
  77             }
  78
  79             print ")\n";
  80
  81             $self->{BIAS} += 6;
  82         }
  83     }
  84
  85     sub footer {
  86         my $self = shift;
  87
  88         print "##end\n";
  89     }
  90 }