home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Workshops / GNU-C / GENINLINE.LHA / conv.p next >
Text File  |  1992-06-14  |  9KB  |  310 lines
  1. #!/c/perl
  2. # convert pair of clib/proto header and fd file into an inline header
  3. #
  4. # (C) 1992 by Markus Wild
  5. # <wild@nessie.cs.id.ethz.ch> or <wild@amiga.physik.unizh.ch>
  6. #
  7. # this tool requires PERL.
  8. #
  9. # 1.1   92-jun-04    now handles double arguments
  10. #
  11. # TODO: handle full ANSI declarations, 
  12. #       eg. void qsort (void *, size_t, size_t, int (*)(const void *, const void *));
  13. #       Currently omit the declaration of the arguments of the function pointers,
  14. #       ie. in this example, use
  15. #       void qsort (void *, size_t, size_t, int (*)());
  16. #
  17.  
  18. $#ARGV == 1 || die "Usage: $0 proto-file fd-file\n";
  19.  
  20. open(PROTO_F, $ARGV[0]) || die "Can't open $ARGV[0], $!";
  21. open(FD_F, $ARGV[1]) || die "Can't open $ARGV[1], $!";
  22.  
  23. # set the input record separator to ; to be able to parse multiline 
  24. # declarations. This could get us into troubles with comments.. we will see
  25. $/=";";
  26.  
  27. p_line: while (<PROTO_F>) {
  28. #print "0: ",$_,"\n";
  29.  
  30.   # skip proprocessor statements and comments
  31.   s/\n+/\n/g;
  32. #print "01: ", $_, "\n";
  33.   s/(#.*\n)+//g;
  34. #print "02: ", $_, "\n";
  35.   s/\/\*([^\*]*\*+)*\///g;
  36. #print "03: ", $_, "\n";
  37.   s/^([^\n\(]+\n)+//g;
  38.   
  39.   next if $_ eq "";
  40.   next unless /\(/;
  41.   
  42.   # suppose this is a function declaration
  43.   # this `little' pattern filters out the return type and the argument
  44.   # line. The return type is quite tricky, since it can be a multi word
  45.   # type (like struct foo *), and we shouldn't overwrite the function
  46.   # name by matching against the return type... this seems to work, although
  47.   # I'm not completly sure it does in all cases.
  48.  
  49. #print "1: ",$_;
  50.   s/\(\s*\*/\(\*/g;
  51. #print "2: ",$_;
  52.   s/\s+(\([^\*])/\(\1/g;
  53. #print "3: ",$_;
  54.   /((\w+\s)*\w+\W+)(\w+)\((([^,\(\)]+|\([^\)]*\)|,|\s)*)\)([^;]*);/;
  55.  
  56.   # %result_tab contains the type part written before the function name
  57.   $result_tab{$3} = $1;
  58.   # %result_tab_end contains the type part written after the closing parenthesis
  59.   chop $6;
  60.   $result_tab_end{$3} = $6;
  61.   # %arg_type_tab contains (later only) the type information for the arguments
  62.   $arg_type_tab{$3} = $4;
  63.   
  64.   # compress the types, throw out not needed whitespace as much as we can
  65.   $result_tab{$3} =~ s/\s+/ /g;
  66.   $result_tab_end{$3} =~ s/\s+/ /g;
  67.   $result_tab_end{$3} =~ s/(\s+$)|(^\s+)//g;
  68.   $arg_type_tab{$3} =~ s/\s+/ /g;
  69.   $arg_type_tab{$3} =~ s/\s*,\s*/,/g;
  70.   $arg_type_tab{$3} =~ s/(\s+$)|(^\s+)//g;
  71. }
  72.  
  73. # now parse the given fd file
  74.  
  75. # reset input record separator to newline for fd file
  76. $/="\n";
  77. $bias = 0;
  78. $private = 0;
  79. ($ARGV[0] =~ /([^:\/]*[:\/])*(\w+)\.h/) && ($lib_base_name = "${2}Base");
  80. $lib_base_name[0] =~ tr/[a-z]/[A-Z]/;
  81.  
  82. f_line: while (<FD_F>) {
  83.   # strip terminating new line
  84.   chop;
  85.  
  86.   # get rid of comments
  87.   /^\*/ && next f_line;
  88.  
  89.   # parse commands
  90.   /^##base _(\w+)/    && ($lib_base_name = $1) && next f_line;
  91.   /^##bias (\d+)/    && ($bias = $1)         && next f_line;
  92.   /^##public/        && (($private = 0), 1)     && next f_line;
  93.   /^##private/        && ($private = 1)     && next f_line;
  94.  
  95.   # parse function
  96.   /^(\w+)\(([^\)]*)\)\(([^\)]*)\)/;
  97.   
  98.   $reg_tab{$1} = $3;
  99.   $arg_name_tab{$1} = $2;
  100.   $bias_tab{$1} = $bias;
  101.  
  102.   $bias += 6;
  103. }
  104.  
  105. %base_types = (
  106.   'SysBase',        'struct ExecBase *',
  107.   'ConsoleDevice',    'struct Device *',
  108.   'TimerBase',        'struct Device *',
  109.   'DiskfontBase',    'struct Library *',
  110.   'DOSBase',        'struct DosLibrary *',
  111.   'IconBase',        'struct Library *',
  112.   'PotgoBase',        'struct Library *',
  113.   'TranslatorBase',    'struct Library *',
  114.   'XpkBase',        'struct Library *',
  115.   'XpkSubBase',        'struct Library *',
  116. );
  117.  
  118. ($lib_base_type = $base_types{$lib_base_name}) || 
  119.   ($lib_base_type = "struct " . $lib_base_name . "* ");
  120.  
  121. # convert arg_name_tab and arg_type_tab into arg_tab. This is rather tricky...
  122.  
  123. foreach $func (sort keys(%arg_name_tab)) {
  124.   $_=$arg_name_tab{$func};
  125.   if ($_ eq "" || /^\s*void\s*/i)
  126.     {
  127.       # no arguments given, or just void or VOID
  128.       $arg_tab{$func} = "";
  129.       next;
  130.     }
  131.   else
  132.     {
  133.       # unpack arguments into array @names
  134.       @names = split(/,/, $arg_name_tab{$func});
  135.       # NOTE: this trick fails if someone specifies full prototypes for
  136.       #       function pointers, ie. (.., (*func)(int, int, int), ...).
  137.       #       Currently just one function in graphics.h does this, so it's
  138.       #       not worth the hassle to do it `right'.
  139.       @types = split(/,/, $arg_type_tab{$func});
  140.       # @types may still contain argument names, if they were specified
  141.       # in the proto file. This is a tricky task, separate the optional
  142.       # argument name...
  143.       foreach $i (0 .. $#types) {
  144.         @words = split(/ /,$types[$i]);
  145.         $wi=$#words;
  146.     word_loop: while ($wi > 0)
  147.       {
  148.             if ($words[$wi] =~ /[\(\)]/ && !($words[$wi - 1] =~ /[\(\)]/))
  149.               {
  150.         last word_loop;
  151.           }
  152.         elsif (!($words[$wi] =~ /[\(\)]/))
  153.           {
  154.             last word_loop;
  155.           }
  156.         $wi--;
  157.       }
  158.     # here come heuristics... (do we have a name to write over or 
  159.     # do we have to append a new element?)
  160.     if ($words[$wi] eq "int" ||
  161.         $words[$wi] eq "long" ||
  162.         $words[$wi] eq "short" ||
  163.         $words[$wi] eq "char" ||
  164.         $words[$wi] eq "*")
  165.       {
  166.         $wi++;
  167.       }
  168.     ($words[$wi] =~ s/(\W*)(\w+)(.*)/\1$names[$i]\3/) ||
  169.       ($words[$wi] = $names[$i]);
  170.     $types[$i] = "@words";
  171.       }
  172.       $arg_tab{$func} = join("|", @types);
  173.     }
  174. }
  175.  
  176.  
  177. # now output the real file
  178.  
  179. ($ARGV[0] =~ /([^:\/]*[:\/])*(\w+)\.h/) && ($def = $2 . "_H");
  180. $def =~ s/_protos//;
  181. $def =~ tr/[a-z]/[A-Z]/;
  182.  
  183. print "#ifndef _INLINE_$def\n#define _INLINE_$def\n\n";
  184.  
  185. print "#include <sys/cdefs.h>\n";
  186. print "#include <inline/stubs.h>\n";
  187.  
  188. # this is for C++ support, it does `extern "C" {' if __cplusplus is defined
  189. print "\n__BEGIN_DECLS\n\n";
  190.  
  191. print "#ifndef BASE_EXT_DECL\n";
  192. print "#define BASE_EXT_DECL extern $lib_base_type $lib_base_name;\n";
  193. print "#endif\n";
  194.  
  195. print "#ifndef BASE_PAR_DECL\n";
  196. print "#define BASE_PAR_DECL\n";
  197. print "#define BASE_PAR_DECL0 void\n";
  198. print "#endif\n";
  199.  
  200. print "#ifndef BASE_NAME\n";
  201. print "#define BASE_NAME $lib_base_name\n";
  202. print "#endif\n\n";
  203.  
  204. foreach $func (sort keys(%result_tab)) {
  205.   # this happens if the clib/ file defines functions that only exist in amiga.lib
  206.   next if $bias_tab{$func} == 0;
  207.  
  208.   print "static __inline ",$result_tab{$func},"\n";
  209.  
  210.   if ($arg_tab{$func} eq "")
  211.     {
  212.       print $func," (BASE_PAR_DECL0)\n{\n";
  213.     }
  214.   else
  215.     {
  216.       print $func," (BASE_PAR_DECL ",join(",", split(/\|/, $arg_tab{$func})),")\n{\n";
  217.     }
  218.   print "  BASE_EXT_DECL\n";
  219.   if (!($result_tab{$func} =~ /^\s*void\s*$/i))
  220.     {
  221.       print "  register $result_tab{$func} _res $result_tab_end{$func} __asm(\"d0\");\n";
  222.     }
  223.   print "  register ${lib_base_type}a6 __asm(\"a6\") = BASE_NAME;\n";
  224.   @args = split(/\|/, $arg_tab{$func});
  225.   @names = split(/,/, $arg_name_tab{$func});
  226.   @regs = split(/[\/,]/, $reg_tab{$func});
  227.   $warn_a4a5 = 0;
  228.   $owe_nl = 0;
  229.  
  230.   if ($#args >= 0)
  231.     {
  232.       # map the fd given register list to the arguments. If there wasn't 
  233.       # DOUBLE/double, then this mapping would be 1:1, but a double variable
  234.       # is specified as taking d0/d1 in the fd file, while gcc only wants to
  235.       # see the d0.
  236.  
  237.       $i = 0;
  238.       $ri = 0;
  239.       @reg_args = ();
  240.       while ($i <= $#args)
  241.         {
  242.           $reg_args[$i] = $regs[$ri];
  243.       # double, but not double pointers, skip one register
  244.       if ($args[$i] =~ /double[^\*]*$/i)
  245.         {
  246.           $ri+=2;
  247.         }
  248.       else
  249.         {
  250.           $ri++;
  251.         }
  252.       $decl = $args[$i];
  253.       $decl =~ s/(\W)$names[$i](\W?)/\1$reg_args[$i]\2/;
  254.           print "  register $decl __asm(\"$reg_args[$i]\") = $names[$i];\n";
  255.           $i++;
  256.         }
  257.     }
  258.   printf "  __asm __volatile (\"jsr a6@(-0x%x)\"\n", $bias_tab{$func};
  259.   if ($result_tab{$func} =~ /^\s*void\s*$/i)
  260.     {
  261.       print "  : /* no output */\n";
  262.     }
  263.   else
  264.     {
  265.       print "  : \"=r\" (_res)\n";
  266.     }
  267.   if ($#args == -1)
  268.     {
  269.       print "  : \"r\" (a6)\n";
  270.     }
  271.   else
  272.     {
  273.       print "  : \"r\" (a6)";
  274.       foreach $r (@reg_args) {
  275.         print ", \"r\" ($r)";
  276.       }
  277.       print "\n";
  278.     }
  279.  
  280.   @clobb=("d0", "d1", "a0", "a1");
  281.   push (@clobb, @regs);
  282.   @clobb = sort(@clobb);
  283.   print "  : ";
  284.   foreach $i (0 .. $#clobb) {
  285.     (($clobb[$i] ne $clobb[$i+1]) && ($i != $#clobb) && (print "\"$clobb[$i]\",")) ||
  286.     ($i == $#clobb && (print "\"$clobb[$i]\");\n"));
  287.   }
  288.   # hack.. for all arguments addressed via address registers, fake a value change
  289.   foreach $i (0 .. $#regs) {
  290.     ($regs[$i] =~ /a[0-5]/) && 
  291.      (print "  *(char *)$regs[$i] = *(char *)$regs[$i];") && ($owe_nl= 1);
  292.     ($regs[$i] =~ /a[45]/) && ($warn_a4a5 = 1);
  293.   }
  294.   print STDERR "Warning: $func uses a4 or a5, add code to save/restore them!\n"
  295.     if $warn_a4a5;
  296.  
  297.   print "\n" if ($owe_nl);
  298.   print "  return _res;\n" if (!($result_tab{$func} =~ /^\s*void\s*$/i));
  299.   print "}\n";
  300. }
  301.  
  302. print "#undef BASE_EXT_DECL\n";
  303. print "#undef BASE_PAR_DECL\n";
  304. print "#undef BASE_PAR_DECL0\n";
  305. print "#undef BASE_NAME\n";
  306.  
  307. print "\n__END_DECLS\n\n";
  308.  
  309. print "#endif /* _INLINE_$def */\n";
  310.