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