tools/sfdc/CLib.pl

   1
   2 ### Class CLib: Create a clib file ############################################
   3
   4 BEGIN {
   5     package CLib;
   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->{VERSION} = 1;
  14         bless ($self, $class);
  15         return $self;
  16     }
  17
  18     sub header {
  19         my $self = shift;
  20         my $sfd  = $self->{SFD};
  21
  22         my $id = $$sfd{'id'};
  23         my $v  = $id;
  24         my $d  = $id;
  25
  26         $v =~ s/^\$[I]d: .*? ([0-9.]+).*/$1/;
  27         $d =~ s,^\$[I]d: .*? [0-9.]+ (\d{4})/(\d{2})/(\d{2}).*,($3.$2.$1),;
  28
  29         print "/* Automatically generated header! Do not edit! */\n";
  30         print "\n";
  31         print "#ifndef CLIB_$$sfd{'BASENAME'}_PROTOS_H\n";
  32         print "#define CLIB_$$sfd{'BASENAME'}_PROTOS_H\n";
  33         print "\n";
  34         print "/*\n";
  35         print "**       \$VER: $$sfd{'basename'}_protos.h $v $d\n";
  36         print "**\n";
  37         print "**       C prototypes. For use with 32 bit integers only.\n";
  38         print "**\n";
  39         print "**       $$sfd{'copyright'}\n";
  40         print "**           All Rights Reserved\n";
  41         print "*/\n";
  42         print "\n";
  43
  44         foreach my $inc (@{$$sfd{'includes'}}) {
  45             print "#include $inc\n";
  46         }
  47
  48         foreach my $td (@{$$sfd{'typedefs'}}) {
  49             print "typedef $td;\n";
  50         }
  51
  52         print "\n";
  53         print "#ifdef __cplusplus\n";
  54         print "extern \"C\" {\n";
  55         print "#endif /* __cplusplus */\n";
  56         print "\n";
  57
  58         $self->{VERSION} = 1;
  59     }
  60
  61     sub function {
  62         my $self     = shift;
  63         my %params    = @_;
  64         my $prototype = $params{'prototype'};
  65         my $sfd       = $self->{SFD};
  66
  67         # Don't process private functions
  68         if ($prototype->{private}) {
  69             return;
  70         }
  71
  72         if ($self->{VERSION} != $$prototype{'version'}) {
  73             $self->{VERSION} = $$prototype{'version'};
  74
  75             print "\n";
  76             print "/*--- functions in V$self->{VERSION} or higher ---*/\n";
  77         }
  78
  79         if ($$prototype{'comment'} ne '') {
  80             my $comment = $$prototype{'comment'};
  81
  82             $comment =~ s,^(\s?)(.*)$,/*$1$2$1*/,mg;
  83
  84             print "\n";
  85             print "$comment\n";
  86         }
  87
  88         my $args = join (', ',@{$$prototype{'args'}});
  89
  90         if ($args eq '') {
  91             $args = "void";
  92         }
  93
  94         print "$$prototype{'return'} $$prototype{'funcname'}($args)";
  95
  96         if ($$classes{'target'} eq 'morphos' &&
  97             $$prototype{'type'} eq 'varargs' &&
  98             $$prototype{'subtype'} ne 'tagcall') {
  99             print " __attribute__((varargs68k))";
 100         }
 101
 102         print ";\n";
 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         print "\n";
 114         print "#endif /* CLIB_$$sfd{'BASENAME'}_PROTOS_H */\n";
 115     }
 116 }