| 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 <(.*)>/) { |
| d9d8d8de |
105 | ($incl = $1) =~ s/\.h$/.ph/; |
| 106 | print OUT $t,"require '$incl';\n"; |
| 154e51a4 |
107 | } |
| 108 | elsif (/^ifdef\s+(\w+)/) { |
| 109 | print OUT $t,"if (defined &$1) {\n"; |
| 110 | $tab += 4; |
| 111 | $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); |
| 112 | } |
| 113 | elsif (/^ifndef\s+(\w+)/) { |
| 114 | print OUT $t,"if (!defined &$1) {\n"; |
| 115 | $tab += 4; |
| 116 | $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); |
| 117 | } |
| 118 | elsif (s/^if\s+//) { |
| 119 | $new = ''; |
| 120 | do expr(); |
| 121 | print OUT $t,"if ($new) {\n"; |
| 122 | $tab += 4; |
| 123 | $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); |
| 124 | } |
| 125 | elsif (s/^elif\s+//) { |
| 126 | $new = ''; |
| 127 | do expr(); |
| 128 | $tab -= 4; |
| 129 | $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); |
| 130 | print OUT $t,"}\n${t}elsif ($new) {\n"; |
| 131 | $tab += 4; |
| 132 | $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); |
| 133 | } |
| 134 | elsif (/^else/) { |
| 135 | $tab -= 4; |
| 136 | $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); |
| 137 | print OUT $t,"}\n${t}else {\n"; |
| 138 | $tab += 4; |
| 139 | $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); |
| 140 | } |
| 141 | elsif (/^endif/) { |
| 142 | $tab -= 4; |
| 143 | $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); |
| 144 | print OUT $t,"}\n"; |
| 145 | } |
| 146 | } |
| 147 | } |
| 148 | print OUT "1;\n"; |
| 149 | } |
| 150 | |
| 151 | sub expr { |
| 152 | while ($_ ne '') { |
| 153 | s/^(\s+)// && do {$new .= ' '; next;}; |
| 154 | s/^(0x[0-9a-fA-F]+)// && do {$new .= $1; next;}; |
| 155 | s/^(\d+)// && do {$new .= $1; next;}; |
| 156 | s/^("(\\"|[^"])*")// && do {$new .= $1; next;}; |
| 157 | s/^'((\\"|[^"])*)'// && do { |
| 158 | if ($curargs{$1}) { |
| 159 | $new .= "ord('\$$1')"; |
| 160 | } |
| 161 | else { |
| 162 | $new .= "ord('$1')"; |
| 163 | } |
| 164 | next; |
| 165 | }; |
| 166 | s/^(struct\s+\w+)// && do {$new .= "'$1'"; next;}; |
| 167 | s/^sizeof\s*\(([^)]+)\)/{$1}/ && do { |
| 168 | $new .= '$sizeof'; |
| 169 | next; |
| 170 | }; |
| 171 | s/^([_a-zA-Z]\w*)// && do { |
| 172 | $id = $1; |
| 173 | if ($curargs{$id}) { |
| 174 | $new .= '$' . $id; |
| 175 | } |
| 176 | elsif ($id eq 'defined') { |
| 177 | $new .= 'defined'; |
| 178 | } |
| 179 | elsif (/^\(/) { |
| 180 | s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/; # cheat |
| 181 | $new .= " &$id"; |
| 182 | } |
| 183 | elsif ($isatype{$id}) { |
| 184 | $new .= "'$id'"; |
| 185 | } |
| 186 | else { |
| 187 | $new .= ' &' . $id; |
| 188 | } |
| 189 | next; |
| 190 | }; |
| 191 | s/^(.)// && do {$new .= $1; next;}; |
| 192 | } |
| 193 | } |
| 194 | ############################################################################## |
| 195 | |
| 196 | # These next few lines are legal in both Perl and nroff. |
| 197 | |
| 198 | .00; # finish .ig |
| 199 | |
| 200 | 'di \" finish diversion--previous line must be blank |
| 201 | .nr nl 0-1 \" fake up transition to first page again |
| 202 | .nr % 0 \" start at page 1 |
| 203 | '; __END__ ############# From here on it's a standard manual page ############ |
| 204 | .TH H2PH 1 "August 8, 1990" |
| 205 | .AT 3 |
| 206 | .SH NAME |
| 207 | h2ph \- convert .h C header files to .ph Perl header files |
| 208 | .SH SYNOPSIS |
| 209 | .B h2ph [headerfiles] |
| 210 | .SH DESCRIPTION |
| 211 | .I h2ph |
| 212 | converts any C header files specified to the corresponding Perl header file |
| 213 | format. |
| 214 | It is most easily run while in /usr/include: |
| 215 | .nf |
| 216 | |
| 217 | cd /usr/include; h2ph * sys/* |
| 218 | |
| 219 | .fi |
| 220 | .SH ENVIRONMENT |
| 221 | No environment variables are used. |
| 222 | .SH FILES |
| 223 | /usr/include/*.h |
| 224 | .br |
| 225 | /usr/include/sys/*.h |
| 226 | .br |
| 227 | etc. |
| 228 | .SH AUTHOR |
| 229 | Larry Wall |
| 230 | .SH "SEE ALSO" |
| 231 | perl(1) |
| 232 | .SH DIAGNOSTICS |
| 233 | The usual warnings if it can't read or write the files involved. |
| 234 | .SH BUGS |
| 235 | Doesn't construct the %sizeof array for you. |
| 236 | .PP |
| 237 | It doesn't handle all C constructs, but it does attempt to isolate |
| 238 | definitions inside evals so that you can get at the definitions |
| 239 | that it can translate. |
| 240 | .PP |
| 241 | It's only intended as a rough tool. |
| 242 | You may need to dicker with the files produced. |
| 243 | .ex |
| 244 | !NO!SUBS! |
| 245 | chmod 755 h2ph |
| 246 | $eunicefix h2ph |
| 247 | rm -f h2ph.man |
| 248 | ln h2ph h2ph.man |
projects / p5sagit/p5-mst-13.2.git / blame