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