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 $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