home *** CD-ROM | disk | FTP | other *** search
- --- h2ph.man.orig Tue Jan 17 22:19:16 1995
- +++ h2ph.man Tue Jan 17 22:19:53 1995
- @@ -1,209 +1,3 @@
- -#!/usr/bin/perl
- -'di';
- -'ig00';
- -
- -$perlincl = '/usr/lib/perl4';
- -
- -chdir '/usr/include' || die "Can't cd /usr/include";
- -
- -@isatype = split(' ',<<END);
- - char uchar u_char
- - short ushort u_short
- - int uint u_int
- - long ulong u_long
- - FILE
- -END
- -
- -@isatype{@isatype} = (1) x @isatype;
- -
- -@ARGV = ('-') unless @ARGV;
- -
- -foreach $file (@ARGV) {
- - if ($file eq '-') {
- - open(IN, "-");
- - open(OUT, ">-");
- - }
- - else {
- - ($outfile = $file) =~ s/\.h$/.ph/ || next;
- - print "$file -> $outfile\n";
- - if ($file =~ m|^(.*)/|) {
- - $dir = $1;
- - if (!-d "$perlincl/$dir") {
- - mkdir("$perlincl/$dir",0777);
- - }
- - }
- - open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
- - open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
- - }
- - while (<IN>) {
- - chop;
- - while (/\\$/) {
- - chop;
- - $_ .= <IN>;
- - chop;
- - }
- - if (s:/\*:\200:g) {
- - s:\*/:\201:g;
- - s/\200[^\201]*\201//g; # delete single line comments
- - if (s/\200.*//) { # begin multi-line comment?
- - $_ .= '/*';
- - $_ .= <IN>;
- - redo;
- - }
- - }
- - if (s/^#\s*//) {
- - if (s/^define\s+(\w+)//) {
- - $name = $1;
- - $new = '';
- - s/\s+$//;
- - if (s/^\(([\w,\s]*)\)//) {
- - $args = $1;
- - if ($args ne '') {
- - foreach $arg (split(/,\s*/,$args)) {
- - $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
- - $curargs{$arg} = 1;
- - }
- - $args =~ s/\b(\w)/\$$1/g;
- - $args = "local($args) = \@_;\n$t ";
- - }
- - s/^\s+//;
- - do expr();
- - $new =~ s/(["\\])/\\$1/g;
- - if ($t ne '') {
- - $new =~ s/(['\\])/\\$1/g;
- - print OUT $t,
- - "eval 'sub $name {\n$t ${args}eval \"$new\";\n$t}';\n";
- - }
- - else {
- - print OUT "sub $name {\n ${args}eval \"$new\";\n}\n";
- - }
- - %curargs = ();
- - }
- - else {
- - s/^\s+//;
- - do expr();
- - $new = 1 if $new eq '';
- - if ($t ne '') {
- - $new =~ s/(['\\])/\\$1/g;
- - print OUT $t,"eval 'sub $name {",$new,";}';\n";
- - }
- - else {
- - print OUT $t,"sub $name {",$new,";}\n";
- - }
- - }
- - }
- - elsif (/^include\s+<(.*)>/) {
- - ($incl = $1) =~ s/\.h$/.ph/;
- - print OUT $t,"require '$incl';\n";
- - }
- - elsif (/^ifdef\s+(\w+)/) {
- - print OUT $t,"if (defined &$1) {\n";
- - $tab += 4;
- - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- - }
- - elsif (/^ifndef\s+(\w+)/) {
- - print OUT $t,"if (!defined &$1) {\n";
- - $tab += 4;
- - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- - }
- - elsif (s/^if\s+//) {
- - $new = '';
- - do expr();
- - print OUT $t,"if ($new) {\n";
- - $tab += 4;
- - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- - }
- - elsif (s/^elif\s+//) {
- - $new = '';
- - do expr();
- - $tab -= 4;
- - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- - print OUT $t,"}\n${t}elsif ($new) {\n";
- - $tab += 4;
- - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- - }
- - elsif (/^else/) {
- - $tab -= 4;
- - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- - print OUT $t,"}\n${t}else {\n";
- - $tab += 4;
- - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- - }
- - elsif (/^endif/) {
- - $tab -= 4;
- - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- - print OUT $t,"}\n";
- - }
- - }
- - }
- - print OUT "1;\n";
- -}
- -
- -sub expr {
- - while ($_ ne '') {
- - s/^(\s+)// && do {$new .= ' '; next;};
- - s/^(0x[0-9a-fA-F]+)// && do {$new .= $1; next;};
- - s/^(\d+)// && do {$new .= $1; next;};
- - s/^("(\\"|[^"])*")// && do {$new .= $1; next;};
- - s/^'((\\"|[^"])*)'// && do {
- - if ($curargs{$1}) {
- - $new .= "ord('\$$1')";
- - }
- - else {
- - $new .= "ord('$1')";
- - }
- - next;
- - };
- - s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
- - $new .= '$sizeof';
- - next;
- - };
- - s/^([_a-zA-Z]\w*)// && do {
- - $id = $1;
- - if ($id eq 'struct') {
- - s/^\s+(\w+)//;
- - $id .= ' ' . $1;
- - $isatype{$id} = 1;
- - }
- - elsif ($id eq 'unsigned') {
- - s/^\s+(\w+)//;
- - $id .= ' ' . $1;
- - $isatype{$id} = 1;
- - }
- - if ($curargs{$id}) {
- - $new .= '$' . $id;
- - }
- - elsif ($id eq 'defined') {
- - $new .= 'defined';
- - }
- - elsif (/^\(/) {
- - s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat
- - $new .= " &$id";
- - }
- - elsif ($isatype{$id}) {
- - if ($new =~ /{\s*$/) {
- - $new .= "'$id'";
- - }
- - elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
- - $new =~ s/\(\s*$//;
- - s/^[\s*]*\)//;
- - }
- - else {
- - $new .= $id;
- - }
- - }
- - else {
- - $new .= ' &' . $id;
- - }
- - next;
- - };
- - s/^(.)// && do {$new .= $1; next;};
- - }
- -}
- -##############################################################################
- -
- - # These next few lines are legal in both Perl and nroff.
- -
- .00; # finish .ig
-
- 'di \" finish diversion--previous line must be blank
-