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