h2ph.SH

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