home *** CD-ROM | disk | FTP | other *** search
/ Amiga Magazin: Amiga-CD 1996 July / AMIGA_1996_7.BIN / ausgabe_7_96 / pd-programmierung / perl5_002bin.lha / bin / h2ph < prev    next >
Text File  |  1996-03-27  |  6KB  |  272 lines
  1. #!/gnu/bin/perl
  2.     eval 'exec perl -S $0 "$@"'
  3.     if 0;
  4.  
  5. 'di ';
  6. 'ds 00 "';
  7. 'ig 00 ';
  8.  
  9. $perlincl = "/usr/lib/perl5/Amiga/5.002";
  10.  
  11.  
  12. chdir '/usr/include' || die "Can't cd /usr/include";
  13.  
  14. @isatype = split(' ',<<END);
  15.     char    uchar    u_char
  16.     short    ushort    u_short
  17.     int    uint    u_int
  18.     long    ulong    u_long
  19.     FILE
  20. END
  21.  
  22. @isatype{@isatype} = (1) x @isatype;
  23. $inif = 0;
  24.  
  25. @ARGV = ('-') unless @ARGV;
  26.  
  27. foreach $file (@ARGV) {
  28.     if ($file eq '-') {
  29.     open(IN, "-");
  30.     open(OUT, ">-");
  31.     }
  32.     else {
  33.     ($outfile = $file) =~ s/\.h$/.ph/ || next;
  34.     print "$file -> $outfile\n";
  35.     if ($file =~ m|^(.*)/|) {
  36.         $dir = $1;
  37.         if (!-d "$perlincl/$dir") {
  38.         mkdir("$perlincl/$dir",0777);
  39.         }
  40.     }
  41.     open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
  42.     open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
  43.     }
  44.     while (<IN>) {
  45.     chop;
  46.     while (/\\$/) {
  47.         chop;
  48.         $_ .= <IN>;
  49.         chop;
  50.     }
  51.     if (s:/\*:\200:g) {
  52.         s:\*/:\201:g;
  53.         s/\200[^\201]*\201//g;    # delete single line comments
  54.         if (s/\200.*//) {        # begin multi-line comment?
  55.         $_ .= '/*';
  56.         $_ .= <IN>;
  57.         redo;
  58.         }
  59.     }
  60.     if (s/^#\s*//) {
  61.         if (s/^define\s+(\w+)//) {
  62.         $name = $1;
  63.         $new = '';
  64.         s/\s+$//;
  65.         if (s/^\(([\w,\s]*)\)//) {
  66.             $args = $1;
  67.             if ($args ne '') {
  68.             foreach $arg (split(/,\s*/,$args)) {
  69.                 $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
  70.                 $curargs{$arg} = 1;
  71.             }
  72.             $args =~ s/\b(\w)/\$$1/g;
  73.             $args = "local($args) = \@_;\n$t    ";
  74.             }
  75.             s/^\s+//;
  76.             do expr();
  77.             $new =~ s/(["\\])/\\$1/g;
  78.             if ($t ne '') {
  79.             $new =~ s/(['\\])/\\$1/g;
  80.             print OUT $t,
  81.               "eval 'sub $name {\n$t    ${args}eval \"$new\";\n$t}';\n";
  82.             }
  83.             else {
  84.             print OUT "sub $name {\n    ${args}eval \"$new\";\n}\n";
  85.             }
  86.             %curargs = ();
  87.         }
  88.         else {
  89.             s/^\s+//;
  90.             do expr();
  91.             $new = 1 if $new eq '';
  92.             if ($t ne '') {
  93.             $new =~ s/(['\\])/\\$1/g;
  94.             print OUT $t,"eval 'sub $name {",$new,";}';\n";
  95.             }
  96.             else {
  97.             print OUT $t,"sub $name {",$new,";}\n";
  98.             }
  99.         }
  100.         }
  101.         elsif (/^include\s*<(.*)>/) {
  102.         ($incl = $1) =~ s/\.h$/.ph/;
  103.         print OUT $t,"require '$incl';\n";
  104.         }
  105.         elsif (/^ifdef\s+(\w+)/) {
  106.         print OUT $t,"if (defined &$1) {\n";
  107.         $tab += 4;
  108.         $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  109.         }
  110.         elsif (/^ifndef\s+(\w+)/) {
  111.         print OUT $t,"if (!defined &$1) {\n";
  112.         $tab += 4;
  113.         $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  114.         }
  115.         elsif (s/^if\s+//) {
  116.         $new = '';
  117.         $inif = 1;
  118.         do expr();
  119.         $inif = 0;
  120.         print OUT $t,"if ($new) {\n";
  121.         $tab += 4;
  122.         $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  123.         }
  124.         elsif (s/^elif\s+//) {
  125.         $new = '';
  126.         $inif = 1;
  127.         do expr();
  128.         $inif = 0;
  129.         $tab -= 4;
  130.         $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  131.         print OUT $t,"}\n${t}elsif ($new) {\n";
  132.         $tab += 4;
  133.         $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  134.         }
  135.         elsif (/^else/) {
  136.         $tab -= 4;
  137.         $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  138.         print OUT $t,"}\n${t}else {\n";
  139.         $tab += 4;
  140.         $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  141.         }
  142.         elsif (/^endif/) {
  143.         $tab -= 4;
  144.         $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  145.         print OUT $t,"}\n";
  146.         }
  147.     }
  148.     }
  149.     print OUT "1;\n";
  150. }
  151.  
  152. sub expr {
  153.     while ($_ ne '') {
  154.     s/^(\s+)//        && do {$new .= ' '; next;};
  155.     s/^(0x[0-9a-fA-F]+)//    && do {$new .= $1; next;};
  156.     s/^(\d+)[LlUu]*//    && do {$new .= $1; next;};
  157.     s/^("(\\"|[^"])*")//    && do {$new .= $1; next;};
  158.     s/^'((\\"|[^"])*)'//    && do {
  159.         if ($curargs{$1}) {
  160.         $new .= "ord('\$$1')";
  161.         }
  162.         else {
  163.         $new .= "ord('$1')";
  164.         }
  165.         next;
  166.     };
  167.     s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
  168.         $new .= '$sizeof';
  169.         next;
  170.     };
  171.     s/^([_a-zA-Z]\w*)//    && do {
  172.         $id = $1;
  173.         if ($id eq 'struct') {
  174.         s/^\s+(\w+)//;
  175.         $id .= ' ' . $1;
  176.         $isatype{$id} = 1;
  177.         }
  178.         elsif ($id eq 'unsigned') {
  179.         s/^\s+(\w+)//;
  180.         $id .= ' ' . $1;
  181.         $isatype{$id} = 1;
  182.         }
  183.         if ($curargs{$id}) {
  184.         $new .= '$' . $id;
  185.         }
  186.         elsif ($id eq 'defined') {
  187.         $new .= 'defined';
  188.         }
  189.         elsif (/^\(/) {
  190.         s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;    # cheat
  191.         $new .= " &$id";
  192.         }
  193.         elsif ($isatype{$id}) {
  194.         if ($new =~ /{\s*$/) {
  195.             $new .= "'$id'";
  196.         }
  197.         elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
  198.             $new =~ s/\(\s*$//;
  199.             s/^[\s*]*\)//;
  200.         }
  201.         else {
  202.             $new .= q(').$id.q(');
  203.         }
  204.         }
  205.         else {
  206.         if ($inif && $new !~ /defined\s*\($/) {
  207.             $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
  208.         } 
  209.         elsif (/^\[/) { 
  210.             $new .= ' $' . $id;
  211.         }
  212.         else {
  213.             $new .= ' &' . $id;
  214.         }
  215.         }
  216.         next;
  217.     };
  218.     s/^(.)// && do { if ($1 ne '#') { $new .= $1; } next;};
  219.     }
  220. }
  221. ##############################################################################
  222.  
  223.     # These next few lines are legal in both Perl and nroff.
  224.  
  225. .00 ;            # finish .ig
  226.  
  227. 'di            \" finish diversion--previous line must be blank
  228. .nr nl 0-1        \" fake up transition to first page again
  229. .nr % 0            \" start at page 1
  230. '; __END__ ############# From here on it's a standard manual page ############
  231. .TH H2PH 1 "August 8, 1990"
  232. .AT 3
  233. .SH NAME
  234. h2ph \- convert .h C header files to .ph Perl header files
  235. .SH SYNOPSIS
  236. .B h2ph [headerfiles]
  237. .SH DESCRIPTION
  238. .I h2ph
  239. converts any C header files specified to the corresponding Perl header file
  240. format.
  241. It is most easily run while in /usr/include:
  242. .nf
  243.  
  244.     cd /usr/include; h2ph * sys/*
  245.  
  246. .fi
  247. If run with no arguments, filters standard input to standard output.
  248. .SH ENVIRONMENT
  249. No environment variables are used.
  250. .SH FILES
  251. /usr/include/*.h
  252. .br
  253. /usr/include/sys/*.h
  254. .br
  255. etc.
  256. .SH AUTHOR
  257. Larry Wall
  258. .SH "SEE ALSO"
  259. perl(1)
  260. .SH DIAGNOSTICS
  261. The usual warnings if it can't read or write the files involved.
  262. .SH BUGS
  263. Doesn't construct the %sizeof array for you.
  264. .PP
  265. It doesn't handle all C constructs, but it does attempt to isolate
  266. definitions inside evals so that you can get at the definitions
  267. that it can translate.
  268. .PP
  269. It's only intended as a rough tool.
  270. You may need to dicker with the files produced.
  271. .ex
  272.