tools/sfdc/SDI.pl

   1
   2 ### Class SDI: Create a generic SDI Stub file ################################
   3
   4 BEGIN {
   5     package SDI;
   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 _$$sfd{'BASENAME'}_H\n";
  27             print "#define _$$sfd{'BASENAME'}_H\n";
  28         }
  29         else {
  30             print "/* Automatically generated SDI stubs! Do not edit! */\n";
  31         }
  32         print "\n";
  33
  34         foreach my $inc (@{$$sfd{'includes'}}) {
  35             print "#include $inc\n";
  36         }
  37
  38         foreach my $td (@{$$sfd{'typedefs'}}) {
  39             print "typedef $td;\n";
  40         }
  41
  42         print "\n";
  43         print "#ifdef __cplusplus\n";
  44         print "extern \"C\" {\n";
  45         print "#endif /* __cplusplus */\n";
  46         print "\n";
  47     }
  48
  49     sub function {
  50         my $self     = shift;
  51         my %params    = @_;
  52         my $prototype = $params{'prototype'};
  53         my $sfd       = $self->{SFD};
  54
  55         if ($prototype->{type} eq 'function') {
  56             $self->function_proto (prototype => $prototype);
  57             $self->function_start (prototype => $prototype);
  58             for my $i (0 .. $$prototype{'numargs'} - 1 ) {
  59                 $self->function_arg (prototype => $prototype,
  60                                      argtype   => $$prototype{'argtypes'}[$i],
  61                                      argname   => $$prototype{'___argnames'}[$i],
  62                                      argreg    => $$prototype{'regs'}[$i],
  63                                      argnum    => $i );
  64             }
  65             $self->function_end (prototype => $prototype);
  66
  67             print "\n";
  68         }
  69     }
  70
  71     sub footer {
  72         my $self = shift;
  73         my $sfd  = $self->{SFD};
  74
  75         print "\n";
  76         print "#ifdef __cplusplus\n";
  77         print "}\n";
  78         print "#endif /* __cplusplus */\n";
  79
  80         if ($self->{PROTO}) {
  81             print "\n";
  82             print "#endif /* _$$sfd{'BASENAME'}_H */\n";
  83         }
  84     }
  85
  86
  87     # Helper functions
  88
  89     sub function_proto {
  90         my $self     = shift;
  91         my %params   = @_;
  92         my $prototype = $params{'prototype'};
  93         my $sfd      = $self->{SFD};
  94     }
  95
  96     sub function_start {
  97         my $self      = shift;
  98         my %params    = @_;
  99         my $prototype = $params{'prototype'};
 100         my $sfd       = $self->{SFD};
 101
 102         if ($self->{PROTO}) {
 103             print ";\n";
 104         }
 105         elsif (!$self->{LIBPROTO}) {
 106             print "\n";
 107             print "{\n";
 108             print "  return $libprefix$prototype->{funcname}(";
 109
 110             if ($libarg eq 'first' && !$prototype->{nb}) {
 111                 print "_base";
 112                 print $prototype->{numargs} > 0 ? ", " : "";
 113             }
 114         }
 115     }
 116
 117     sub function_arg {
 118         my $self      = shift;
 119
 120         if (!$self->{PROTO} && !$self->{LIBPROTO}) {
 121             my %params    = @_;
 122             my $argname   = $params{'argname'};
 123             my $argnum    = $params{'argnum'};
 124
 125             print $argnum > 0 ? ", " : "";
 126             print $argname;
 127         }
 128     }
 129
 130     sub function_end {
 131         my $self      = shift;
 132
 133         if (!$self->{PROTO} && !$self->{LIBPROTO}) {
 134             my %params    = @_;
 135             my $prototype = $params{'prototype'};
 136             my $sfd       = $self->{SFD};
 137
 138             if ($libarg eq 'last' && !$prototype->{nb}) {
 139                 print $prototype->{numargs} > 0 ? ", " : "";
 140                 print "_base";
 141             }
 142
 143             print ");\n";
 144             print "}\n";
 145         }
 146     }
 147
 148 }