home *** CD-ROM | disk | FTP | other *** search
/ PC-Online 1996 May / PCOnline_05_1996.bin / linux / source / contrib / perl4.036 / perl-4.003 / perl-4.036.diff
Text File  |  1995-01-17  |  146KB  |  6,016 lines
  1. diff -u --new-file --recursive perl-4.036.orig/Makefile perl-4.036/Makefile
  2. --- perl-4.036.orig/Makefile    Wed Dec 31 18:00:00 1969
  3. +++ perl-4.036/Makefile    Tue Jan 17 21:16:27 1995
  4. @@ -0,0 +1,336 @@
  5. +# : Makefile.SH,v 4063Revision: 4.0.1.4 4063Date: 92/06/08 11:40:43 $
  6. +#
  7. +# $Log:    Makefile.SH,v $
  8. +# Revision 4.0.1.4  92/06/08  11:40:43  lwall
  9. +# patch20: cray didn't give enough memory to /bin/sh
  10. +# patch20: various and sundry fixes
  11. +# 
  12. +# Revision 4.0.1.3  91/11/05  15:48:11  lwall
  13. +# patch11: saberized perl
  14. +# patch11: added support for dbz
  15. +# 
  16. +# Revision 4.0.1.2  91/06/07  10:14:43  lwall
  17. +# patch4: cflags now emits entire cc command except for the filename
  18. +# patch4: alternate make programs are now semi-supported
  19. +# patch4: uperl.o no longer tries to link in libraries prematurely
  20. +# patch4: installperl now installs x2p stuff too
  21. +# 
  22. +# Revision 4.0.1.1  91/04/11  17:30:39  lwall
  23. +# patch1: C flags are now settable on a per-file basis
  24. +# 
  25. +# Revision 4.0  91/03/20  00:58:54  lwall
  26. +# 4.0 baseline.
  27. +# 
  28. +# 
  29. +
  30. +CC = gcc
  31. +YACC = bison -y
  32. +bin = /usr/bin
  33. +scriptdir = /usr/bin
  34. +privlib = /usr/lib/perl4
  35. +mansrc = /usr/man/man1
  36. +manext = 1
  37. +LDFLAGS = -s
  38. +CLDFLAGS = -s
  39. +SMALL = 
  40. +LARGE =  
  41. +mallocsrc = 
  42. +mallocobj = 
  43. +SLN = ln -s
  44. +RMS = rm -f
  45. +
  46. +libs = -ldbm -lm 
  47. +
  48. +public = perl taintperl 
  49. +
  50. +shellflags = 
  51. +
  52. +# To use an alternate make, set  in config.sh.
  53. +MAKE = make
  54. +
  55. +
  56. +CCCMD = `sh $(shellflags) cflags $@`
  57. +
  58. +private = 
  59. +
  60. +scripts = h2ph
  61. +
  62. +manpages = perl.man h2ph.man
  63. +
  64. +util =
  65. +
  66. +sh = Makefile.SH makedepend.SH h2ph.SH
  67. +
  68. +h1 = EXTERN.h INTERN.h arg.h array.h cmd.h config.h form.h handy.h
  69. +h2 = hash.h perl.h regcomp.h regexp.h spat.h stab.h str.h util.h
  70. +
  71. +h = $(h1) $(h2)
  72. +
  73. +c1 = array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c
  74. +c2 = eval.c form.c hash.c $(mallocsrc) perl.c regcomp.c regexec.c
  75. +c3 = stab.c str.c toke.c util.c usersub.c
  76. +
  77. +c = $(c1) $(c2) $(c3)
  78. +
  79. +s1 = array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c
  80. +s2 = eval.c form.c hash.c perl.c regcomp.c regexec.c
  81. +s3 = stab.c str.c toke.c util.c usersub.c perly.c
  82. +
  83. +saber = $(s1) $(s2) $(s3)
  84. +
  85. +obj1 = array.o cmd.o cons.o consarg.o doarg.o doio.o dolist.o dump.o
  86. +obj2 = eval.o form.o $(mallocobj) perl.o regcomp.o regexec.o
  87. +obj3 = stab.o str.o toke.o util.o
  88. +
  89. +obj = $(obj1) $(obj2) $(obj3)
  90. +
  91. +tobj1 = tarray.o tcmd.o tcons.o tconsarg.o tdoarg.o tdoio.o tdolist.o tdump.o
  92. +tobj2 = teval.o tform.o thash.o $(mallocobj) tregcomp.o tregexec.o
  93. +tobj3 = tstab.o tstr.o ttoke.o tutil.o
  94. +
  95. +tobj = $(tobj1) $(tobj2) $(tobj3)
  96. +
  97. +lintflags = -hbvxac
  98. +
  99. +addedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7
  100. +
  101. +# grrr
  102. +SHELL = /bin/sh
  103. +
  104. +.c.o:
  105. +    $(CCCMD) $*.c
  106. +
  107. +all: $(public) $(private) $(util) uperl.o $(scripts)
  108. +    cd x2p; $(MAKE) all
  109. +    touch all
  110. +
  111. +# This is the standard version that contains no "taint" checks and is
  112. +# used for all scripts that aren't set-id or running under something set-id.
  113. +# The $& notation is tells Sequent machines that it can do a parallel make,
  114. +# and is harmless otherwise.
  115. +
  116. +perl: $& perly.o $(obj) hash.o usersub.o
  117. +    $(CC) $(LARGE) $(CLDFLAGS) $(obj) hash.o perly.o usersub.o $(libs) -o perl
  118. +
  119. +# This command assumes that /usr/include/dbz.h and /usr/lib/dbz.o exist.
  120. +
  121. +dbzperl: $& perly.o $(obj) zhash.o usersub.o
  122. +    $(CC) $(LARGE) $(CLDFLAGS) $(obj) zhash.o /usr/lib/dbz.o perly.o usersub.o $(libs) -o dbzperl
  123. +
  124. +zhash.o: hash.c $(h)
  125. +    $(RMS) zhash.c
  126. +    $(SLN) hash.c zhash.c
  127. +    $(CCCMD) -DWANT_DBZ zhash.c
  128. +    $(RMS) zhash.c
  129. +
  130. +uperl.o: $& perly.o $(obj) hash.o
  131. +    -ld $(LARGE) $(LDFLAGS) -r $(obj) hash.o perly.o -o uperl.o
  132. +
  133. +saber: $(saber)
  134. +    # load $(saber)
  135. +    # load /lib/libm.a
  136. +
  137. +# This version, if specified in Configure, does ONLY those scripts which need
  138. +# set-id emulation.  Suidperl must be setuid root.  It contains the "taint"
  139. +# checks as well as the special code to validate that the script in question
  140. +# has been invoked correctly.
  141. +
  142. +suidperl: $& tperly.o sperl.o $(tobj) usersub.o
  143. +    $(CC) $(LARGE) $(CLDFLAGS) sperl.o $(tobj) tperly.o usersub.o $(libs) \
  144. +        -o suidperl
  145. +
  146. +# This version interprets scripts that are already set-id either via a wrapper
  147. +# or through the kernel allowing set-id scripts (bad idea).  Taintperl must
  148. +# NOT be setuid to root or anything else.  The only difference between it
  149. +# and normal perl is the presence of the "taint" checks.
  150. +
  151. +taintperl: $& tperly.o tperl.o $(tobj) usersub.o
  152. +    $(CC) $(LARGE) $(CLDFLAGS) tperl.o $(tobj) tperly.o usersub.o $(libs) \
  153. +        -o taintperl
  154. +
  155. +# Replicating all this junk is yucky, but I don't see a portable way to fix it.
  156. +
  157. +tperly.o: perly.c perly.h $(h)
  158. +    $(RMS) tperly.c
  159. +    $(SLN) perly.c tperly.c
  160. +    $(CCCMD) -DTAINT tperly.c
  161. +    $(RMS) tperly.c
  162. +
  163. +tperl.o: perl.c perly.h patchlevel.h perl.h $(h)
  164. +    $(RMS) tperl.c
  165. +    $(SLN) perl.c tperl.c
  166. +    $(CCCMD) -DTAINT tperl.c
  167. +    $(RMS) tperl.c
  168. +
  169. +sperl.o: perl.c perly.h patchlevel.h $(h)
  170. +    $(RMS) sperl.c
  171. +    $(SLN) perl.c sperl.c
  172. +    $(CCCMD) -DTAINT -DIAMSUID sperl.c
  173. +    $(RMS) sperl.c
  174. +
  175. +tarray.o: array.c $(h)
  176. +    $(RMS) tarray.c
  177. +    $(SLN) array.c tarray.c
  178. +    $(CCCMD) -DTAINT tarray.c
  179. +    $(RMS) tarray.c
  180. +
  181. +tcmd.o: cmd.c $(h)
  182. +    $(RMS) tcmd.c
  183. +    $(SLN) cmd.c tcmd.c
  184. +    $(CCCMD) -DTAINT tcmd.c
  185. +    $(RMS) tcmd.c
  186. +
  187. +tcons.o: cons.c $(h) perly.h
  188. +    $(RMS) tcons.c
  189. +    $(SLN) cons.c tcons.c
  190. +    $(CCCMD) -DTAINT tcons.c
  191. +    $(RMS) tcons.c
  192. +
  193. +tconsarg.o: consarg.c $(h)
  194. +    $(RMS) tconsarg.c
  195. +    $(SLN) consarg.c tconsarg.c
  196. +    $(CCCMD) -DTAINT tconsarg.c
  197. +    $(RMS) tconsarg.c
  198. +
  199. +tdoarg.o: doarg.c $(h)
  200. +    $(RMS) tdoarg.c
  201. +    $(SLN) doarg.c tdoarg.c
  202. +    $(CCCMD) -DTAINT tdoarg.c
  203. +    $(RMS) tdoarg.c
  204. +
  205. +tdoio.o: doio.c $(h)
  206. +    $(RMS) tdoio.c
  207. +    $(SLN) doio.c tdoio.c
  208. +    $(CCCMD) -DTAINT tdoio.c
  209. +    $(RMS) tdoio.c
  210. +
  211. +tdolist.o: dolist.c $(h)
  212. +    $(RMS) tdolist.c
  213. +    $(SLN) dolist.c tdolist.c
  214. +    $(CCCMD) -DTAINT tdolist.c
  215. +    $(RMS) tdolist.c
  216. +
  217. +tdump.o: dump.c $(h)
  218. +    $(RMS) tdump.c
  219. +    $(SLN) dump.c tdump.c
  220. +    $(CCCMD) -DTAINT tdump.c
  221. +    $(RMS) tdump.c
  222. +
  223. +teval.o: eval.c $(h)
  224. +    $(RMS) teval.c
  225. +    $(SLN) eval.c teval.c
  226. +    $(CCCMD) -DTAINT teval.c
  227. +    $(RMS) teval.c
  228. +
  229. +tform.o: form.c $(h)
  230. +    $(RMS) tform.c
  231. +    $(SLN) form.c tform.c
  232. +    $(CCCMD) -DTAINT tform.c
  233. +    $(RMS) tform.c
  234. +
  235. +thash.o: hash.c $(h)
  236. +    $(RMS) thash.c
  237. +    $(SLN) hash.c thash.c
  238. +    $(CCCMD) -DTAINT thash.c
  239. +    $(RMS) thash.c
  240. +
  241. +tregcomp.o: regcomp.c $(h)
  242. +    $(RMS) tregcomp.c
  243. +    $(SLN) regcomp.c tregcomp.c
  244. +    $(CCCMD) -DTAINT tregcomp.c
  245. +    $(RMS) tregcomp.c
  246. +
  247. +tregexec.o: regexec.c $(h)
  248. +    $(RMS) tregexec.c
  249. +    $(SLN) regexec.c tregexec.c
  250. +    $(CCCMD) -DTAINT tregexec.c
  251. +    $(RMS) tregexec.c
  252. +
  253. +tstab.o: stab.c $(h)
  254. +    $(RMS) tstab.c
  255. +    $(SLN) stab.c tstab.c
  256. +    $(CCCMD) -DTAINT tstab.c
  257. +    $(RMS) tstab.c
  258. +
  259. +tstr.o: str.c $(h) perly.h
  260. +    $(RMS) tstr.c
  261. +    $(SLN) str.c tstr.c
  262. +    $(CCCMD) -DTAINT tstr.c
  263. +    $(RMS) tstr.c
  264. +
  265. +ttoke.o: toke.c $(h) perly.h
  266. +    $(RMS) ttoke.c
  267. +    $(SLN) toke.c ttoke.c
  268. +    $(CCCMD) -DTAINT ttoke.c
  269. +    $(RMS) ttoke.c
  270. +
  271. +tutil.o: util.c $(h)
  272. +    $(RMS) tutil.c
  273. +    $(SLN) util.c tutil.c
  274. +    $(CCCMD) -DTAINT tutil.c
  275. +    $(RMS) tutil.c
  276. +
  277. +perly.h: perly.c
  278. +    @ echo Dummy dependency for dumb parallel make
  279. +    touch perly.h
  280. +
  281. +perly.c: perly.y perly.fixer
  282. +    @ \
  283. +case "$(YACC)" in \
  284. +    *bison*) echo 'Expect' 25 shift/reduce and 59 reduce/reduce conflicts;; \
  285. +    *) echo 'Expect' 27 shift/reduce and 57 reduce/reduce conflicts;; \
  286. +esac
  287. +    $(YACC) -d perly.y
  288. +    sh $(shellflags) ./perly.fixer y.tab.c perly.c
  289. +    mv y.tab.h perly.h
  290. +    echo 'extern YYSTYPE yylval;' >>perly.h
  291. +
  292. +perly.o: perly.c perly.h $(h)
  293. +    $(CCCMD) perly.c
  294. +
  295. +install: all
  296. +    ./perl installperl
  297. +
  298. +clean:
  299. +    rm -f *.o all perl taintperl suidperl perly.c
  300. +    cd x2p; $(MAKE) clean
  301. +
  302. +realclean: clean
  303. +    cd x2p; $(MAKE) realclean
  304. +    rm -f *.orig */*.orig *~ */*~ core $(addedbyconf) h2ph h2ph.man
  305. +    rm -f perly.c perly.h t/perl Makefile config.h makedepend makedir
  306. +    rm -f makefile x2p/Makefile x2p/makefile cflags x2p/cflags
  307. +    rm -f c2ph pstruct
  308. +
  309. +# The following lint has practically everything turned on.  Unfortunately,
  310. +# you have to wade through a lot of mumbo jumbo that can't be suppressed.
  311. +# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message
  312. +# for that spot.
  313. +
  314. +lint: perly.c $(c)
  315. +    lint $(lintflags) $(defs) perly.c $(c) > perl.fuzz
  316. +
  317. +depend: makedepend
  318. +    - test -f perly.h || cp /dev/null perly.h
  319. +    ./makedepend
  320. +    - test -s perly.h || /bin/rm -f perly.h
  321. +    cd x2p; $(MAKE) depend
  322. +
  323. +test: perl
  324. +    - cd t && chmod +x TEST */*.t
  325. +    - cd t && (rm -f perl; $(SLN) ../perl perl) && ./perl TEST </dev/tty
  326. +
  327. +clist:
  328. +    echo $(c) | tr ' ' '\012' >.clist
  329. +
  330. +hlist:
  331. +    echo $(h) | tr ' ' '\012' >.hlist
  332. +
  333. +shlist:
  334. +    echo $(sh) | tr ' ' '\012' >.shlist
  335. +
  336. +# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
  337. +$(obj) hash.o:
  338. +    @ echo "You haven't done a "'"make depend" yet!'; exit 1
  339. +makedepend: makedepend.SH
  340. +    /bin/sh $(shellflags) makedepend.SH
  341. diff -u --new-file --recursive perl-4.036.orig/c2ph perl-4.036/c2ph
  342. --- perl-4.036.orig/c2ph    Wed Dec 31 18:00:00 1969
  343. +++ perl-4.036/c2ph    Tue Jan 17 21:16:27 1995
  344. @@ -0,0 +1,1071 @@
  345. +#!/usr/bin/perl
  346. +#
  347. +#
  348. +#   c2ph (aka pstruct)
  349. +#   Tom Christiansen, <tchrist@convex.com>
  350. +#   
  351. +#   As pstruct, dump C structures as generated from 'cc -g -S' stabs.
  352. +#   As c2ph, do this PLUS generate perl code for getting at the structures.
  353. +#
  354. +#   See the usage message for more.  If this isn't enough, read the code.
  355. +#
  356. +
  357. +$RCSID = '$RCSfile: c2ph.SH,v $$Revision: 4.0.1.2 $$Date: 92/06/08 11:56:08 $';
  358. +
  359. +
  360. +######################################################################
  361. +
  362. +# some handy data definitions.   many of these can be reset later.
  363. +
  364. +$bitorder = 'b';  # ascending; set to B for descending bit fields
  365. +
  366. +%intrinsics = 
  367. +%template = (
  368. +    'char',             'c',
  369. +    'unsigned char',         'C',
  370. +    'short',            's',
  371. +    'short int',        's',
  372. +    'unsigned short',        'S',
  373. +    'unsigned short int',    'S',
  374. +    'short unsigned int',    'S',
  375. +    'int',            'i',
  376. +    'unsigned int',        'I',
  377. +    'long',            'l',
  378. +    'long int',            'l',
  379. +    'unsigned long',        'L',
  380. +    'unsigned long',        'L',
  381. +    'long unsigned int',    'L',
  382. +    'unsigned long int',    'L',
  383. +    'long long',        'q',
  384. +    'long long int',        'q',
  385. +    'unsigned long long',    'Q',
  386. +    'unsigned long long int',    'Q',
  387. +    'float',            'f',
  388. +    'double',            'd',
  389. +    'pointer',            'p',
  390. +    'null',            'x',
  391. +    'neganull',            'X',
  392. +    'bit',            $bitorder,
  393. +); 
  394. +
  395. +&buildscrunchlist;
  396. +delete $intrinsics{'neganull'};
  397. +delete $intrinsics{'bit'};
  398. +delete $intrinsics{'null'};
  399. +
  400. +# use -s to recompute sizes
  401. +%sizeof = (
  402. +    'char',             '1',
  403. +    'unsigned char',         '1',
  404. +    'short',            '2',
  405. +    'short int',        '2',
  406. +    'unsigned short',        '2',
  407. +    'unsigned short int',    '2',
  408. +    'short unsigned int',    '2',
  409. +    'int',            '4',
  410. +    'unsigned int',        '4',
  411. +    'long',            '4',
  412. +    'long int',            '4',
  413. +    'unsigned long',        '4',
  414. +    'unsigned long int',    '4',
  415. +    'long unsigned int',    '4',
  416. +    'long long',        '8',
  417. +    'long long int',        '8',
  418. +    'unsigned long long',    '8',
  419. +    'unsigned long long int',    '8',
  420. +    'float',            '4',
  421. +    'double',            '8',
  422. +    'pointer',            '4',
  423. +);
  424. +
  425. +($type_width, $member_width, $offset_width, $size_width) = (20, 20, 6, 5);
  426. +
  427. +($offset_fmt, $size_fmt) = ('d', 'd');
  428. +
  429. +$indent = 2;
  430. +
  431. +$CC = 'cc';
  432. +$CFLAGS = '-g -S';
  433. +$DEFINES = '';
  434. +
  435. +$perl++ if $0 =~ m#/?c2ph$#;
  436. +
  437. +require 'getopts.pl';
  438. +
  439. +eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
  440. +
  441. +&Getopts('aixdpvtnws:') || &usage(0);
  442. +
  443. +$opt_d && $debug++;
  444. +$opt_t && $trace++;
  445. +$opt_p && $perl++;
  446. +$opt_v && $verbose++;
  447. +$opt_n && ($perl = 0);
  448. +
  449. +if ($opt_w) {
  450. +    ($type_width, $member_width, $offset_width) = (45, 35, 8);
  451. +} 
  452. +if ($opt_x) {
  453. +    ($offset_fmt, $offset_width, $size_fmt, $size_width) = ( 'x', '08', 'x', 04 );
  454. +}
  455. +
  456. +eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
  457. +
  458. +sub PLUMBER {
  459. +    select(STDERR);
  460. +    print "oops, apperent pager foulup\n";
  461. +    $isatty++;
  462. +    &usage(1);
  463. +} 
  464. +
  465. +sub usage {
  466. +    local($oops) = @_;
  467. +    unless (-t STDOUT) {
  468. +    select(STDERR);
  469. +    } elsif (!$oops) {
  470. +    $isatty++;
  471. +    $| = 1;
  472. +    print "hit <RETURN> for further explanation: ";
  473. +    <STDIN>;
  474. +    open (PIPE, "|". ($ENV{PAGER} || 'more'));
  475. +    $SIG{PIPE} = PLUMBER;
  476. +    select(PIPE);
  477. +    } 
  478. +
  479. +    print "usage: $0 [-dpnP] [var=val] [files ...]\n";
  480. +
  481. +    exit unless $isatty;
  482. +
  483. +    print <<EOF;
  484. +
  485. +Options:
  486. +
  487. +-w    wide; short for: type_width=45 member_width=35 offset_width=8
  488. +-x    hex; short for:  offset_fmt=x offset_width=08 size_fmt=x size_width=04
  489. +
  490. +-n      do not generate perl code  (default when invoked as pstruct)
  491. +-p      generate perl code         (default when invoked as c2ph)
  492. +-v    generate perl code, with C decls as comments
  493. +
  494. +-i    do NOT recompute sizes for intrinsic datatypes
  495. +-a    dump information on intrinsics also
  496. +
  497. +-t     trace execution
  498. +-d    spew reams of debugging output
  499. +
  500. +-slist  give comma-separated list a structures to dump
  501. +
  502. +
  503. +Var Name        Default Value    Meaning
  504. +
  505. +EOF
  506. +
  507. +    &defvar('CC', 'which_compiler to call');
  508. +    &defvar('CFLAGS', 'how to generate *.s files with stabs');
  509. +    &defvar('DEFINES','any extra cflags or cpp defines, like -I, -D, -U');
  510. +
  511. +    print "\n";
  512. +
  513. +    &defvar('type_width', 'width of type field   (column 1)');
  514. +    &defvar('member_width', 'width of member field (column 2)');
  515. +    &defvar('offset_width', 'width of offset field (column 3)');
  516. +    &defvar('size_width', 'width of size field   (column 4)');
  517. +
  518. +    print "\n";
  519. +
  520. +    &defvar('offset_fmt', 'sprintf format type for offset');
  521. +    &defvar('size_fmt', 'sprintf format type for size');
  522. +
  523. +    print "\n";
  524. +
  525. +    &defvar('indent', 'how far to indent each nesting level');
  526. +
  527. +   print <<'EOF';
  528. +
  529. +    If any *.[ch] files are given, these will be catted together into
  530. +    a temporary *.c file and sent through:
  531. +        $CC $CFLAGS $DEFINES 
  532. +    and the resulting *.s groped for stab information.  If no files are
  533. +    supplied, then stdin is read directly with the assumption that it
  534. +    contains stab information.  All other liens will be ignored.  At
  535. +    most one *.s file should be supplied.
  536. +
  537. +EOF
  538. +    close PIPE;
  539. +    exit 1;
  540. +} 
  541. +
  542. +sub defvar {
  543. +    local($var, $msg) = @_;
  544. +    printf "%-16s%-15s  %s\n", $var, eval "\$$var", $msg;
  545. +} 
  546. +
  547. +$recurse = 1;
  548. +
  549. +if (@ARGV) {
  550. +    if (grep(!/\.[csh]$/,@ARGV)) {
  551. +    warn "Only *.[csh] files expected!\n";
  552. +    &usage;
  553. +    } 
  554. +    elsif (grep(/\.s$/,@ARGV)) {
  555. +    if (@ARGV > 1) { 
  556. +        warn "Only one *.s file allowed!\n";
  557. +        &usage;
  558. +    }
  559. +    } 
  560. +    elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) {
  561. +    local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#;
  562. +    $chdir = "cd $dir; " if $dir;
  563. +    &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1;
  564. +    $ARGV[0] =~ s/\.c$/.s/;
  565. +    } 
  566. +    else {
  567. +    $TMP = "/tmp/c2ph.$$.c";
  568. +    &system("cat @ARGV > $TMP") && exit 1;
  569. +    &system("cd /tmp; $CC $CFLAGS $DEFINES $TMP") && exit 1;
  570. +    unlink $TMP;
  571. +    $TMP =~ s/\.c$/.s/;
  572. +    @ARGV = ($TMP);
  573. +    } 
  574. +}
  575. +
  576. +if ($opt_s) {
  577. +    for (split(/[\s,]+/, $opt_s)) {
  578. +    $interested{$_}++;
  579. +    } 
  580. +} 
  581. +
  582. +
  583. +$| = 1 if $debug;
  584. +
  585. +main: {
  586. +
  587. +    if ($trace) {
  588. +    if (-t && !@ARGV) { 
  589. +        print STDERR "reading from your keyboard: ";
  590. +    } else {
  591. +        print STDERR "reading from " . (@ARGV ? "@ARGV" : "<STDIN>").": ";
  592. +    }
  593. +    }
  594. +
  595. +STAB: while (<>) {
  596. +    if ($trace && !($. % 10)) {
  597. +        $lineno = $..'';
  598. +        print STDERR $lineno, "\b" x length($lineno);
  599. +    } 
  600. +    next unless /^\s*\.stabs\s+/;
  601. +    $line = $_;
  602. +    s/^\s*\.stabs\s+//; 
  603. +    &stab; 
  604. +    }
  605. +    print STDERR "$.\n" if $trace;
  606. +    unlink $TMP if $TMP;
  607. +
  608. +    &compute_intrinsics if $perl && !$opt_i;
  609. +
  610. +    print STDERR "resolving types\n" if $trace;
  611. +
  612. +    &resolve_types;
  613. +    &adjust_start_addrs;
  614. +
  615. +    $sum = 2 + $type_width + $member_width;
  616. +    $pmask1 = "%-${type_width}s %-${member_width}s"; 
  617. +    $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s";
  618. +
  619. +    if ($perl) {
  620. +    # resolve template -- should be in stab define order, but even this isn't enough.
  621. +    print STDERR "\nbuilding type templates: " if $trace;
  622. +    for $i (reverse 0..$#type) {
  623. +        next unless defined($name = $type[$i]);
  624. +        next unless defined $struct{$name};
  625. +        $build_recursed = 0;
  626. +        &build_template($name) unless defined $template{&psou($name)} ||
  627. +                    $opt_s && !$interested{$name};
  628. +    } 
  629. +    print STDERR "\n\n" if $trace;
  630. +    }
  631. +
  632. +    print STDERR "dumping structs: " if $trace;
  633. +
  634. +
  635. +    foreach $name (sort keys %struct) {
  636. +    next if $opt_s && !$interested{$name};
  637. +    print STDERR "$name " if $trace;
  638. +
  639. +    undef @sizeof;
  640. +    undef @typedef;
  641. +    undef @offsetof;
  642. +    undef @indices;
  643. +    undef @typeof;
  644. +
  645. +    $mname = &munge($name);
  646. +
  647. +    $fname = &psou($name);
  648. +
  649. +    print "# " if $perl && $verbose;
  650. +    $pcode = '';
  651. +    print "$fname {\n" if !$perl || $verbose; 
  652. +    $template{$fname} = &scrunch($template{$fname}) if $perl;
  653. +    &pstruct($name,$name,0); 
  654. +    print "# " if $perl && $verbose;
  655. +    print "}\n" if !$perl || $verbose; 
  656. +    print "\n" if $perl && $verbose;
  657. +
  658. +    if ($perl) {
  659. +        print "$pcode";
  660. +
  661. +        printf("\nsub %-32s { %4d; }\n\n", "${mname}'struct", $countof{$name});
  662. +
  663. +        print <<EOF;
  664. +sub ${mname}'typedef { 
  665. +    local(\$${mname}'index) = shift;
  666. +    defined \$${mname}'index 
  667. +    ? \$${mname}'typedef[\$${mname}'index] 
  668. +    : \$${mname}'typedef;
  669. +}
  670. +EOF
  671. +
  672. +        print <<EOF;
  673. +sub ${mname}'sizeof { 
  674. +    local(\$${mname}'index) = shift;
  675. +    defined \$${mname}'index 
  676. +    ? \$${mname}'sizeof[\$${mname}'index] 
  677. +    : \$${mname}'sizeof;
  678. +}
  679. +EOF
  680. +
  681. +        print <<EOF;
  682. +sub ${mname}'offsetof { 
  683. +    local(\$${mname}'index) = shift;
  684. +    defined \$${mname}index 
  685. +    ? \$${mname}'offsetof[\$${mname}'index] 
  686. +    : \$${mname}'sizeof;
  687. +}
  688. +EOF
  689. +
  690. +        print <<EOF;
  691. +sub ${mname}'typeof { 
  692. +    local(\$${mname}'index) = shift;
  693. +    defined \$${mname}index 
  694. +    ? \$${mname}'typeof[\$${mname}'index] 
  695. +    : '$name';
  696. +}
  697. +EOF
  698. +    
  699. +
  700. +        print "\$${mname}'typedef = '" . &scrunch($template{$fname}) 
  701. +        . "';\n";
  702. +
  703. +        print "\$${mname}'sizeof = $sizeof{$name};\n\n";
  704. +
  705. +
  706. +        print "\@${mname}'indices = (", &squishseq(@indices), ");\n";
  707. +
  708. +        print "\n";
  709. +
  710. +        print "\@${mname}'typedef[\@${mname}'indices] = (",
  711. +            join("\n\t", '', @typedef), "\n    );\n\n";
  712. +        print "\@${mname}'sizeof[\@${mname}'indices] = (",
  713. +            join("\n\t", '', @sizeof), "\n    );\n\n";
  714. +        print "\@${mname}'offsetof[\@${mname}'indices] = (",
  715. +            join("\n\t", '', @offsetof), "\n    );\n\n";
  716. +        print "\@${mname}'typeof[\@${mname}'indices] = (",
  717. +            join("\n\t", '', @typeof), "\n    );\n\n";
  718. +
  719. +        $template_printed{$fname}++;
  720. +        $size_printed{$fname}++;
  721. +    } 
  722. +    print "\n";
  723. +    }
  724. +
  725. +    print STDERR "\n" if $trace;
  726. +
  727. +    unless ($perl && $opt_a) { 
  728. +    print "\n1;\n";
  729. +    exit;
  730. +    }
  731. +
  732. +
  733. +
  734. +    foreach $name (sort bysizevalue keys %intrinsics) {
  735. +    next if $size_printed{$name};
  736. +    print '$',&munge($name),"'sizeof = ", $sizeof{$name}, ";\n";
  737. +    }
  738. +
  739. +    print "\n";
  740. +
  741. +    sub bysizevalue { $sizeof{$a} <=> $sizeof{$b}; }
  742. +
  743. +
  744. +    foreach $name (sort keys %intrinsics) {
  745. +    print '$',&munge($name),"'typedef = '", $template{$name}, "';\n";
  746. +    }
  747. +
  748. +    print "\n1;\n";
  749. +    
  750. +    exit;
  751. +}
  752. +
  753. +########################################################################################
  754. +
  755. +
  756. +sub stab {
  757. +    next unless /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/;  # (\d+,\d+) is for sun
  758. +    s/"//                         || next;
  759. +    s/",([x\d]+),([x\d]+),([x\d]+),.*//         || next;
  760. +
  761. +    next if /^\s*$/;
  762. +
  763. +    $size = $3 if $3;
  764. +
  765. +
  766. +    $line = $_;
  767. +
  768. +    if (($name, $pdecl) = /^([\$ \w]+):[tT]((\d+)(=[rufs*](\d+))+)$/) {
  769. +    print "$name is a typedef for some funky pointers: $pdecl\n" if $debug;
  770. +    &pdecl($pdecl);
  771. +    next;
  772. +    }
  773. +
  774. +
  775. +
  776. +    if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) {  
  777. +    local($ident) = $2;
  778. +    push(@intrinsics, $ident);
  779. +    $typeno = &typeno($3);
  780. +    $type[$typeno] = $ident;
  781. +    print STDERR "intrinsic $ident in new type $typeno\n" if $debug; 
  782. +    next;
  783. +    }
  784. +
  785. +    if (($name, $typeordef, $typeno, $extra, $struct, $_) 
  786. +    = /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/) 
  787. +    {
  788. +    $typeno = &typeno($typeno);  # sun foolery
  789. +    } 
  790. +    elsif (/^[\$\w]+:/) {
  791. +    next; # variable
  792. +    }
  793. +    else { 
  794. +    warn "can't grok stab: <$_> in: $line " if $_;
  795. +    next;
  796. +    } 
  797. +
  798. +    #warn "got size $size for $name\n";
  799. +    $sizeof{$name} = $size if $size;
  800. +
  801. +    s/;[-\d]*;[-\d]*;$//;  # we don't care about ranges
  802. +
  803. +    $typenos{$name} = $typeno;
  804. +
  805. +    unless (defined $type[$typeno]) {
  806. +    &panic("type 0??") unless $typeno;
  807. +    $type[$typeno] = $name unless defined $type[$typeno];
  808. +    printf "new type $typeno is $name" if $debug;
  809. +    if ($extra =~ /\*/ && defined $type[$struct]) {
  810. +        print ", a typedef for a pointer to " , $type[$struct] if $debug;
  811. +    }
  812. +    } else {
  813. +    printf "%s is type %d", $name, $typeno if $debug;
  814. +    print ", a typedef for " , $type[$typeno] if $debug;
  815. +    } 
  816. +    print "\n" if $debug;
  817. +    #next unless $extra =~ /[su*]/;
  818. +
  819. +    #$type[$struct] = $name;
  820. +
  821. +    if ($extra =~ /[us*]/) {
  822. +    &sou($name, $extra);
  823. +    $_ = &sdecl($name, $_, 0);
  824. +    }
  825. +    elsif (/^=ar/) {
  826. +    print "it's a bare array typedef -- that's pretty sick\n" if $debug;
  827. +    $_ = "$typeno$_";
  828. +    $scripts = '';
  829. +    $_ = &adecl($_,1);
  830. +
  831. +    }
  832. +    elsif (s/((\w+):t(\d+|\(\d+,\d+\)))?=r?(;\d+;\d+;)?//) {  # the ?'s are for gcc
  833. +    push(@intrinsics, $2);
  834. +    $typeno = &typeno($3);
  835. +    $type[$typeno] = $2;
  836. +    print STDERR "intrinsic $2 in new type $typeno\n" if $debug; 
  837. +    }
  838. +    elsif (s/^=e//) { # blessed by thy compiler; mine won't do this
  839. +    &edecl;
  840. +    } 
  841. +    else {
  842. +    warn "Funny remainder for $name on line $_ left in $line " if $_;
  843. +    } 
  844. +}
  845. +
  846. +sub typeno {  # sun thinks types are (0,27) instead of just 27
  847. +    local($_) = @_;
  848. +    s/\(\d+,(\d+)\)/$1/;
  849. +    $_;
  850. +} 
  851. +
  852. +sub pstruct {
  853. +    local($what,$prefix,$base) = @_; 
  854. +    local($field, $fieldname, $typeno, $count, $offset, $entry); 
  855. +    local($fieldtype);
  856. +    local($type, $tname); 
  857. +    local($mytype, $mycount, $entry2);
  858. +    local($struct_count) = 0;
  859. +    local($pad, $revpad, $length, $prepad, $lastoffset, $lastlength, $fmt);
  860. +    local($bits,$bytes);
  861. +    local($template);
  862. +
  863. +
  864. +    local($mname) = &munge($name);
  865. +
  866. +    sub munge { 
  867. +    local($_) = @_;
  868. +    s/[\s\$\.]/_/g;
  869. +    $_;
  870. +    }
  871. +
  872. +    local($sname) = &psou($what);
  873. +
  874. +    $nesting++;
  875. +
  876. +    for $field (split(/;/, $struct{$what})) {
  877. +    $pad = $prepad = 0;
  878. +    $entry = ''; 
  879. +    ($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field); 
  880. +
  881. +    $type = $type[$typeno];
  882. +
  883. +    $type =~ /([^[]*)(\[.*\])?/;
  884. +    $mytype = $1;
  885. +    $count .= $2;
  886. +    $fieldtype = &psou($mytype);
  887. +
  888. +    local($fname) = &psou($name);
  889. +
  890. +    if ($build_templates) {
  891. +
  892. +        $pad = ($offset - ($lastoffset + $lastlength))/8 
  893. +        if defined $lastoffset;
  894. +
  895. +        if (! $finished_template{$sname}) {
  896. +        if ($isaunion{$what}) {
  897. +            $template{$sname} .= 'X' x $revpad . ' '    if $revpad;
  898. +        } else {
  899. +            $template{$sname} .= 'x' x $pad    . ' '    if $pad;
  900. +        }
  901. +        }
  902. +
  903. +        $template = &fetch_template($type) x 
  904. +                ($count ? &scripts2count($count) : 1);
  905. +
  906. +        if (! $finished_template{$sname}) {
  907. +        $template{$sname} .= $template;
  908. +        }
  909. +
  910. +        $revpad = $length/8 if $isaunion{$what};
  911. +
  912. +        ($lastoffset, $lastlength) = ($offset, $length);
  913. +
  914. +    } else { 
  915. +        print '# ' if $perl && $verbose;
  916. +        $entry = sprintf($pmask1,
  917. +            ' ' x ($nesting * $indent) . $fieldtype,
  918. +            "$prefix.$fieldname" . $count); 
  919. +
  920. +        $entry =~ s/(\*+)( )/$2$1/; 
  921. +
  922. +        printf $pmask2,
  923. +            $entry,
  924. +            ($base+$offset)/8,
  925. +            ($bits = ($base+$offset)%8) ? ".$bits" : "  ",
  926. +            $length/8,
  927. +            ($bits = $length % 8) ? ".$bits": ""
  928. +            if !$perl || $verbose;
  929. +
  930. +
  931. +        if ($perl && $nesting == 1) {
  932. +        $template = &scrunch(&fetch_template($type) x 
  933. +                ($count ? &scripts2count($count) : 1));
  934. +        push(@sizeof, int($length/8) .",\t# $fieldname");
  935. +        push(@offsetof, int($offset/8) .",\t# $fieldname");
  936. +        push(@typedef, "'$template', \t# $fieldname");
  937. +        $type =~ s/(struct|union) //;
  938. +        push(@typeof, "'$type" . ($count ? $count : '') .
  939. +            "',\t# $fieldname");
  940. +        }
  941. +
  942. +        print '  ', ' ' x $indent x $nesting, $template
  943. +                if $perl && $verbose;
  944. +
  945. +        print "\n" if !$perl || $verbose;
  946. +
  947. +    }    
  948. +    if ($perl) {
  949. +        local($mycount) = defined $struct{$mytype} ? $countof{$mytype} : 1;
  950. +        $mycount *= &scripts2count($count) if $count;
  951. +        if ($nesting==1 && !$build_templates) {
  952. +        $pcode .= sprintf("sub %-32s { %4d; }\n", 
  953. +            "${mname}'${fieldname}", $struct_count);
  954. +        push(@indices, $struct_count);
  955. +        }
  956. +        $struct_count += $mycount;
  957. +    } 
  958. +
  959. +
  960. +    &pstruct($type, "$prefix.$fieldname", $base+$offset) 
  961. +        if $recurse && defined $struct{$type}; 
  962. +    }
  963. +
  964. +    $countof{$what} = $struct_count unless defined $countof{$whati};
  965. +
  966. +    $template{$sname} .= '$' if $build_templates;
  967. +    $finished_template{$sname}++;
  968. +
  969. +    if ($build_templates && !defined $sizeof{$name}) {
  970. +    local($fmt) = &scrunch($template{$sname});
  971. +    print STDERR "no size for $name, punting with $fmt..." if $debug;
  972. +    eval '$sizeof{$name} = length(pack($fmt, ()))';
  973. +    if ($@) {
  974. +        chop $@;
  975. +        warn "couldn't get size for \$name: $@";
  976. +    } else {
  977. +        print STDERR $sizeof{$name}, "\n" if $debUg;
  978. +    }
  979. +    } 
  980. +
  981. +    --$nesting;
  982. +}
  983. +
  984. +
  985. +sub psize {
  986. +    local($me) = @_; 
  987. +    local($amstruct) = $struct{$me} ?  'struct ' : '';
  988. +
  989. +    print '$sizeof{\'', $amstruct, $me, '\'} = '; 
  990. +    printf "%d;\n", $sizeof{$me}; 
  991. +}
  992. +
  993. +sub pdecl {
  994. +    local($pdecl) = @_;
  995. +    local(@pdecls);
  996. +    local($tname);
  997. +
  998. +    warn "pdecl: $pdecl\n" if $debug;
  999. +
  1000. +    $pdecl =~ s/\(\d+,(\d+)\)/$1/g;
  1001. +    $pdecl =~ s/\*//g; 
  1002. +    @pdecls = split(/=/, $pdecl); 
  1003. +    $typeno = $pdecls[0];
  1004. +    $tname = pop @pdecls;
  1005. +
  1006. +    if ($tname =~ s/^f//) { $tname = "$tname&"; } 
  1007. +    #else { $tname = "$tname*"; } 
  1008. +
  1009. +    for (reverse @pdecls) {
  1010. +    $tname  .= s/^f// ? "&" : "*"; 
  1011. +    #$tname =~ s/^f(.*)/$1&/;
  1012. +    print "type[$_] is $tname\n" if $debug;
  1013. +    $type[$_] = $tname unless defined $type[$_];
  1014. +    } 
  1015. +}
  1016. +
  1017. +
  1018. +
  1019. +sub adecl {
  1020. +    ($arraytype, $unknown, $lower, $upper) = ();
  1021. +    #local($typeno);
  1022. +    # global $typeno, @type
  1023. +    local($_, $typedef) = @_;
  1024. +
  1025. +    while (s/^((\d+)=)?ar(\d+);//) {
  1026. +    ($arraytype, $unknown) = ($2, $3); 
  1027. +    if (s/^(\d+);(\d+);//) {
  1028. +        ($lower, $upper) = ($1, $2); 
  1029. +        $scripts .= '[' .  ($upper+1) . ']'; 
  1030. +    } else {
  1031. +        warn "can't find array bounds: $_"; 
  1032. +    } 
  1033. +    }
  1034. +    if (s/^([\d*f=]*),(\d+),(\d+);//) {
  1035. +    ($start, $length) = ($2, $3); 
  1036. +    local($whatis) = $1;
  1037. +    if ($whatis =~ /^(\d+)=/) {
  1038. +        $typeno = $1;
  1039. +        &pdecl($whatis);
  1040. +    } else {
  1041. +        $typeno = $whatis;
  1042. +    }
  1043. +    } elsif (s/^(\d+)(=[*suf]\d*)//) {
  1044. +    local($whatis) = $2; 
  1045. +
  1046. +    if ($whatis =~ /[f*]/) {
  1047. +        &pdecl($whatis); 
  1048. +    } elsif ($whatis =~ /[su]/) {  # 
  1049. +        print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n" 
  1050. +        if $debug;
  1051. +        #$type[$typeno] = $name unless defined $type[$typeno];
  1052. +        ##printf "new type $typeno is $name" if $debug;
  1053. +        $typeno = $1;
  1054. +        $type[$typeno] = "$prefix.$fieldname";
  1055. +        local($name) = $type[$typeno];
  1056. +        &sou($name, $whatis);
  1057. +        $_ = &sdecl($name, $_, $start+$offset);
  1058. +        1;
  1059. +        $start = $start{$name};
  1060. +        $offset = $sizeof{$name};
  1061. +        $length = $offset;
  1062. +    } else {
  1063. +        warn "what's this? $whatis in $line ";
  1064. +    } 
  1065. +    } elsif (/^\d+$/) {
  1066. +    $typeno = $_;
  1067. +    } else {
  1068. +    warn "bad array stab: $_ in $line ";
  1069. +    next STAB;
  1070. +    } 
  1071. +    #local($wasdef) = defined($type[$typeno]) && $debug;
  1072. +    #if ($typedef) { 
  1073. +    #print "redefining $type[$typeno] to " if $wasdef;
  1074. +    #$type[$typeno] = "$whatis$scripts"; # unless defined $type[$typeno];
  1075. +    #print "$type[$typeno]\n" if $wasdef;
  1076. +    #} else {
  1077. +    #$type[$arraytype] = $type[$typeno] unless defined $type[$arraytype];
  1078. +    #}
  1079. +    $type[$arraytype] = "$type[$typeno]$scripts" if defined $type[$typeno];
  1080. +    print "type[$arraytype] is $type[$arraytype]\n" if $debug;
  1081. +    print "$prefix.$fieldname is an array of $type[$arraytype]\n" if $debug;
  1082. +    $_;
  1083. +}
  1084. +
  1085. +
  1086. +
  1087. +sub sdecl {
  1088. +    local($prefix, $_, $offset) = @_;
  1089. +
  1090. +    local($fieldname, $scripts, $type, $arraytype, $unknown,
  1091. +    $whatis, $pdecl, $upper,$lower, $start,$length) = ();
  1092. +    local($typeno,$sou);
  1093. +
  1094. +
  1095. +SFIELD:
  1096. +    while (/^([^;]+);/) {
  1097. +    $scripts = '';
  1098. +    warn "sdecl $_\n" if $debug;
  1099. +    if (s/^([\$\w]+)://) { 
  1100. +        $fieldname = $1;
  1101. +    } elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # 
  1102. +        $typeno = &typeno($1);
  1103. +        $type[$typeno] = "$prefix.$fieldname";
  1104. +        local($name) = "$prefix.$fieldname";
  1105. +        &sou($name,$2);
  1106. +        $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
  1107. +        $start = $start{$name};
  1108. +        $offset += $sizeof{$name};
  1109. +        #print "done with anon, start is $start, offset is $offset\n";
  1110. +        #next SFIELD;
  1111. +    } else  {
  1112. +        warn "weird field $_ of $line" if $debug;
  1113. +        next STAB;
  1114. +        #$fieldname = &gensym;
  1115. +        #$_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
  1116. +    }
  1117. +
  1118. +    if (/^\d+=ar/) {
  1119. +        $_ = &adecl($_);
  1120. +    }
  1121. +    elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) {
  1122. +        ($start, $length) =  ($2, $3); 
  1123. +        &panic("no length?") unless $length;
  1124. +        $typeno = &typeno($1) if $1;
  1125. +    }
  1126. +    elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) {
  1127. +        ($pdecl, $start, $length) =  ($1,$5,$6); 
  1128. +        &pdecl($pdecl); 
  1129. +    }
  1130. +    elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct
  1131. +        ($typeno, $sou) = ($1, $2);
  1132. +        $typeno = &typeno($typeno);
  1133. +        if (defined($type[$typeno])) {
  1134. +        warn "now how did we get type $1 in $fieldname of $line?";
  1135. +        } else {
  1136. +        print "anon type $typeno is $prefix.$fieldname\n" if $debug;
  1137. +        $type[$typeno] = "$prefix.$fieldname" unless defined $type[$typeno];
  1138. +        };
  1139. +        local($name) = "$prefix.$fieldname";
  1140. +        &sou($name,$sou);
  1141. +        print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug;
  1142. +        $type[$typeno] = "$prefix.$fieldname";
  1143. +        $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); 
  1144. +        $start = $start{$name};
  1145. +        $length = $sizeof{$name};
  1146. +    }
  1147. +    else {
  1148. +        warn "can't grok stab for $name ($_) in line $line "; 
  1149. +        next STAB; 
  1150. +    }
  1151. +
  1152. +    &panic("no length for $prefix.$fieldname") unless $length;
  1153. +    $struct{$name} .= join(',', $fieldname, $typeno, $scripts, $start, $length) . ';';
  1154. +    }
  1155. +    if (s/;\d*,(\d+),(\d+);//) {
  1156. +    local($start, $size) = ($1, $2); 
  1157. +    $sizeof{$prefix} = $size;
  1158. +    print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug; 
  1159. +    $start{$prefix} = $start; 
  1160. +    } 
  1161. +    $_;
  1162. +}
  1163. +
  1164. +sub edecl {
  1165. +    s/;$//;
  1166. +    $enum{$name} = $_;
  1167. +    $_ = '';
  1168. +} 
  1169. +
  1170. +sub resolve_types {
  1171. +    local($sou);
  1172. +    for $i (0 .. $#type) {
  1173. +    next unless defined $type[$i];
  1174. +    $_ = $type[$i];
  1175. +    unless (/\d/) {
  1176. +        print "type[$i] $type[$i]\n" if $debug;
  1177. +        next;
  1178. +    }
  1179. +    print "type[$i] $_ ==> " if $debug;
  1180. +    s/^(\d+)(\**)\&\*(\**)/"$2($3".&type($1) . ')()'/e;
  1181. +    s/^(\d+)\&/&type($1)/e; 
  1182. +    s/^(\d+)/&type($1)/e; 
  1183. +    s/(\*+)([^*]+)(\*+)/$1$3$2/;
  1184. +    s/\((\*+)(\w+)(\*+)\)/$3($1$2)/;
  1185. +    s/^(\d+)([\*\[].*)/&type($1).$2/e;
  1186. +    #s/(\d+)(\*|(\[[\[\]\d\*]+]\])+)/&type($1).$2/ge;
  1187. +    $type[$i] = $_;
  1188. +    print "$_\n" if $debug;
  1189. +    }
  1190. +}
  1191. +sub type { &psou($type[$_[0]] || "<UNDEFINED>"); } 
  1192. +
  1193. +sub adjust_start_addrs {
  1194. +    for (sort keys %start) {
  1195. +    ($basename = $_) =~ s/\.[^.]+$//;
  1196. +    $start{$_} += $start{$basename};
  1197. +    print "start: $_ @ $start{$_}\n" if $debug;
  1198. +    }
  1199. +}
  1200. +
  1201. +sub sou {
  1202. +    local($what, $_) = @_;
  1203. +    /u/ && $isaunion{$what}++;
  1204. +    /s/ && $isastruct{$what}++;
  1205. +}
  1206. +
  1207. +sub psou {
  1208. +    local($what) = @_;
  1209. +    local($prefix) = '';
  1210. +    if ($isaunion{$what})  {
  1211. +    $prefix = 'union ';
  1212. +    } elsif ($isastruct{$what})  {
  1213. +    $prefix = 'struct ';
  1214. +    }
  1215. +    $prefix . $what;
  1216. +}
  1217. +
  1218. +sub scrunch {
  1219. +    local($_) = @_;
  1220. +
  1221. +    study;
  1222. +
  1223. +    s/\$//g;
  1224. +    s/  / /g;
  1225. +    1 while s/(\w) \1/$1$1/g;
  1226. +
  1227. +    # i wanna say this, but perl resists my efforts:
  1228. +    #       s/(\w)(\1+)/$2 . length($1)/ge;
  1229. +
  1230. +    &quick_scrunch;
  1231. +
  1232. +    s/ $//;
  1233. +
  1234. +    $_;
  1235. +}
  1236. +
  1237. +sub buildscrunchlist {
  1238. +    $scrunch_code = "sub quick_scrunch {\n";
  1239. +    for (values %intrinsics) {
  1240. +        $scrunch_code .= "\ts/($_{2,})/'$_' . length(\$1)/ge;\n";
  1241. +    } 
  1242. +    $scrunch_code .= "}\n";
  1243. +    print "$scrunch_code" if $debug;
  1244. +    eval $scrunch_code;
  1245. +    &panic("can't eval scrunch_code $@ \nscrunch_code") if $@;
  1246. +} 
  1247. +
  1248. +sub fetch_template {
  1249. +    local($mytype) = @_;
  1250. +    local($fmt);
  1251. +    local($count) = 1;
  1252. +
  1253. +    &panic("why do you care?") unless $perl;
  1254. +
  1255. +    if ($mytype =~ s/(\[\d+\])+$//) {
  1256. +    $count .= $1;
  1257. +    } 
  1258. +
  1259. +    if ($mytype =~ /\*/) {
  1260. +    $fmt = $template{'pointer'};
  1261. +    } 
  1262. +    elsif (defined $template{$mytype}) {
  1263. +    $fmt = $template{$mytype};
  1264. +    } 
  1265. +    elsif (defined $struct{$mytype}) {
  1266. +    if (!defined $template{&psou($mytype)}) {
  1267. +        &build_template($mytype) unless $mytype eq $name;
  1268. +    } 
  1269. +    elsif ($template{&psou($mytype)} !~ /\$$/) {
  1270. +        #warn "incomplete template for $mytype\n";
  1271. +    } 
  1272. +    $fmt = $template{&psou($mytype)} || '?';
  1273. +    } 
  1274. +    else {
  1275. +    warn "unknown fmt for $mytype\n";
  1276. +    $fmt = '?';
  1277. +    } 
  1278. +
  1279. +    $fmt x $count . ' ';
  1280. +}
  1281. +
  1282. +sub compute_intrinsics {
  1283. +    local($TMP) = "/tmp/c2ph-i.$$.c";
  1284. +    open (TMP, ">$TMP") || die "can't open $TMP: $!";
  1285. +    select(TMP);
  1286. +
  1287. +    print STDERR "computing intrinsic sizes: " if $trace;
  1288. +
  1289. +    undef %intrinsics;
  1290. +
  1291. +    print <<'EOF';
  1292. +main() {
  1293. +    char *mask = "%d %s\n";
  1294. +EOF
  1295. +
  1296. +    for $type (@intrinsics) {
  1297. +    next if $type eq 'void';
  1298. +    print <<"EOF";
  1299. +    printf(mask,sizeof($type), "$type");
  1300. +EOF
  1301. +    } 
  1302. +
  1303. +    print <<'EOF';
  1304. +    printf(mask,sizeof(char *), "pointer");
  1305. +    exit(0);
  1306. +}
  1307. +EOF
  1308. +    close TMP;
  1309. +
  1310. +    select(STDOUT);
  1311. +    open(PIPE, "cd /tmp && $CC $TMP && /tmp/a.out|");
  1312. +    while (<PIPE>) {
  1313. +    chop;
  1314. +    split(' ',$_,2);;
  1315. +    print "intrinsic $_[1] is size $_[0]\n" if $debug;
  1316. +    $sizeof{$_[1]} = $_[0];
  1317. +    $intrinsics{$_[1]} = $template{$_[0]};
  1318. +    } 
  1319. +    close(PIPE) || die "couldn't read intrinsics!";
  1320. +    unlink($TMP, '/tmp/a.out');
  1321. +    print STDERR "done\n" if $trace;
  1322. +} 
  1323. +
  1324. +sub scripts2count {
  1325. +    local($_) = @_;
  1326. +
  1327. +    s/^\[//;
  1328. +    s/\]$//;
  1329. +    s/\]\[/*/g;
  1330. +    $_ = eval;
  1331. +    &panic("$_: $@") if $@;
  1332. +    $_;
  1333. +}
  1334. +
  1335. +sub system {
  1336. +    print STDERR "@_\n" if $trace;
  1337. +    system @_;
  1338. +} 
  1339. +
  1340. +sub build_template { 
  1341. +    local($name) = @_;
  1342. +
  1343. +    &panic("already got a template for $name") if defined $template{$name};
  1344. +
  1345. +    local($build_templates) = 1;
  1346. +
  1347. +    local($lparen) = '(' x $build_recursed;
  1348. +    local($rparen) = ')' x $build_recursed;
  1349. +
  1350. +    print STDERR "$lparen$name$rparen " if $trace;
  1351. +    $build_recursed++;
  1352. +    &pstruct($name,$name,0);
  1353. +    print STDERR "TEMPLATE for $name is ", $template{&psou($name)}, "\n" if $debug;
  1354. +    --$build_recursed;
  1355. +}
  1356. +
  1357. +
  1358. +sub panic {
  1359. +
  1360. +    select(STDERR);
  1361. +
  1362. +    print "\npanic: @_\n";
  1363. +
  1364. +    exit 1 if $] <= 4.003;  # caller broken
  1365. +
  1366. +    local($i,$_);
  1367. +    local($p,$f,$l,$s,$h,$a,@a,@sub);
  1368. +    for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
  1369. +    @a = @DB'args;
  1370. +    for (@a) {
  1371. +        if (/^StB\000/ && length($_) == length($_main{'_main'})) {
  1372. +        $_ = sprintf("%s",$_);
  1373. +        }
  1374. +        else {
  1375. +        s/'/\\'/g;
  1376. +        s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
  1377. +        s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
  1378. +        s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
  1379. +        }
  1380. +    }
  1381. +    $w = $w ? '@ = ' : '$ = ';
  1382. +    $a = $h ? '(' . join(', ', @a) . ')' : '';
  1383. +    push(@sub, "$w&$s$a from file $f line $l\n");
  1384. +    last if $signal;
  1385. +    }
  1386. +    for ($i=0; $i <= $#sub; $i++) {
  1387. +    last if $signal;
  1388. +    print $sub[$i];
  1389. +    }
  1390. +    exit 1;
  1391. +} 
  1392. +
  1393. +sub squishseq {
  1394. +    local($num);
  1395. +    local($last) = -1e8;
  1396. +    local($string);
  1397. +    local($seq) = '..';
  1398. +
  1399. +    while (defined($num = shift)) {
  1400. +        if ($num == ($last + 1)) {
  1401. +            $string .= $seq unless $inseq++;
  1402. +            $last = $num;
  1403. +            next;
  1404. +        } elsif ($inseq) {
  1405. +            $string .= $last unless $last == -1e8;
  1406. +        }
  1407. +
  1408. +        $string .= ',' if defined $string;
  1409. +        $string .= $num;
  1410. +        $last = $num;
  1411. +        $inseq = 0;
  1412. +    }
  1413. +    $string .= $last if $inseq && $last != -e18;
  1414. +    $string;
  1415. +}
  1416. diff -u --new-file --recursive perl-4.036.orig/cflags perl-4.036/cflags
  1417. --- perl-4.036.orig/cflags    Wed Dec 31 18:00:00 1969
  1418. +++ perl-4.036/cflags    Tue Jan 17 21:16:27 1995
  1419. @@ -0,0 +1,91 @@
  1420. +case "$0" in
  1421. +*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
  1422. +esac
  1423. +case $CONFIG in
  1424. +'')
  1425. +    if test ! -f config.sh; then
  1426. +    ln ../config.sh . || \
  1427. +    ln ../../config.sh . || \
  1428. +    ln ../../../config.sh . || \
  1429. +    (echo "Can't find config.sh."; exit 1)
  1430. +    fi 2>/dev/null
  1431. +    . ./config.sh
  1432. +    ;;
  1433. +esac
  1434. +
  1435. +also=': '
  1436. +case $# in
  1437. +1) also='echo 1>&2 "      CCCMD = "'
  1438. +esac
  1439. +
  1440. +case $# in
  1441. +0) set *.c; echo "The current C flags are:" ;;
  1442. +esac
  1443. +
  1444. +set `echo "$* " | sed 's/\.[oc] / /g'`
  1445. +
  1446. +for file do
  1447. +
  1448. +    case "$#" in
  1449. +    1) ;;
  1450. +    *) echo $n "    $file.c    $c" ;;
  1451. +    esac
  1452. +
  1453. +    : allow variables like toke_cflags to be evaluated
  1454. +
  1455. +    eval 'eval ${'"${file}_cflags"'-""}'
  1456. +
  1457. +    : or customize here
  1458. +
  1459. +    case "$file" in
  1460. +    array) ;;
  1461. +    cmd) ;;
  1462. +    cons) ;;
  1463. +    consarg) ;;
  1464. +    doarg) ;;
  1465. +    doio) ;;
  1466. +    dolist) ;;
  1467. +    dump) ;;
  1468. +    eval) ;;
  1469. +    form) ;;
  1470. +    hash) ;;
  1471. +    malloc) ;;
  1472. +    perl) ;;
  1473. +    perly) ;;
  1474. +    regcomp) ;;
  1475. +    regexec) ;;
  1476. +    stab) ;;
  1477. +    str) ;;
  1478. +    toke) ;;
  1479. +    usersub) ;;
  1480. +    util) ;;
  1481. +    tarray) ;;
  1482. +    tcmd) ;;
  1483. +    tcons) ;;
  1484. +    tconsarg) ;;
  1485. +    tdoarg) ;;
  1486. +    tdoio) ;;
  1487. +    tdolist) ;;
  1488. +    tdump) ;;
  1489. +    teval) ;;
  1490. +    tform) ;;
  1491. +    thash) ;;
  1492. +    tmalloc) ;;
  1493. +    tperl) ;;
  1494. +    tperly) ;;
  1495. +    tregcomp) ;;
  1496. +    tregexec) ;;
  1497. +    tstab) ;;
  1498. +    tstr) ;;
  1499. +    ttoke) ;;
  1500. +    tusersub) ;;
  1501. +    tutil) ;;
  1502. +    *) ;;
  1503. +    esac
  1504. +
  1505. +    echo "$cc -c $ccflags $optimize $large $split"
  1506. +    eval "$also "'"$cc -c $ccflags $optimize $large $split"'
  1507. +
  1508. +    . ./config.sh
  1509. +
  1510. +done
  1511. diff -u --new-file --recursive perl-4.036.orig/config.h perl-4.036/config.h
  1512. --- perl-4.036.orig/config.h    Wed Dec 31 18:00:00 1969
  1513. +++ perl-4.036/config.h    Tue Jan 17 21:16:28 1995
  1514. @@ -0,0 +1,892 @@
  1515. +#ifndef config_h
  1516. +#define config_h
  1517. +/* config.h
  1518. + * This file was produced by running the config.h.SH script, which
  1519. + * gets its values from config.sh, which is generally produced by
  1520. + * running Configure.
  1521. + *
  1522. + * Feel free to modify any of this as the need arises.  Note, however,
  1523. + * that running config.h.SH again will wipe out any changes you've made.
  1524. + * For a more permanent change edit config.sh and rerun config.h.SH.
  1525. + */
  1526. + /*SUPPRESS 460*/
  1527. +
  1528. +
  1529. +/* EUNICE
  1530. + *    This symbol, if defined, indicates that the program is being compiled
  1531. + *    under the EUNICE package under VMS.  The program will need to handle
  1532. + *    things like files that don't go away the first time you unlink them,
  1533. + *    due to version numbering.  It will also need to compensate for lack
  1534. + *    of a respectable link() command.
  1535. + */
  1536. +/* VMS
  1537. + *    This symbol, if defined, indicates that the program is running under
  1538. + *    VMS.  It is currently only set in conjunction with the EUNICE symbol.
  1539. + */
  1540. +/*#undef    EUNICE        /**/
  1541. +/*#undef    VMS        /**/
  1542. +
  1543. +/* LOC_SED
  1544. + *     This symbol holds the complete pathname to the sed program.
  1545. + */
  1546. +#define LOC_SED "/usr/bin/sed"             /**/
  1547. +
  1548. +/* ALIGNBYTES
  1549. + *    This symbol contains the number of bytes required to align a double.
  1550. + *    Usual values are 2, 4, and 8.
  1551. + */
  1552. +#define ALIGNBYTES 4        /**/
  1553. +
  1554. +/* BIN
  1555. + *    This symbol holds the name of the directory in which the user wants
  1556. + *    to keep publicly executable images for the package in question.  It
  1557. + *    is most often a local directory such as /usr/local/bin.
  1558. + */
  1559. +#define BIN "/usr/bin"             /**/
  1560. +
  1561. +/* BYTEORDER
  1562. + *    This symbol contains an encoding of the order of bytes in a long.
  1563. + *    Usual values (in hex) are 0x1234, 0x4321, 0x2143, 0x3412...
  1564. + */
  1565. +#define BYTEORDER 0x1234        /**/
  1566. +
  1567. +/* CPPSTDIN
  1568. + *    This symbol contains the first part of the string which will invoke
  1569. + *    the C preprocessor on the standard input and produce to standard
  1570. + *    output.     Typical value of "cc -E" or "/lib/cpp".
  1571. + */
  1572. +/* CPPMINUS
  1573. + *    This symbol contains the second part of the string which will invoke
  1574. + *    the C preprocessor on the standard input and produce to standard
  1575. + *    output.  This symbol will have the value "-" if CPPSTDIN needs a minus
  1576. + *    to specify standard input, otherwise the value is "".
  1577. + */
  1578. +#define CPPSTDIN "cppstdin"
  1579. +#define CPPMINUS ""
  1580. +
  1581. +/* HAS_BCMP
  1582. + *    This symbol, if defined, indicates that the bcmp routine is available
  1583. + *    to compare blocks of memory.  If undefined, use memcmp.  If that's
  1584. + *    not available, roll your own.
  1585. + */
  1586. +#define    HAS_BCMP        /**/
  1587. +
  1588. +/* HAS_BCOPY
  1589. + *    This symbol, if defined, indicates that the bcopy routine is available
  1590. + *    to copy blocks of memory.  Otherwise you should probably use memcpy().
  1591. + *    If neither is defined, roll your own.
  1592. + */
  1593. +/* SAFE_BCOPY
  1594. + *    This symbol, if defined, indicates that the bcopy routine is available
  1595. + *    to copy potentially overlapping copy blocks of bcopy.  Otherwise you
  1596. + *    should probably use memmove() or memcpy().  If neither is defined,
  1597. + *    roll your own.
  1598. + */
  1599. +#define    HAS_BCOPY        /**/
  1600. +#define    SAFE_BCOPY        /**/
  1601. +
  1602. +/* HAS_BZERO
  1603. + *    This symbol, if defined, indicates that the bzero routine is available
  1604. + *    to zero blocks of memory.  Otherwise you should probably use memset()
  1605. + *    or roll your own.
  1606. + */
  1607. +#define    HAS_BZERO        /**/
  1608. +
  1609. +/* CASTNEGFLOAT
  1610. + *    This symbol, if defined, indicates that this C compiler knows how to
  1611. + *    cast negative or large floating point numbers to unsigned longs, ints
  1612. + *    and shorts.
  1613. + */
  1614. +/* CASTFLAGS
  1615. + *    This symbol contains flags that say what difficulties the compiler
  1616. + *    has casting odd floating values to unsigned long:
  1617. + *        1 = couldn't cast < 0
  1618. + *        2 = couldn't cast >= 0x80000000
  1619. + */
  1620. +#define    CASTNEGFLOAT    /**/
  1621. +#define    CASTFLAGS 0    /**/
  1622. +
  1623. +/* CHARSPRINTF
  1624. + *    This symbol is defined if this system declares "char *sprintf()" in
  1625. + *    stdio.h.  The trend seems to be to declare it as "int sprintf()".  It
  1626. + *    is up to the package author to declare sprintf correctly based on the
  1627. + *    symbol.
  1628. + */
  1629. +/*#undef    CHARSPRINTF     /**/
  1630. +
  1631. +/* HAS_CHSIZE
  1632. + *    This symbol, if defined, indicates that the chsize routine is available
  1633. + *    to truncate files.  You might need a -lx to get this routine.
  1634. + */
  1635. +/*#undef    HAS_CHSIZE        /**/
  1636. +
  1637. +/* HAS_CRYPT
  1638. + *    This symbol, if defined, indicates that the crypt routine is available
  1639. + *    to encrypt passwords and the like.
  1640. + */
  1641. +#define    HAS_CRYPT        /**/
  1642. +
  1643. +/* CSH
  1644. + *    This symbol, if defined, indicates that the C-shell exists.
  1645. + *    If defined, contains the full pathname of csh.
  1646. + */
  1647. +#define CSH "/bin/csh"        /**/
  1648. +
  1649. +/* DOSUID
  1650. + *    This symbol, if defined, indicates that the C program should
  1651. + *    check the script that it is executing for setuid/setgid bits, and
  1652. + *    attempt to emulate setuid/setgid on systems that have disabled
  1653. + *    setuid #! scripts because the kernel can't do it securely.
  1654. + *    It is up to the package designer to make sure that this emulation
  1655. + *    is done securely.  Among other things, it should do an fstat on
  1656. + *    the script it just opened to make sure it really is a setuid/setgid
  1657. + *    script, it should make sure the arguments passed correspond exactly
  1658. + *    to the argument on the #! line, and it should not trust any
  1659. + *    subprocesses to which it must pass the filename rather than the
  1660. + *    file descriptor of the script to be executed.
  1661. + */
  1662. +/*#undef DOSUID        /**/
  1663. +
  1664. +/* HAS_DUP2
  1665. + *    This symbol, if defined, indicates that the dup2 routine is available
  1666. + *    to dup file descriptors.  Otherwise you should use dup().
  1667. + */
  1668. +#define    HAS_DUP2        /**/
  1669. +
  1670. +/* HAS_FCHMOD
  1671. + *    This symbol, if defined, indicates that the fchmod routine is available
  1672. + *    to change mode of opened files.  If unavailable, use chmod().
  1673. + */
  1674. +#define    HAS_FCHMOD        /**/
  1675. +
  1676. +/* HAS_FCHOWN
  1677. + *    This symbol, if defined, indicates that the fchown routine is available
  1678. + *    to change ownership of opened files.  If unavailable, use chown().
  1679. + */
  1680. +#define    HAS_FCHOWN        /**/
  1681. +
  1682. +/* HAS_FCNTL
  1683. + *    This symbol, if defined, indicates to the C program that
  1684. + *    the fcntl() function exists.
  1685. + */
  1686. +#define    HAS_FCNTL        /**/
  1687. +
  1688. +/* FLEXFILENAMES
  1689. + *    This symbol, if defined, indicates that the system supports filenames
  1690. + *    longer than 14 characters.
  1691. + */
  1692. +#define    FLEXFILENAMES        /**/
  1693. +
  1694. +/* HAS_FLOCK
  1695. + *    This symbol, if defined, indicates that the flock() routine is
  1696. + *    available to do file locking.
  1697. + */
  1698. +#define    HAS_FLOCK        /**/
  1699. +
  1700. +/* HAS_GETGROUPS
  1701. + *    This symbol, if defined, indicates that the getgroups() routine is
  1702. + *    available to get the list of process groups.  If unavailable, multiple
  1703. + *    groups are probably not supported.
  1704. + */
  1705. +/*#undef    HAS_GETGROUPS        /**/
  1706. +
  1707. +/* HAS_GETHOSTENT
  1708. + *    This symbol, if defined, indicates that the gethostent() routine is
  1709. + *    available to lookup host names in some data base or other.
  1710. + */
  1711. +/*#undef    HAS_GETHOSTENT        /**/
  1712. +
  1713. +/* HAS_GETPGRP
  1714. + *    This symbol, if defined, indicates that the getpgrp() routine is
  1715. + *    available to get the current process group.
  1716. + */
  1717. +#define    HAS_GETPGRP        /**/
  1718. +
  1719. +/* HAS_GETPGRP2
  1720. + *    This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
  1721. + *    routine is available to get the current process group.
  1722. + */
  1723. +/*#undef    HAS_GETPGRP2        /**/
  1724. +
  1725. +/* HAS_GETPRIORITY
  1726. + *    This symbol, if defined, indicates that the getpriority() routine is
  1727. + *    available to get a process's priority.
  1728. + */
  1729. +/*#undef    HAS_GETPRIORITY        /**/
  1730. +
  1731. +/* HAS_HTONS
  1732. + *    This symbol, if defined, indicates that the htons routine (and friends)
  1733. + *    are available to do network order byte swapping.
  1734. + */
  1735. +/* HAS_HTONL
  1736. + *    This symbol, if defined, indicates that the htonl routine (and friends)
  1737. + *    are available to do network order byte swapping.
  1738. + */
  1739. +/* HAS_NTOHS
  1740. + *    This symbol, if defined, indicates that the ntohs routine (and friends)
  1741. + *    are available to do network order byte swapping.
  1742. + */
  1743. +/* HAS_NTOHL
  1744. + *    This symbol, if defined, indicates that the ntohl routine (and friends)
  1745. + *    are available to do network order byte swapping.
  1746. + */
  1747. +/*#undef    HAS_HTONS    /**/
  1748. +/*#undef    HAS_HTONL    /**/
  1749. +/*#undef    HAS_NTOHS    /**/
  1750. +/*#undef    HAS_NTOHL    /**/
  1751. +
  1752. +/* index
  1753. + *    This preprocessor symbol is defined, along with rindex, if the system
  1754. + *    uses the strchr and strrchr routines instead.
  1755. + */
  1756. +/* rindex
  1757. + *    This preprocessor symbol is defined, along with index, if the system
  1758. + *    uses the strchr and strrchr routines instead.
  1759. + */
  1760. +/*#undef    index strchr    /* cultural */
  1761. +/*#undef    rindex strrchr    /*  differences? */
  1762. +
  1763. +/* HAS_ISASCII
  1764. + *    This symbol, if defined, indicates that the isascii routine is available
  1765. + *    to test characters for asciiness.
  1766. + */
  1767. +/*#undef    HAS_ISASCII        /**/
  1768. +
  1769. +/* HAS_KILLPG
  1770. + *    This symbol, if defined, indicates that the killpg routine is available
  1771. + *    to kill process groups.  If unavailable, you probably should use kill
  1772. + *    with a negative process number.
  1773. + */
  1774. +#define    HAS_KILLPG        /**/
  1775. +
  1776. +/* HAS_LSTAT
  1777. + *    This symbol, if defined, indicates that the lstat() routine is
  1778. + *    available to stat symbolic links.
  1779. + */
  1780. +#define    HAS_LSTAT        /**/
  1781. +
  1782. +/* HAS_MEMCMP
  1783. + *    This symbol, if defined, indicates that the memcmp routine is available
  1784. + *    to compare blocks of memory.  If undefined, roll your own.
  1785. + */
  1786. +#define    HAS_MEMCMP        /**/
  1787. +
  1788. +/* HAS_MEMCPY
  1789. + *    This symbol, if defined, indicates that the memcpy routine is available
  1790. + *    to copy blocks of memory.  Otherwise you should probably use bcopy().
  1791. + *    If neither is defined, roll your own.
  1792. + */
  1793. +/* SAFE_MEMCPY
  1794. + *    This symbol, if defined, indicates that the memcpy routine is available
  1795. + *    to copy potentially overlapping copy blocks of memory.  Otherwise you
  1796. + *    should probably use memmove() or bcopy().  If neither is defined,
  1797. + *    roll your own.
  1798. + */
  1799. +#define    HAS_MEMCPY        /**/
  1800. +/*#undef    SAFE_MEMCPY        /**/
  1801. +
  1802. +/* HAS_MEMMOVE
  1803. + *    This symbol, if defined, indicates that the memmove routine is available
  1804. + *    to move potentially overlapping blocks of memory.  Otherwise you
  1805. + *    should use bcopy() or roll your own.
  1806. + */
  1807. +#define    HAS_MEMMOVE        /**/
  1808. +
  1809. +/* HAS_MEMSET
  1810. + *    This symbol, if defined, indicates that the memset routine is available
  1811. + *    to set a block of memory to a character.  If undefined, roll your own.
  1812. + */
  1813. +#define    HAS_MEMSET        /**/
  1814. +
  1815. +/* HAS_MKDIR
  1816. + *    This symbol, if defined, indicates that the mkdir routine is available
  1817. + *    to create directories.  Otherwise you should fork off a new process to
  1818. + *    exec /bin/mkdir.
  1819. + */
  1820. +#define    HAS_MKDIR        /**/
  1821. +
  1822. +/* HAS_MSG
  1823. + *    This symbol, if defined, indicates that the entire msg*(2) library is
  1824. + *    supported.
  1825. + */
  1826. +#define    HAS_MSG        /**/
  1827. +
  1828. +/* HAS_MSGCTL
  1829. + *    This symbol, if defined, indicates that the msgctl() routine is
  1830. + *    available to control message passing.
  1831. + */
  1832. +#define    HAS_MSGCTL        /**/
  1833. +
  1834. +/* HAS_MSGGET
  1835. + *    This symbol, if defined, indicates that the msgget() routine is
  1836. + *    available to get messages.
  1837. + */
  1838. +#define    HAS_MSGGET        /**/
  1839. +
  1840. +/* HAS_MSGRCV
  1841. + *    This symbol, if defined, indicates that the msgrcv() routine is
  1842. + *    available to receive messages.
  1843. + */
  1844. +#define    HAS_MSGRCV        /**/
  1845. +
  1846. +/* HAS_MSGSND
  1847. + *    This symbol, if defined, indicates that the msgsnd() routine is
  1848. + *    available to send messages.
  1849. + */
  1850. +#define    HAS_MSGSND        /**/
  1851. +
  1852. +/* HAS_NDBM
  1853. + *    This symbol, if defined, indicates that ndbm.h exists and should
  1854. + *    be included.
  1855. + */
  1856. +#define    HAS_NDBM        /**/
  1857. +
  1858. +/* HAS_ODBM
  1859. + *    This symbol, if defined, indicates that dbm.h exists and should
  1860. + *    be included.
  1861. + */
  1862. +#define    HAS_ODBM        /**/
  1863. +
  1864. +/* HAS_OPEN3
  1865. + *    This manifest constant lets the C program know that the three
  1866. + *    argument form of open(2) is available.
  1867. + */
  1868. +#define    HAS_OPEN3        /**/
  1869. +
  1870. +/* HAS_READDIR
  1871. + *    This symbol, if defined, indicates that the readdir routine is available
  1872. + *    from the C library to read directories.
  1873. + */
  1874. +#define    HAS_READDIR        /**/
  1875. +
  1876. +/* HAS_RENAME
  1877. + *    This symbol, if defined, indicates that the rename routine is available
  1878. + *    to rename files.  Otherwise you should do the unlink(), link(), unlink()
  1879. + *    trick.
  1880. + */
  1881. +#define    HAS_RENAME        /**/
  1882. +
  1883. +/* HAS_REWINDDIR
  1884. + *    This symbol, if defined, indicates that the rewindir routine is
  1885. + *    available to rewind directories.
  1886. + */
  1887. +#define    HAS_REWINDDIR        /**/
  1888. +
  1889. +/* HAS_RMDIR
  1890. + *    This symbol, if defined, indicates that the rmdir routine is available
  1891. + *    to remove directories.  Otherwise you should fork off a new process to
  1892. + *    exec /bin/rmdir.
  1893. + */
  1894. +#define    HAS_RMDIR        /**/
  1895. +
  1896. +/* HAS_SEEKDIR
  1897. + *    This symbol, if defined, indicates that the seekdir routine is
  1898. + *    available to seek into directories.
  1899. + */
  1900. +#define    HAS_SEEKDIR        /**/
  1901. +
  1902. +/* HAS_SELECT
  1903. + *    This symbol, if defined, indicates that the select() subroutine
  1904. + *    exists.
  1905. + */
  1906. +#define    HAS_SELECT    /**/
  1907. +
  1908. +/* HAS_SEM
  1909. + *    This symbol, if defined, indicates that the entire sem*(2) library is
  1910. + *    supported.
  1911. + */
  1912. +#define    HAS_SEM        /**/
  1913. +
  1914. +/* HAS_SEMCTL
  1915. + *    This symbol, if defined, indicates that the semctl() routine is
  1916. + *    available to control semaphores.
  1917. + */
  1918. +#define    HAS_SEMCTL        /**/
  1919. +
  1920. +/* HAS_SEMGET
  1921. + *    This symbol, if defined, indicates that the semget() routine is
  1922. + *    available to get semaphores ids.
  1923. + */
  1924. +#define    HAS_SEMGET        /**/
  1925. +
  1926. +/* HAS_SEMOP
  1927. + *    This symbol, if defined, indicates that the semop() routine is
  1928. + *    available to perform semaphore operations.
  1929. + */
  1930. +#define    HAS_SEMOP        /**/
  1931. +
  1932. +/* HAS_SETEGID
  1933. + *    This symbol, if defined, indicates that the setegid routine is available
  1934. + *    to change the effective gid of the current program.
  1935. + */
  1936. +#define    HAS_SETEGID        /**/
  1937. +
  1938. +/* HAS_SETEUID
  1939. + *    This symbol, if defined, indicates that the seteuid routine is available
  1940. + *    to change the effective uid of the current program.
  1941. + */
  1942. +#define    HAS_SETEUID        /**/
  1943. +
  1944. +/* HAS_SETPGRP
  1945. + *    This symbol, if defined, indicates that the setpgrp() routine is
  1946. + *    available to set the current process group.
  1947. + */
  1948. +#define    HAS_SETPGRP        /**/
  1949. +
  1950. +/* HAS_SETPGRP2
  1951. + *    This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
  1952. + *    routine is available to set the current process group.
  1953. + */
  1954. +/*#undef    HAS_SETPGRP2        /**/
  1955. +
  1956. +/* HAS_SETPRIORITY
  1957. + *    This symbol, if defined, indicates that the setpriority() routine is
  1958. + *    available to set a process's priority.
  1959. + */
  1960. +/*#undef    HAS_SETPRIORITY        /**/
  1961. +
  1962. +/* HAS_SETREGID
  1963. + *    This symbol, if defined, indicates that the setregid routine is
  1964. + *    available to change the real and effective gid of the current program.
  1965. + */
  1966. +/* HAS_SETRESGID
  1967. + *    This symbol, if defined, indicates that the setresgid routine is
  1968. + *    available to change the real, effective and saved gid of the current
  1969. + *    program.
  1970. + */
  1971. +#define    HAS_SETREGID        /**/
  1972. +/*#undef    HAS_SETRESGID        /**/
  1973. +
  1974. +/* HAS_SETREUID
  1975. + *    This symbol, if defined, indicates that the setreuid routine is
  1976. + *    available to change the real and effective uid of the current program.
  1977. + */
  1978. +/* HAS_SETRESUID
  1979. + *    This symbol, if defined, indicates that the setresuid routine is
  1980. + *    available to change the real, effective and saved uid of the current
  1981. + *    program.
  1982. + */
  1983. +#define    HAS_SETREUID        /**/
  1984. +/*#undef    HAS_SETRESUID        /**/
  1985. +
  1986. +/* HAS_SETRGID
  1987. + *    This symbol, if defined, indicates that the setrgid routine is available
  1988. + *    to change the real gid of the current program.
  1989. + */
  1990. +/*#undef    HAS_SETRGID        /**/
  1991. +
  1992. +/* HAS_SETRUID
  1993. + *    This symbol, if defined, indicates that the setruid routine is available
  1994. + *    to change the real uid of the current program.
  1995. + */
  1996. +/*#undef    HAS_SETRUID        /**/
  1997. +
  1998. +/* HAS_SHM
  1999. + *    This symbol, if defined, indicates that the entire shm*(2) library is
  2000. + *    supported.
  2001. + */
  2002. +#define    HAS_SHM        /**/
  2003. +
  2004. +/* HAS_SHMAT
  2005. + *    This symbol, if defined, indicates that the shmat() routine is
  2006. + *    available to attach a shared memory segment.
  2007. + */
  2008. +/* VOID_SHMAT
  2009. + *    This symbol, if defined, indicates that the shmat() routine
  2010. + *    returns a pointer of type void*.
  2011. + */
  2012. +#define    HAS_SHMAT        /**/
  2013. +
  2014. +/*#undef    VOIDSHMAT        /**/
  2015. +
  2016. +/* HAS_SHMCTL
  2017. + *    This symbol, if defined, indicates that the shmctl() routine is
  2018. + *    available to control a shared memory segment.
  2019. + */
  2020. +#define    HAS_SHMCTL        /**/
  2021. +
  2022. +/* HAS_SHMDT
  2023. + *    This symbol, if defined, indicates that the shmdt() routine is
  2024. + *    available to detach a shared memory segment.
  2025. + */
  2026. +#define    HAS_SHMDT        /**/
  2027. +
  2028. +/* HAS_SHMGET
  2029. + *    This symbol, if defined, indicates that the shmget() routine is
  2030. + *    available to get a shared memory segment id.
  2031. + */
  2032. +#define    HAS_SHMGET        /**/
  2033. +
  2034. +/* HAS_SOCKET
  2035. + *    This symbol, if defined, indicates that the BSD socket interface is
  2036. + *    supported.
  2037. + */
  2038. +/* HAS_SOCKETPAIR
  2039. + *    This symbol, if defined, indicates that the BSD socketpair call is
  2040. + *    supported.
  2041. + */
  2042. +/* OLDSOCKET
  2043. + *    This symbol, if defined, indicates that the 4.1c BSD socket interface
  2044. + *    is supported instead of the 4.2/4.3 BSD socket interface.
  2045. + */
  2046. +#define    HAS_SOCKET        /**/
  2047. +
  2048. +#define    HAS_SOCKETPAIR    /**/
  2049. +
  2050. +/*#undef    OLDSOCKET    /**/
  2051. +
  2052. +/* STATBLOCKS
  2053. + *    This symbol is defined if this system has a stat structure declaring
  2054. + *    st_blksize and st_blocks.
  2055. + */
  2056. +#define    STATBLOCKS     /**/
  2057. +
  2058. +/* STDSTDIO
  2059. + *    This symbol is defined if this system has a FILE structure declaring
  2060. + *    _ptr and _cnt in stdio.h.
  2061. + */
  2062. +/*#undef    STDSTDIO     /**/
  2063. +
  2064. +/* STRUCTCOPY
  2065. + *    This symbol, if defined, indicates that this C compiler knows how
  2066. + *    to copy structures.  If undefined, you'll need to use a block copy
  2067. + *    routine of some sort instead.
  2068. + */
  2069. +#define    STRUCTCOPY    /**/
  2070. +
  2071. +/* HAS_STRERROR
  2072. + *    This symbol, if defined, indicates that the strerror() routine is
  2073. + *    available to translate error numbers to strings.
  2074. + */
  2075. +#define    HAS_STRERROR        /**/
  2076. +
  2077. +/* HAS_SYMLINK
  2078. + *    This symbol, if defined, indicates that the symlink routine is available
  2079. + *    to create symbolic links.
  2080. + */
  2081. +#define    HAS_SYMLINK        /**/
  2082. +
  2083. +/* HAS_SYSCALL
  2084. + *    This symbol, if defined, indicates that the syscall routine is available
  2085. + *    to call arbitrary system calls.  If undefined, that's tough.
  2086. + */
  2087. +#define    HAS_SYSCALL        /**/
  2088. +
  2089. +/* HAS_TELLDIR
  2090. + *    This symbol, if defined, indicates that the telldir routine is
  2091. + *    available to tell your location in directories.
  2092. + */
  2093. +#define    HAS_TELLDIR        /**/
  2094. +
  2095. +/* HAS_TRUNCATE
  2096. + *    This symbol, if defined, indicates that the truncate routine is
  2097. + *    available to truncate files.
  2098. + */
  2099. +#define    HAS_TRUNCATE        /**/
  2100. +
  2101. +/* HAS_VFORK
  2102. + *    This symbol, if defined, indicates that vfork() exists.
  2103. + */
  2104. +#define    HAS_VFORK    /**/
  2105. +
  2106. +/* VOIDSIG
  2107. + *    This symbol is defined if this system declares "void (*signal())()" in
  2108. + *    signal.h.  The old way was to declare it as "int (*signal())()".  It
  2109. + *    is up to the package author to declare things correctly based on the
  2110. + *    symbol.
  2111. + */
  2112. +/* TO_SIGNAL
  2113. + *    This symbol's value is either "void" or "int", corresponding to the
  2114. + *    appropriate return "type" of a signal handler.  Thus, one can declare
  2115. + *    a signal handler using "TO_SIGNAL (*handler())()", and define the
  2116. + *    handler using "TO_SIGNAL handler(sig)".
  2117. + */
  2118. +#define    VOIDSIG     /**/
  2119. +#define    TO_SIGNAL    int     /**/
  2120. +
  2121. +/* HASVOLATILE
  2122. + *    This symbol, if defined, indicates that this C compiler knows about
  2123. + *    the volatile declaration.
  2124. + */
  2125. +#define    HASVOLATILE    /**/
  2126. +
  2127. +/* HAS_VPRINTF
  2128. + *    This symbol, if defined, indicates that the vprintf routine is available
  2129. + *    to printf with a pointer to an argument list.  If unavailable, you
  2130. + *    may need to write your own, probably in terms of _doprnt().
  2131. + */
  2132. +/* CHARVSPRINTF
  2133. + *    This symbol is defined if this system has vsprintf() returning type
  2134. + *    (char*).  The trend seems to be to declare it as "int vsprintf()".  It
  2135. + *    is up to the package author to declare vsprintf correctly based on the
  2136. + *    symbol.
  2137. + */
  2138. +#define    HAS_VPRINTF    /**/
  2139. +/*#undef    CHARVSPRINTF     /**/
  2140. +
  2141. +/* HAS_WAIT4
  2142. + *    This symbol, if defined, indicates that wait4() exists.
  2143. + */
  2144. +#define    HAS_WAIT4    /**/
  2145. +
  2146. +/* HAS_WAITPID
  2147. + *    This symbol, if defined, indicates that waitpid() exists.
  2148. + */
  2149. +#define    HAS_WAITPID    /**/
  2150. +
  2151. +/* GIDTYPE
  2152. + *    This symbol has a value like gid_t, int, ushort, or whatever type is
  2153. + *    used to declare group ids in the kernel.
  2154. + */
  2155. +#define GIDTYPE unsigned short        /**/
  2156. +
  2157. +/* GROUPSTYPE
  2158. + *    This symbol has a value like gid_t, int, ushort, or whatever type is
  2159. + *    used in the return value of getgroups().
  2160. + */
  2161. +#define GROUPSTYPE unsigned short        /**/
  2162. +
  2163. +/* I_FCNTL
  2164. + *    This manifest constant tells the C program to include <fcntl.h>.
  2165. + */
  2166. +/*#undef    I_FCNTL    /**/
  2167. +
  2168. +/* I_GDBM
  2169. + *    This symbol, if defined, indicates that gdbm.h exists and should
  2170. + *    be included.
  2171. + */
  2172. +#define    I_GDBM        /**/
  2173. +
  2174. +/* I_GRP
  2175. + *    This symbol, if defined, indicates to the C program that it should
  2176. + *    include grp.h.
  2177. + */
  2178. +#define    I_GRP        /**/
  2179. +
  2180. +/* I_NETINET_IN
  2181. + *    This symbol, if defined, indicates to the C program that it should
  2182. + *    include netinet/in.h.
  2183. + */
  2184. +/* I_SYS_IN
  2185. + *    This symbol, if defined, indicates to the C program that it should
  2186. + *    include sys/in.h.
  2187. + */
  2188. +#define    I_NETINET_IN        /**/
  2189. +/*#undef    I_SYS_IN        /**/
  2190. +
  2191. +/* I_PWD
  2192. + *    This symbol, if defined, indicates to the C program that it should
  2193. + *    include pwd.h.
  2194. + */
  2195. +/* PWQUOTA
  2196. + *    This symbol, if defined, indicates to the C program that struct passwd
  2197. + *    contains pw_quota.
  2198. + */
  2199. +/* PWAGE
  2200. + *    This symbol, if defined, indicates to the C program that struct passwd
  2201. + *    contains pw_age.
  2202. + */
  2203. +/* PWCHANGE
  2204. + *    This symbol, if defined, indicates to the C program that struct passwd
  2205. + *    contains pw_change.
  2206. + */
  2207. +/* PWCLASS
  2208. + *    This symbol, if defined, indicates to the C program that struct passwd
  2209. + *    contains pw_class.
  2210. + */
  2211. +/* PWEXPIRE
  2212. + *    This symbol, if defined, indicates to the C program that struct passwd
  2213. + *    contains pw_expire.
  2214. + */
  2215. +/* PWCOMMENT
  2216. + *    This symbol, if defined, indicates to the C program that struct passwd
  2217. + *    contains pw_comment.
  2218. + */
  2219. +#define    I_PWD        /**/
  2220. +/*#undef    PWQUOTA        /**/
  2221. +/*#undef    PWAGE        /**/
  2222. +/*#undef    PWCHANGE    /**/
  2223. +/*#undef    PWCLASS        /**/
  2224. +/*#undef    PWEXPIRE    /**/
  2225. +/*#undef    PWCOMMENT    /**/
  2226. +
  2227. +/* I_SYS_FILE
  2228. + *    This manifest constant tells the C program to include <sys/file.h>.
  2229. + */
  2230. +#define    I_SYS_FILE    /**/
  2231. +
  2232. +/* I_SYSIOCTL
  2233. + *    This symbol, if defined, indicates that sys/ioctl.h exists and should
  2234. + *    be included.
  2235. + */
  2236. +#define    I_SYSIOCTL        /**/
  2237. +
  2238. +/* I_TIME
  2239. + *    This symbol is defined if the program should include <time.h>.
  2240. + */
  2241. +/* I_SYS_TIME
  2242. + *    This symbol is defined if the program should include <sys/time.h>.
  2243. + */
  2244. +/* SYSTIMEKERNEL
  2245. + *    This symbol is defined if the program should include <sys/time.h>
  2246. + *    with KERNEL defined.
  2247. + */
  2248. +/* I_SYS_SELECT
  2249. + *    This symbol is defined if the program should include <sys/select.h>.
  2250. + */
  2251. +/*#undef    I_TIME         /**/
  2252. +#define    I_SYS_TIME     /**/
  2253. +/*#undef    SYSTIMEKERNEL     /**/
  2254. +/*#undef    I_SYS_SELECT     /**/
  2255. +
  2256. +/* I_UTIME
  2257. + *    This symbol, if defined, indicates to the C program that it should
  2258. + *    include utime.h.
  2259. + */
  2260. +#define    I_UTIME        /**/
  2261. +
  2262. +/* I_VARARGS
  2263. + *    This symbol, if defined, indicates to the C program that it should
  2264. + *    include varargs.h.
  2265. + */
  2266. +/*#undef    I_VARARGS        /**/
  2267. +
  2268. +/* I_VFORK
  2269. + *    This symbol, if defined, indicates to the C program that it should
  2270. + *    include vfork.h.
  2271. + */
  2272. +/*#undef    I_VFORK        /**/
  2273. +
  2274. +/* INTSIZE
  2275. + *    This symbol contains the size of an int, so that the C preprocessor
  2276. + *    can make decisions based on it.
  2277. + */
  2278. +#define INTSIZE 4        /**/
  2279. +
  2280. +/* I_DIRENT
  2281. + *    This symbol, if defined, indicates that the program should use the
  2282. + *    P1003-style directory routines, and include <dirent.h>.
  2283. + */
  2284. +/* I_SYS_DIR
  2285. + *    This symbol, if defined, indicates that the program should use the
  2286. + *    directory functions by including <sys/dir.h>.
  2287. + */
  2288. +/* I_NDIR
  2289. + *    This symbol, if defined, indicates that the program should include the
  2290. + *    system's version of ndir.h, rather than the one with this package.
  2291. + */
  2292. +/* I_SYS_NDIR
  2293. + *    This symbol, if defined, indicates that the program should include the
  2294. + *    system's version of sys/ndir.h, rather than the one with this package.
  2295. + */
  2296. +/* I_MY_DIR
  2297. + *    This symbol, if defined, indicates that the program should compile
  2298. + *    the ndir.c code provided with the package.
  2299. + */
  2300. +/* DIRNAMLEN
  2301. + *    This symbol, if defined, indicates to the C program that the length
  2302. + *    of directory entry names is provided by a d_namlen field.  Otherwise
  2303. + *    you need to do strlen() on the d_name field.
  2304. + */
  2305. +#define    I_DIRENT    /**/
  2306. +/*#undef    I_SYS_DIR    /**/
  2307. +/*#undef    I_NDIR        /**/
  2308. +/*#undef    I_SYS_NDIR    /**/
  2309. +/*#undef    I_MY_DIR    /**/
  2310. +#define    DIRNAMLEN    /**/
  2311. +
  2312. +/* MYMALLOC
  2313. + *    This symbol, if defined, indicates that we're using our own malloc.
  2314. + */
  2315. +/* MALLOCPTRTYPE
  2316. + *    This symbol defines the kind of ptr returned by malloc and realloc.
  2317. + */
  2318. +/*#undef MYMALLOC            /**/
  2319. +
  2320. +#define MALLOCPTRTYPE void         /**/
  2321. +
  2322. +
  2323. +/* RANDBITS
  2324. + *    This symbol contains the number of bits of random number the rand()
  2325. + *    function produces.  Usual values are 15, 16, and 31.
  2326. + */
  2327. +#define RANDBITS 31        /**/
  2328. +
  2329. +/* SCRIPTDIR
  2330. + *    This symbol holds the name of the directory in which the user wants
  2331. + *    to keep publicly executable scripts for the package in question.  It
  2332. + *    is often a directory that is mounted across diverse architectures.
  2333. + */
  2334. +#define SCRIPTDIR "/usr/bin"             /**/
  2335. +
  2336. +/* SIG_NAME
  2337. + *    This symbol contains an list of signal names in order.
  2338. + */
  2339. +#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","IOT","BUS","FPE","KILL","USR1","SEGV","USR2","PIPE","ALRM","TERM","STKFLT","CHLD","CONT","STOP","TSTP","TTIN","TTOU","URG","XCPU","XFSZ","VTALRM","PROF","WINCH","LOST","PWR","UNUSED"        /**/
  2340. +
  2341. +/* STDCHAR
  2342. + *    This symbol is defined to be the type of char used in stdio.h.
  2343. + *    It has the values "unsigned char" or "char".
  2344. + */
  2345. +#define STDCHAR char    /**/
  2346. +
  2347. +/* UIDTYPE
  2348. + *    This symbol has a value like uid_t, int, ushort, or whatever type is
  2349. + *    used to declare user ids in the kernel.
  2350. + */
  2351. +#define UIDTYPE unsigned short        /**/
  2352. +
  2353. +/* VOIDHAVE
  2354. + *    This symbol indicates how much support of the void type is given by this
  2355. + *    compiler.  What various bits mean:
  2356. + *
  2357. + *        1 = supports declaration of void
  2358. + *        2 = supports arrays of pointers to functions returning void
  2359. + *        4 = supports comparisons between pointers to void functions and
  2360. + *            addresses of void functions
  2361. + *
  2362. + *    The package designer should define VOIDWANT to indicate the requirements
  2363. + *    of the package.  This can be done either by #defining VOIDWANT before
  2364. + *    including config.h, or by defining voidwant in Myinit.U.  If the level
  2365. + *    of void support necessary is not present, config.h defines void to "int",
  2366. + *    VOID to the empty string, and VOIDP to "char *".
  2367. + */
  2368. +/* void
  2369. + *    This symbol is used for void casts.  On implementations which support
  2370. + *    void appropriately, its value is "void".  Otherwise, its value maps
  2371. + *    to "int".
  2372. + */
  2373. +/* VOID
  2374. + *    This symbol's value is "void" if the implementation supports void
  2375. + *    appropriately.  Otherwise, its value is the empty string.  The primary
  2376. + *    use of this symbol is in specifying void parameter lists for function
  2377. + *    prototypes.
  2378. + */
  2379. +/* VOIDP
  2380. + *    This symbol is used for casting generic pointers.  On implementations
  2381. + *    which support void appropriately, its value is "void *".  Otherwise,
  2382. + *    its value is "char *".
  2383. + */
  2384. +#ifndef VOIDWANT
  2385. +#define VOIDWANT 7
  2386. +#endif
  2387. +#define VOIDHAVE 7
  2388. +#if (VOIDHAVE & VOIDWANT) != VOIDWANT
  2389. +#define void int        /* is void to be avoided? */
  2390. +#define VOID
  2391. +#define VOIDP (char *)
  2392. +#define M_VOID        /* Xenix strikes again */
  2393. +#else
  2394. +#define VOID void
  2395. +#define VOIDP (void *)
  2396. +#endif
  2397. +
  2398. +/* PRIVLIB
  2399. + *    This symbol contains the name of the private library for this package.
  2400. + *    The library is private in the sense that it needn't be in anyone's
  2401. + *    execution path, but it should be accessible by the world.  The program
  2402. + *    should be prepared to do ~ expansion.
  2403. + */
  2404. +#define PRIVLIB "/usr/lib/perl4"        /**/
  2405. +
  2406. +#endif
  2407. diff -u --new-file --recursive perl-4.036.orig/config.sh perl-4.036/config.sh
  2408. --- perl-4.036.orig/config.sh    Wed Dec 31 18:00:00 1969
  2409. +++ perl-4.036/config.sh    Tue Jan 17 21:16:24 1995
  2410. @@ -0,0 +1,268 @@
  2411. +#!/bin/sh
  2412. +# config.sh
  2413. +# This file was produced by running the Configure script.
  2414. +d_eunice='undef'
  2415. +define='define'
  2416. +eunicefix=':'
  2417. +loclist='
  2418. +cat
  2419. +cp
  2420. +echo
  2421. +expr
  2422. +grep
  2423. +mkdir
  2424. +mv
  2425. +rm
  2426. +sed
  2427. +sort
  2428. +tr
  2429. +uniq
  2430. +'
  2431. +expr='/usr/bin/expr'
  2432. +sed='/usr/bin/sed'
  2433. +echo='/bin/echo'
  2434. +cat='/bin/cat'
  2435. +rm='/bin/rm'
  2436. +mv='/bin/mv'
  2437. +cp='/bin/cp'
  2438. +tail=''
  2439. +tr='/usr/bin/tr'
  2440. +mkdir='/bin/mkdir'
  2441. +sort='/usr/bin/sort'
  2442. +uniq='/usr/bin/uniq'
  2443. +grep='/usr/bin/grep'
  2444. +trylist='
  2445. +Mcc
  2446. +bison
  2447. +cpp
  2448. +csh
  2449. +egrep
  2450. +line
  2451. +nroff
  2452. +perl
  2453. +test
  2454. +uname
  2455. +yacc
  2456. +'
  2457. +test='test'
  2458. +inews=''
  2459. +egrep='/usr/bin/egrep'
  2460. +more=''
  2461. +pg=''
  2462. +Mcc='Mcc'
  2463. +vi=''
  2464. +mailx=''
  2465. +mail=''
  2466. +cpp='/lib/cpp'
  2467. +perl='/usr/bin/perl'
  2468. +emacs=''
  2469. +ls=''
  2470. +rmail=''
  2471. +sendmail=''
  2472. +shar=''
  2473. +smail=''
  2474. +tbl=''
  2475. +troff=''
  2476. +nroff='groff'
  2477. +uname='/bin/uname'
  2478. +uuname=''
  2479. +line='line'
  2480. +chgrp=''
  2481. +chmod=''
  2482. +lint=''
  2483. +sleep=''
  2484. +pr=''
  2485. +tar=''
  2486. +ln=''
  2487. +lpr=''
  2488. +lp=''
  2489. +touch=''
  2490. +make=''
  2491. +date=''
  2492. +csh='/bin/csh'
  2493. +bash=''
  2494. +ksh=''
  2495. +lex=''
  2496. +flex=''
  2497. +bison='/usr/bin/bison'
  2498. +Log='$Log'
  2499. +Header='$Header'
  2500. +Id='$Id'
  2501. +lastuname='Linux fuzzy 1.1.82 #2 Mon Jan 16 10:30:09 EST 1995 i486'
  2502. +alignbytes='4'
  2503. +bin='/usr/bin'
  2504. +installbin='/usr/bin'
  2505. +byteorder='1234'
  2506. +contains='grep'
  2507. +cppstdin='cppstdin'
  2508. +cppminus=''
  2509. +d_bcmp='define'
  2510. +d_bcopy='define'
  2511. +d_safebcpy='define'
  2512. +d_bzero='define'
  2513. +d_castneg='define'
  2514. +castflags='0'
  2515. +d_charsprf='undef'
  2516. +d_chsize='undef'
  2517. +d_crypt='define'
  2518. +cryptlib=''
  2519. +d_csh='define'
  2520. +d_dosuid='undef'
  2521. +d_dup2='define'
  2522. +d_fchmod='define'
  2523. +d_fchown='define'
  2524. +d_fcntl='define'
  2525. +d_flexfnam='define'
  2526. +d_flock='define'
  2527. +d_getgrps='undef'
  2528. +d_gethent='undef'
  2529. +d_getpgrp='define'
  2530. +d_getpgrp2='undef'
  2531. +d_getprior='undef'
  2532. +d_htonl='undef'
  2533. +d_index='undef'
  2534. +d_isascii='undef'
  2535. +d_killpg='define'
  2536. +d_lstat='define'
  2537. +d_memcmp='define'
  2538. +d_memcpy='define'
  2539. +d_safemcpy='undef'
  2540. +d_memmove='define'
  2541. +d_memset='define'
  2542. +d_mkdir='define'
  2543. +d_msg='define'
  2544. +d_msgctl='define'
  2545. +d_msgget='define'
  2546. +d_msgrcv='define'
  2547. +d_msgsnd='define'
  2548. +d_ndbm='define'
  2549. +d_odbm='define'
  2550. +d_open3='define'
  2551. +d_readdir='define'
  2552. +d_rename='define'
  2553. +d_rewindir='define'
  2554. +d_rmdir='define'
  2555. +d_seekdir='define'
  2556. +d_select='define'
  2557. +d_sem='define'
  2558. +d_semctl='define'
  2559. +d_semget='define'
  2560. +d_semop='define'
  2561. +d_setegid='define'
  2562. +d_seteuid='define'
  2563. +d_setpgrp='define'
  2564. +d_setpgrp2='undef'
  2565. +d_setprior='undef'
  2566. +d_setregid='define'
  2567. +d_setresgid='undef'
  2568. +d_setreuid='define'
  2569. +d_setresuid='undef'
  2570. +d_setrgid='undef'
  2571. +d_setruid='undef'
  2572. +d_shm='define'
  2573. +d_shmat='define'
  2574. +d_voidshmat='undef'
  2575. +d_shmctl='define'
  2576. +d_shmdt='define'
  2577. +d_shmget='define'
  2578. +d_socket='define'
  2579. +d_sockpair='define'
  2580. +d_oldsock='undef'
  2581. +socketlib=''
  2582. +d_statblks='define'
  2583. +d_stdstdio='undef'
  2584. +d_strctcpy='define'
  2585. +d_strerror='define'
  2586. +d_symlink='define'
  2587. +d_syscall='define'
  2588. +d_telldir='define'
  2589. +d_truncate='define'
  2590. +d_vfork='define'
  2591. +d_voidsig='define'
  2592. +d_tosignal='int'
  2593. +d_volatile='define'
  2594. +d_vprintf='define'
  2595. +d_charvspr='undef'
  2596. +d_wait4='define'
  2597. +d_waitpid='define'
  2598. +gidtype='unsigned short'
  2599. +groupstype='unsigned short'
  2600. +i_fcntl='undef'
  2601. +i_gdbm='define'
  2602. +i_grp='define'
  2603. +i_niin='define'
  2604. +i_sysin='undef'
  2605. +i_pwd='define'
  2606. +d_pwquota='undef'
  2607. +d_pwage='undef'
  2608. +d_pwchange='undef'
  2609. +d_pwclass='undef'
  2610. +d_pwexpire='undef'
  2611. +d_pwcomment='undef'
  2612. +i_sys_file='define'
  2613. +i_sysioctl='define'
  2614. +i_time='undef'
  2615. +i_sys_time='define'
  2616. +i_sys_select='undef'
  2617. +d_systimekernel='undef'
  2618. +i_utime='define'
  2619. +i_varargs='undef'
  2620. +i_vfork='undef'
  2621. +intsize='4'
  2622. +libc='/usr/lib/libc.a'
  2623. +nm_opts=''
  2624. +libndir=''
  2625. +i_my_dir='undef'
  2626. +i_ndir='undef'
  2627. +i_sys_ndir='undef'
  2628. +i_dirent='define'
  2629. +i_sys_dir='undef'
  2630. +d_dirnamlen='define'
  2631. +ndirc=''
  2632. +ndiro=''
  2633. +mallocsrc=''
  2634. +mallocobj=''
  2635. +d_mymalloc='undef'
  2636. +mallocptrtype='void'
  2637. +mansrc='/usr/man/man1'
  2638. +manext='1'
  2639. +models='none'
  2640. +split=''
  2641. +small=''
  2642. +medium=''
  2643. +large=''
  2644. +huge=''
  2645. +optimize='-O2'
  2646. +ccflags=''
  2647. +cppflags=''
  2648. +ldflags='-s'
  2649. +cc='gcc'
  2650. +nativegcc='define'
  2651. +libs='-ldbm -lm'
  2652. +n='-n'
  2653. +c=''
  2654. +package='perl(linux-36LA)'
  2655. +randbits='31'
  2656. +scriptdir='/usr/bin'
  2657. +installscr='/usr/bin'
  2658. +sig_name='ZERO HUP INT QUIT ILL TRAP IOT BUS FPE KILL USR1 SEGV USR2 PIPE ALRM TERM STKFLT CHLD CONT STOP TSTP TTIN TTOU URG XCPU XFSZ VTALRM PROF WINCH LOST PWR UNUSED'
  2659. +spitshell='cat'
  2660. +shsharp='true'
  2661. +sharpbang='#!'
  2662. +startsh='#!/bin/sh'
  2663. +stdchar='char'
  2664. +uidtype='unsigned short'
  2665. +usrinclude='/usr/include'
  2666. +inclPath=''
  2667. +void=''
  2668. +voidhave='7'
  2669. +voidwant='7'
  2670. +w_localtim='1'
  2671. +w_s_timevl='1'
  2672. +w_s_tm='1'
  2673. +yacc='bison -y'
  2674. +lib=''
  2675. +privlib='/usr/lib/perl4'
  2676. +installprivlib='/usr/lib/perl4'
  2677. +PATCHLEVEL=36
  2678. +CONFIG=true
  2679. diff -u --new-file --recursive perl-4.036.orig/cppstdin perl-4.036/cppstdin
  2680. --- perl-4.036.orig/cppstdin    Wed Dec 31 18:00:00 1969
  2681. +++ perl-4.036/cppstdin    Tue Jan 17 21:15:05 1995
  2682. @@ -0,0 +1 @@
  2683. +cat >.$$.c; gcc -E ${1+"$@"} .$$.c; rm .$$.c
  2684. diff -u --new-file --recursive perl-4.036.orig/h2ph perl-4.036/h2ph
  2685. --- perl-4.036.orig/h2ph    Wed Dec 31 18:00:00 1969
  2686. +++ perl-4.036/h2ph    Tue Jan 17 21:16:29 1995
  2687. @@ -0,0 +1,253 @@
  2688. +#!/usr/bin/perl
  2689. +'di';
  2690. +'ig00';
  2691. +
  2692. +$perlincl = '/usr/lib/perl4';
  2693. +
  2694. +chdir '/usr/include' || die "Can't cd /usr/include";
  2695. +
  2696. +@isatype = split(' ',<<END);
  2697. +    char    uchar    u_char
  2698. +    short    ushort    u_short
  2699. +    int    uint    u_int
  2700. +    long    ulong    u_long
  2701. +    FILE
  2702. +END
  2703. +
  2704. +@isatype{@isatype} = (1) x @isatype;
  2705. +
  2706. +@ARGV = ('-') unless @ARGV;
  2707. +
  2708. +foreach $file (@ARGV) {
  2709. +    if ($file eq '-') {
  2710. +    open(IN, "-");
  2711. +    open(OUT, ">-");
  2712. +    }
  2713. +    else {
  2714. +    ($outfile = $file) =~ s/\.h$/.ph/ || next;
  2715. +    print "$file -> $outfile\n";
  2716. +    if ($file =~ m|^(.*)/|) {
  2717. +        $dir = $1;
  2718. +        if (!-d "$perlincl/$dir") {
  2719. +        mkdir("$perlincl/$dir",0777);
  2720. +        }
  2721. +    }
  2722. +    open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
  2723. +    open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
  2724. +    }
  2725. +    while (<IN>) {
  2726. +    chop;
  2727. +    while (/\\$/) {
  2728. +        chop;
  2729. +        $_ .= <IN>;
  2730. +        chop;
  2731. +    }
  2732. +    if (s:/\*:\200:g) {
  2733. +        s:\*/:\201:g;
  2734. +        s/\200[^\201]*\201//g;    # delete single line comments
  2735. +        if (s/\200.*//) {        # begin multi-line comment?
  2736. +        $_ .= '/*';
  2737. +        $_ .= <IN>;
  2738. +        redo;
  2739. +        }
  2740. +    }
  2741. +    if (s/^#\s*//) {
  2742. +        if (s/^define\s+(\w+)//) {
  2743. +        $name = $1;
  2744. +        $new = '';
  2745. +        s/\s+$//;
  2746. +        if (s/^\(([\w,\s]*)\)//) {
  2747. +            $args = $1;
  2748. +            if ($args ne '') {
  2749. +            foreach $arg (split(/,\s*/,$args)) {
  2750. +                $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
  2751. +                $curargs{$arg} = 1;
  2752. +            }
  2753. +            $args =~ s/\b(\w)/\$$1/g;
  2754. +            $args = "local($args) = \@_;\n$t    ";
  2755. +            }
  2756. +            s/^\s+//;
  2757. +            do expr();
  2758. +            $new =~ s/(["\\])/\\$1/g;
  2759. +            if ($t ne '') {
  2760. +            $new =~ s/(['\\])/\\$1/g;
  2761. +            print OUT $t,
  2762. +              "eval 'sub $name {\n$t    ${args}eval \"$new\";\n$t}';\n";
  2763. +            }
  2764. +            else {
  2765. +            print OUT "sub $name {\n    ${args}eval \"$new\";\n}\n";
  2766. +            }
  2767. +            %curargs = ();
  2768. +        }
  2769. +        else {
  2770. +            s/^\s+//;
  2771. +            do expr();
  2772. +            $new = 1 if $new eq '';
  2773. +            if ($t ne '') {
  2774. +            $new =~ s/(['\\])/\\$1/g;
  2775. +            print OUT $t,"eval 'sub $name {",$new,";}';\n";
  2776. +            }
  2777. +            else {
  2778. +            print OUT $t,"sub $name {",$new,";}\n";
  2779. +            }
  2780. +        }
  2781. +        }
  2782. +        elsif (/^include\s+<(.*)>/) {
  2783. +        ($incl = $1) =~ s/\.h$/.ph/;
  2784. +        print OUT $t,"require '$incl';\n";
  2785. +        }
  2786. +        elsif (/^ifdef\s+(\w+)/) {
  2787. +        print OUT $t,"if (defined &$1) {\n";
  2788. +        $tab += 4;
  2789. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  2790. +        }
  2791. +        elsif (/^ifndef\s+(\w+)/) {
  2792. +        print OUT $t,"if (!defined &$1) {\n";
  2793. +        $tab += 4;
  2794. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  2795. +        }
  2796. +        elsif (s/^if\s+//) {
  2797. +        $new = '';
  2798. +        do expr();
  2799. +        print OUT $t,"if ($new) {\n";
  2800. +        $tab += 4;
  2801. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  2802. +        }
  2803. +        elsif (s/^elif\s+//) {
  2804. +        $new = '';
  2805. +        do expr();
  2806. +        $tab -= 4;
  2807. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  2808. +        print OUT $t,"}\n${t}elsif ($new) {\n";
  2809. +        $tab += 4;
  2810. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  2811. +        }
  2812. +        elsif (/^else/) {
  2813. +        $tab -= 4;
  2814. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  2815. +        print OUT $t,"}\n${t}else {\n";
  2816. +        $tab += 4;
  2817. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  2818. +        }
  2819. +        elsif (/^endif/) {
  2820. +        $tab -= 4;
  2821. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  2822. +        print OUT $t,"}\n";
  2823. +        }
  2824. +    }
  2825. +    }
  2826. +    print OUT "1;\n";
  2827. +}
  2828. +
  2829. +sub expr {
  2830. +    while ($_ ne '') {
  2831. +    s/^(\s+)//        && do {$new .= ' '; next;};
  2832. +    s/^(0x[0-9a-fA-F]+)//    && do {$new .= $1; next;};
  2833. +    s/^(\d+)//        && do {$new .= $1; next;};
  2834. +    s/^("(\\"|[^"])*")//    && do {$new .= $1; next;};
  2835. +    s/^'((\\"|[^"])*)'//    && do {
  2836. +        if ($curargs{$1}) {
  2837. +        $new .= "ord('\$$1')";
  2838. +        }
  2839. +        else {
  2840. +        $new .= "ord('$1')";
  2841. +        }
  2842. +        next;
  2843. +    };
  2844. +    s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
  2845. +        $new .= '$sizeof';
  2846. +        next;
  2847. +    };
  2848. +    s/^([_a-zA-Z]\w*)//    && do {
  2849. +        $id = $1;
  2850. +        if ($id eq 'struct') {
  2851. +        s/^\s+(\w+)//;
  2852. +        $id .= ' ' . $1;
  2853. +        $isatype{$id} = 1;
  2854. +        }
  2855. +        elsif ($id eq 'unsigned') {
  2856. +        s/^\s+(\w+)//;
  2857. +        $id .= ' ' . $1;
  2858. +        $isatype{$id} = 1;
  2859. +        }
  2860. +        if ($curargs{$id}) {
  2861. +        $new .= '$' . $id;
  2862. +        }
  2863. +        elsif ($id eq 'defined') {
  2864. +        $new .= 'defined';
  2865. +        }
  2866. +        elsif (/^\(/) {
  2867. +        s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;    # cheat
  2868. +        $new .= " &$id";
  2869. +        }
  2870. +        elsif ($isatype{$id}) {
  2871. +        if ($new =~ /{\s*$/) {
  2872. +            $new .= "'$id'";
  2873. +        }
  2874. +        elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
  2875. +            $new =~ s/\(\s*$//;
  2876. +            s/^[\s*]*\)//;
  2877. +        }
  2878. +        else {
  2879. +            $new .= $id;
  2880. +        }
  2881. +        }
  2882. +        else {
  2883. +        $new .= ' &' . $id;
  2884. +        }
  2885. +        next;
  2886. +    };
  2887. +    s/^(.)//            && do {$new .= $1; next;};
  2888. +    }
  2889. +}
  2890. +##############################################################################
  2891. +
  2892. +    # These next few lines are legal in both Perl and nroff.
  2893. +
  2894. +.00;            # finish .ig
  2895. + 
  2896. +'di            \" finish diversion--previous line must be blank
  2897. +.nr nl 0-1        \" fake up transition to first page again
  2898. +.nr % 0            \" start at page 1
  2899. +'; __END__ ############# From here on it's a standard manual page ############
  2900. +.TH H2PH 1 "August 8, 1990"
  2901. +.AT 3
  2902. +.SH NAME
  2903. +h2ph \- convert .h C header files to .ph Perl header files
  2904. +.SH SYNOPSIS
  2905. +.B h2ph [headerfiles]
  2906. +.SH DESCRIPTION
  2907. +.I h2ph
  2908. +converts any C header files specified to the corresponding Perl header file
  2909. +format.
  2910. +It is most easily run while in /usr/include:
  2911. +.nf
  2912. +
  2913. +    cd /usr/include; h2ph * sys/*
  2914. +
  2915. +.fi
  2916. +If run with no arguments, filters standard input to standard output.
  2917. +.SH ENVIRONMENT
  2918. +No environment variables are used.
  2919. +.SH FILES
  2920. +/usr/include/*.h
  2921. +.br
  2922. +/usr/include/sys/*.h
  2923. +.br
  2924. +etc.
  2925. +.SH AUTHOR
  2926. +Larry Wall
  2927. +.SH "SEE ALSO"
  2928. +perl(1)
  2929. +.SH DIAGNOSTICS
  2930. +The usual warnings if it can't read or write the files involved.
  2931. +.SH BUGS
  2932. +Doesn't construct the %sizeof array for you.
  2933. +.PP
  2934. +It doesn't handle all C constructs, but it does attempt to isolate
  2935. +definitions inside evals so that you can get at the definitions
  2936. +that it can translate.
  2937. +.PP
  2938. +It's only intended as a rough tool.
  2939. +You may need to dicker with the files produced.
  2940. +.ex
  2941. diff -u --new-file --recursive perl-4.036.orig/h2ph.man perl-4.036/h2ph.man
  2942. --- perl-4.036.orig/h2ph.man    Wed Dec 31 18:00:00 1969
  2943. +++ perl-4.036/h2ph.man    Tue Jan 17 21:16:29 1995
  2944. @@ -0,0 +1,253 @@
  2945. +#!/usr/bin/perl
  2946. +'di';
  2947. +'ig00';
  2948. +
  2949. +$perlincl = '/usr/lib/perl4';
  2950. +
  2951. +chdir '/usr/include' || die "Can't cd /usr/include";
  2952. +
  2953. +@isatype = split(' ',<<END);
  2954. +    char    uchar    u_char
  2955. +    short    ushort    u_short
  2956. +    int    uint    u_int
  2957. +    long    ulong    u_long
  2958. +    FILE
  2959. +END
  2960. +
  2961. +@isatype{@isatype} = (1) x @isatype;
  2962. +
  2963. +@ARGV = ('-') unless @ARGV;
  2964. +
  2965. +foreach $file (@ARGV) {
  2966. +    if ($file eq '-') {
  2967. +    open(IN, "-");
  2968. +    open(OUT, ">-");
  2969. +    }
  2970. +    else {
  2971. +    ($outfile = $file) =~ s/\.h$/.ph/ || next;
  2972. +    print "$file -> $outfile\n";
  2973. +    if ($file =~ m|^(.*)/|) {
  2974. +        $dir = $1;
  2975. +        if (!-d "$perlincl/$dir") {
  2976. +        mkdir("$perlincl/$dir",0777);
  2977. +        }
  2978. +    }
  2979. +    open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
  2980. +    open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
  2981. +    }
  2982. +    while (<IN>) {
  2983. +    chop;
  2984. +    while (/\\$/) {
  2985. +        chop;
  2986. +        $_ .= <IN>;
  2987. +        chop;
  2988. +    }
  2989. +    if (s:/\*:\200:g) {
  2990. +        s:\*/:\201:g;
  2991. +        s/\200[^\201]*\201//g;    # delete single line comments
  2992. +        if (s/\200.*//) {        # begin multi-line comment?
  2993. +        $_ .= '/*';
  2994. +        $_ .= <IN>;
  2995. +        redo;
  2996. +        }
  2997. +    }
  2998. +    if (s/^#\s*//) {
  2999. +        if (s/^define\s+(\w+)//) {
  3000. +        $name = $1;
  3001. +        $new = '';
  3002. +        s/\s+$//;
  3003. +        if (s/^\(([\w,\s]*)\)//) {
  3004. +            $args = $1;
  3005. +            if ($args ne '') {
  3006. +            foreach $arg (split(/,\s*/,$args)) {
  3007. +                $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
  3008. +                $curargs{$arg} = 1;
  3009. +            }
  3010. +            $args =~ s/\b(\w)/\$$1/g;
  3011. +            $args = "local($args) = \@_;\n$t    ";
  3012. +            }
  3013. +            s/^\s+//;
  3014. +            do expr();
  3015. +            $new =~ s/(["\\])/\\$1/g;
  3016. +            if ($t ne '') {
  3017. +            $new =~ s/(['\\])/\\$1/g;
  3018. +            print OUT $t,
  3019. +              "eval 'sub $name {\n$t    ${args}eval \"$new\";\n$t}';\n";
  3020. +            }
  3021. +            else {
  3022. +            print OUT "sub $name {\n    ${args}eval \"$new\";\n}\n";
  3023. +            }
  3024. +            %curargs = ();
  3025. +        }
  3026. +        else {
  3027. +            s/^\s+//;
  3028. +            do expr();
  3029. +            $new = 1 if $new eq '';
  3030. +            if ($t ne '') {
  3031. +            $new =~ s/(['\\])/\\$1/g;
  3032. +            print OUT $t,"eval 'sub $name {",$new,";}';\n";
  3033. +            }
  3034. +            else {
  3035. +            print OUT $t,"sub $name {",$new,";}\n";
  3036. +            }
  3037. +        }
  3038. +        }
  3039. +        elsif (/^include\s+<(.*)>/) {
  3040. +        ($incl = $1) =~ s/\.h$/.ph/;
  3041. +        print OUT $t,"require '$incl';\n";
  3042. +        }
  3043. +        elsif (/^ifdef\s+(\w+)/) {
  3044. +        print OUT $t,"if (defined &$1) {\n";
  3045. +        $tab += 4;
  3046. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  3047. +        }
  3048. +        elsif (/^ifndef\s+(\w+)/) {
  3049. +        print OUT $t,"if (!defined &$1) {\n";
  3050. +        $tab += 4;
  3051. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  3052. +        }
  3053. +        elsif (s/^if\s+//) {
  3054. +        $new = '';
  3055. +        do expr();
  3056. +        print OUT $t,"if ($new) {\n";
  3057. +        $tab += 4;
  3058. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  3059. +        }
  3060. +        elsif (s/^elif\s+//) {
  3061. +        $new = '';
  3062. +        do expr();
  3063. +        $tab -= 4;
  3064. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  3065. +        print OUT $t,"}\n${t}elsif ($new) {\n";
  3066. +        $tab += 4;
  3067. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  3068. +        }
  3069. +        elsif (/^else/) {
  3070. +        $tab -= 4;
  3071. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  3072. +        print OUT $t,"}\n${t}else {\n";
  3073. +        $tab += 4;
  3074. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  3075. +        }
  3076. +        elsif (/^endif/) {
  3077. +        $tab -= 4;
  3078. +        $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
  3079. +        print OUT $t,"}\n";
  3080. +        }
  3081. +    }
  3082. +    }
  3083. +    print OUT "1;\n";
  3084. +}
  3085. +
  3086. +sub expr {
  3087. +    while ($_ ne '') {
  3088. +    s/^(\s+)//        && do {$new .= ' '; next;};
  3089. +    s/^(0x[0-9a-fA-F]+)//    && do {$new .= $1; next;};
  3090. +    s/^(\d+)//        && do {$new .= $1; next;};
  3091. +    s/^("(\\"|[^"])*")//    && do {$new .= $1; next;};
  3092. +    s/^'((\\"|[^"])*)'//    && do {
  3093. +        if ($curargs{$1}) {
  3094. +        $new .= "ord('\$$1')";
  3095. +        }
  3096. +        else {
  3097. +        $new .= "ord('$1')";
  3098. +        }
  3099. +        next;
  3100. +    };
  3101. +    s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
  3102. +        $new .= '$sizeof';
  3103. +        next;
  3104. +    };
  3105. +    s/^([_a-zA-Z]\w*)//    && do {
  3106. +        $id = $1;
  3107. +        if ($id eq 'struct') {
  3108. +        s/^\s+(\w+)//;
  3109. +        $id .= ' ' . $1;
  3110. +        $isatype{$id} = 1;
  3111. +        }
  3112. +        elsif ($id eq 'unsigned') {
  3113. +        s/^\s+(\w+)//;
  3114. +        $id .= ' ' . $1;
  3115. +        $isatype{$id} = 1;
  3116. +        }
  3117. +        if ($curargs{$id}) {
  3118. +        $new .= '$' . $id;
  3119. +        }
  3120. +        elsif ($id eq 'defined') {
  3121. +        $new .= 'defined';
  3122. +        }
  3123. +        elsif (/^\(/) {
  3124. +        s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;    # cheat
  3125. +        $new .= " &$id";
  3126. +        }
  3127. +        elsif ($isatype{$id}) {
  3128. +        if ($new =~ /{\s*$/) {
  3129. +            $new .= "'$id'";
  3130. +        }
  3131. +        elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
  3132. +            $new =~ s/\(\s*$//;
  3133. +            s/^[\s*]*\)//;
  3134. +        }
  3135. +        else {
  3136. +            $new .= $id;
  3137. +        }
  3138. +        }
  3139. +        else {
  3140. +        $new .= ' &' . $id;
  3141. +        }
  3142. +        next;
  3143. +    };
  3144. +    s/^(.)//            && do {$new .= $1; next;};
  3145. +    }
  3146. +}
  3147. +##############################################################################
  3148. +
  3149. +    # These next few lines are legal in both Perl and nroff.
  3150. +
  3151. +.00;            # finish .ig
  3152. + 
  3153. +'di            \" finish diversion--previous line must be blank
  3154. +.nr nl 0-1        \" fake up transition to first page again
  3155. +.nr % 0            \" start at page 1
  3156. +'; __END__ ############# From here on it's a standard manual page ############
  3157. +.TH H2PH 1 "August 8, 1990"
  3158. +.AT 3
  3159. +.SH NAME
  3160. +h2ph \- convert .h C header files to .ph Perl header files
  3161. +.SH SYNOPSIS
  3162. +.B h2ph [headerfiles]
  3163. +.SH DESCRIPTION
  3164. +.I h2ph
  3165. +converts any C header files specified to the corresponding Perl header file
  3166. +format.
  3167. +It is most easily run while in /usr/include:
  3168. +.nf
  3169. +
  3170. +    cd /usr/include; h2ph * sys/*
  3171. +
  3172. +.fi
  3173. +If run with no arguments, filters standard input to standard output.
  3174. +.SH ENVIRONMENT
  3175. +No environment variables are used.
  3176. +.SH FILES
  3177. +/usr/include/*.h
  3178. +.br
  3179. +/usr/include/sys/*.h
  3180. +.br
  3181. +etc.
  3182. +.SH AUTHOR
  3183. +Larry Wall
  3184. +.SH "SEE ALSO"
  3185. +perl(1)
  3186. +.SH DIAGNOSTICS
  3187. +The usual warnings if it can't read or write the files involved.
  3188. +.SH BUGS
  3189. +Doesn't construct the %sizeof array for you.
  3190. +.PP
  3191. +It doesn't handle all C constructs, but it does attempt to isolate
  3192. +definitions inside evals so that you can get at the definitions
  3193. +that it can translate.
  3194. +.PP
  3195. +It's only intended as a rough tool.
  3196. +You may need to dicker with the files produced.
  3197. +.ex
  3198. diff -u --new-file --recursive perl-4.036.orig/makedepend perl-4.036/makedepend
  3199. --- perl-4.036.orig/makedepend    Wed Dec 31 18:00:00 1969
  3200. +++ perl-4.036/makedepend    Tue Jan 17 21:16:29 1995
  3201. @@ -0,0 +1,147 @@
  3202. +#!/bin/sh
  3203. +# : makedepend.SH,v 4063Revision: 4.0.1.4 4063Date: 92/06/08 13:51:24 $
  3204. +#
  3205. +# $Log:    makedepend.SH,v $
  3206. +# Revision 4.0.1.4  92/06/08  13:51:24  lwall
  3207. +# patch20: various and sundry fixes
  3208. +# 
  3209. +# Revision 4.0.1.3  91/11/05  17:56:33  lwall
  3210. +# patch11: various portability fixes
  3211. +# 
  3212. +# Revision 4.0.1.2  91/06/07  15:40:06  lwall
  3213. +# patch4: fixed cppstdin to run in the right directory
  3214. +# 
  3215. +# Revision 4.0.1.1  91/06/07  11:20:06  lwall
  3216. +# patch4: Makefile is no longer self-modifying code under makedepend
  3217. +# 
  3218. +# Revision 4.0  91/03/20  01:27:04  lwall
  3219. +# 4.0 baseline.
  3220. +# 
  3221. +# 
  3222. +
  3223. +export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh $0; kill $$)
  3224. +
  3225. +cat='/bin/cat'
  3226. +cppflags=''
  3227. +cp='/bin/cp'
  3228. +cppstdin='cppstdin'
  3229. +cppminus=''
  3230. +echo='/bin/echo'
  3231. +egrep='/usr/bin/egrep'
  3232. +expr='/usr/bin/expr'
  3233. +mv='/bin/mv'
  3234. +rm='/bin/rm'
  3235. +sed='/usr/bin/sed'
  3236. +sort='/usr/bin/sort'
  3237. +test='test'
  3238. +tr='/usr/bin/tr'
  3239. +uniq='/usr/bin/uniq'
  3240. +
  3241. +PATH="$PATH:."
  3242. +export PATH
  3243. +
  3244. +$cat /dev/null >.deptmp
  3245. +$rm -f *.c.c c/*.c.c
  3246. +if test -f Makefile; then
  3247. +    cp Makefile makefile
  3248. +fi
  3249. +mf=makefile
  3250. +if test -f $mf; then
  3251. +    defrule=`<$mf sed -n        \
  3252. +    -e '/^\.c\.o:.*;/{'        \
  3253. +    -e    's/\$\*\.c//'        \
  3254. +    -e    's/^[^;]*;[     ]*//p'    \
  3255. +    -e    q                \
  3256. +    -e '}'                \
  3257. +    -e '/^\.c\.o: *$/{'        \
  3258. +    -e    N                \
  3259. +    -e    's/\$\*\.c//'        \
  3260. +    -e    's/^.*\n[     ]*//p'        \
  3261. +    -e    q                \
  3262. +    -e '}'`
  3263. +fi
  3264. +case "$defrule" in
  3265. +'') defrule='$(CC) -c $(CFLAGS)' ;;
  3266. +esac
  3267. +
  3268. +make clist || ($echo "Searching for .c files..."; \
  3269. +    $echo *.c | $tr ' ' '\012' | $egrep -v '\*' >.clist)
  3270. +for file in `$cat .clist`; do
  3271. +# for file in `cat /dev/null`; do
  3272. +    case "$file" in
  3273. +    *.c) filebase=`basename $file .c` ;;
  3274. +    *.y) filebase=`basename $file .y` ;;
  3275. +    esac
  3276. +    case "$file" in
  3277. +    */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
  3278. +    *)   finc= ;;
  3279. +    esac
  3280. +    $echo "Finding dependencies for $filebase.o."
  3281. +    ( $echo "#line 1 \"$file\""; \
  3282. +      $sed -n <$file \
  3283. +    -e "/^${filebase}_init(/q" \
  3284. +    -e '/^#/{' \
  3285. +    -e 's|/\*.*$||' \
  3286. +    -e 's|\\$||' \
  3287. +    -e p \
  3288. +    -e '}' ) >$file.c
  3289. +    $cppstdin $finc -I/usr/local/include -I. $cppflags $cppminus <$file.c |
  3290. +    $sed \
  3291. +    -e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
  3292. +    -e 's/^[     ]*#[     ]*line/#/' \
  3293. +    -e '/^# *[0-9][0-9]* *[".\/]/!d' \
  3294. +    -e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \
  3295. +    -e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'.o: \1/' \
  3296. +    -e 's|: \./|: |' \
  3297. +    -e 's|\.c\.c|.c|' | \
  3298. +    $uniq | $sort | $uniq >> .deptmp
  3299. +done
  3300. +
  3301. +$sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d'
  3302. +
  3303. +make shlist || ($echo "Searching for .SH files..."; \
  3304. +    $echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist)
  3305. +if $test -s .deptmp; then
  3306. +    for file in `cat .shlist`; do
  3307. +    $echo `$expr X$file : 'X\(.*\).SH'`: $file config.sh \; \
  3308. +        /bin/sh $file >> .deptmp
  3309. +    done
  3310. +    $echo "Updating $mf..."
  3311. +    $echo "# If this runs make out of memory, delete /usr/include lines." \
  3312. +    >> $mf.new
  3313. +    $sed 's|^\(.*\.o:\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
  3314. +       >>$mf.new
  3315. +else
  3316. +    make hlist || ($echo "Searching for .h files..."; \
  3317. +    $echo *.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist)
  3318. +    $echo "You don't seem to have a proper C preprocessor.  Using grep instead."
  3319. +    $egrep '^#include ' `cat .clist` `cat .hlist`  >.deptmp
  3320. +    $echo "Updating $mf..."
  3321. +    <.clist $sed -n                            \
  3322. +    -e '/\//{'                            \
  3323. +    -e   's|^\(.*\)/\(.*\)\.c|\2.o: \1/\2.c; '"$defrule \1/\2.c|p"    \
  3324. +    -e   d                                \
  3325. +    -e '}'                                \
  3326. +    -e 's|^\(.*\)\.c|\1.o: \1.c|p' >> $mf.new
  3327. +    <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed
  3328. +    <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \
  3329. +       $sed 's|^[^;]*/||' | \
  3330. +       $sed -f .hsed >> $mf.new
  3331. +    <.deptmp $sed -n 's|c:#include <\(.*\)>.*$|o: /usr/include/\1|p' \
  3332. +       >> $mf.new
  3333. +    <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \
  3334. +       $sed -f .hsed >> $mf.new
  3335. +    <.deptmp $sed -n 's|h:#include <\(.*\)>.*$|h: /usr/include/\1|p' \
  3336. +       >> $mf.new
  3337. +    for file in `$cat .shlist`; do
  3338. +    $echo `$expr X$file : 'X\(.*\).SH'`: $file config.sh \; \
  3339. +        /bin/sh $file >> $mf.new
  3340. +    done
  3341. +fi
  3342. +$rm -f $mf.old
  3343. +$cp $mf $mf.old
  3344. +$cp $mf.new $mf
  3345. +$rm $mf.new
  3346. +$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf
  3347. +$rm -f .deptmp `sed 's/\.c/.c.c/' .clist` .shlist .clist .hlist .hsed
  3348. +
  3349. diff -u --new-file --recursive perl-4.036.orig/makedir perl-4.036/makedir
  3350. --- perl-4.036.orig/makedir    Wed Dec 31 18:00:00 1969
  3351. +++ perl-4.036/makedir    Tue Jan 17 21:16:29 1995
  3352. @@ -0,0 +1,56 @@
  3353. +#!/bin/sh
  3354. +# : makedir.SH,v 4063Revision: 4.0.1.1 4063Date: 92/06/08 14:24:55 $
  3355. +# 
  3356. +# $Log:    makedir.SH,v $
  3357. +# Revision 4.0.1.1  92/06/08  14:24:55  lwall
  3358. +# patch20: SH files didn't work well with symbolic links
  3359. +# 
  3360. +# Revision 4.0  91/03/20  01:27:13  lwall
  3361. +# 4.0 baseline.
  3362. +# 
  3363. +# 
  3364. +
  3365. +export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh $0; kill $$)
  3366. +
  3367. +case $# in
  3368. +  0)
  3369. +    /bin/echo "makedir pathname filenameflag"
  3370. +    exit 1
  3371. +    ;;
  3372. +esac
  3373. +
  3374. +: guarantee one slash before 1st component
  3375. +case $1 in
  3376. +  /*) ;;
  3377. +  *)  set ./$1 $2 ;;
  3378. +esac
  3379. +
  3380. +: strip last component if it is to be a filename
  3381. +case X$2 in
  3382. +  X1) set `/bin/echo $1 | /usr/bin/sed 's:\(.*\)/[^/]*$:\1:'` ;;
  3383. +  *)  set $1 ;;
  3384. +esac
  3385. +
  3386. +: return reasonable status if nothing to be created
  3387. +if test -d "$1" ; then
  3388. +    exit 0
  3389. +fi
  3390. +
  3391. +list=''
  3392. +while true ; do
  3393. +    case $1 in
  3394. +    */*)
  3395. +    list="$1 $list"
  3396. +    set `echo $1 | /usr/bin/sed 's:\(.*\)/:\1 :'`
  3397. +    ;;
  3398. +    *)
  3399. +    break
  3400. +    ;;
  3401. +    esac
  3402. +done
  3403. +
  3404. +set $list
  3405. +
  3406. +for dir do
  3407. +    /bin/mkdir $dir >/dev/null 2>&1
  3408. +done
  3409. diff -u --new-file --recursive perl-4.036.orig/pstruct perl-4.036/pstruct
  3410. --- perl-4.036.orig/pstruct    Wed Dec 31 18:00:00 1969
  3411. +++ perl-4.036/pstruct    Tue Jan 17 21:16:27 1995
  3412. @@ -0,0 +1,1071 @@
  3413. +#!/usr/bin/perl
  3414. +#
  3415. +#
  3416. +#   c2ph (aka pstruct)
  3417. +#   Tom Christiansen, <tchrist@convex.com>
  3418. +#   
  3419. +#   As pstruct, dump C structures as generated from 'cc -g -S' stabs.
  3420. +#   As c2ph, do this PLUS generate perl code for getting at the structures.
  3421. +#
  3422. +#   See the usage message for more.  If this isn't enough, read the code.
  3423. +#
  3424. +
  3425. +$RCSID = '$RCSfile: c2ph.SH,v $$Revision: 4.0.1.2 $$Date: 92/06/08 11:56:08 $';
  3426. +
  3427. +
  3428. +######################################################################
  3429. +
  3430. +# some handy data definitions.   many of these can be reset later.
  3431. +
  3432. +$bitorder = 'b';  # ascending; set to B for descending bit fields
  3433. +
  3434. +%intrinsics = 
  3435. +%template = (
  3436. +    'char',             'c',
  3437. +    'unsigned char',         'C',
  3438. +    'short',            's',
  3439. +    'short int',        's',
  3440. +    'unsigned short',        'S',
  3441. +    'unsigned short int',    'S',
  3442. +    'short unsigned int',    'S',
  3443. +    'int',            'i',
  3444. +    'unsigned int',        'I',
  3445. +    'long',            'l',
  3446. +    'long int',            'l',
  3447. +    'unsigned long',        'L',
  3448. +    'unsigned long',        'L',
  3449. +    'long unsigned int',    'L',
  3450. +    'unsigned long int',    'L',
  3451. +    'long long',        'q',
  3452. +    'long long int',        'q',
  3453. +    'unsigned long long',    'Q',
  3454. +    'unsigned long long int',    'Q',
  3455. +    'float',            'f',
  3456. +    'double',            'd',
  3457. +    'pointer',            'p',
  3458. +    'null',            'x',
  3459. +    'neganull',            'X',
  3460. +    'bit',            $bitorder,
  3461. +); 
  3462. +
  3463. +&buildscrunchlist;
  3464. +delete $intrinsics{'neganull'};
  3465. +delete $intrinsics{'bit'};
  3466. +delete $intrinsics{'null'};
  3467. +
  3468. +# use -s to recompute sizes
  3469. +%sizeof = (
  3470. +    'char',             '1',
  3471. +    'unsigned char',         '1',
  3472. +    'short',            '2',
  3473. +    'short int',        '2',
  3474. +    'unsigned short',        '2',
  3475. +    'unsigned short int',    '2',
  3476. +    'short unsigned int',    '2',
  3477. +    'int',            '4',
  3478. +    'unsigned int',        '4',
  3479. +    'long',            '4',
  3480. +    'long int',            '4',
  3481. +    'unsigned long',        '4',
  3482. +    'unsigned long int',    '4',
  3483. +    'long unsigned int',    '4',
  3484. +    'long long',        '8',
  3485. +    'long long int',        '8',
  3486. +    'unsigned long long',    '8',
  3487. +    'unsigned long long int',    '8',
  3488. +    'float',            '4',
  3489. +    'double',            '8',
  3490. +    'pointer',            '4',
  3491. +);
  3492. +
  3493. +($type_width, $member_width, $offset_width, $size_width) = (20, 20, 6, 5);
  3494. +
  3495. +($offset_fmt, $size_fmt) = ('d', 'd');
  3496. +
  3497. +$indent = 2;
  3498. +
  3499. +$CC = 'cc';
  3500. +$CFLAGS = '-g -S';
  3501. +$DEFINES = '';
  3502. +
  3503. +$perl++ if $0 =~ m#/?c2ph$#;
  3504. +
  3505. +require 'getopts.pl';
  3506. +
  3507. +eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
  3508. +
  3509. +&Getopts('aixdpvtnws:') || &usage(0);
  3510. +
  3511. +$opt_d && $debug++;
  3512. +$opt_t && $trace++;
  3513. +$opt_p && $perl++;
  3514. +$opt_v && $verbose++;
  3515. +$opt_n && ($perl = 0);
  3516. +
  3517. +if ($opt_w) {
  3518. +    ($type_width, $member_width, $offset_width) = (45, 35, 8);
  3519. +} 
  3520. +if ($opt_x) {
  3521. +    ($offset_fmt, $offset_width, $size_fmt, $size_width) = ( 'x', '08', 'x', 04 );
  3522. +}
  3523. +
  3524. +eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
  3525. +
  3526. +sub PLUMBER {
  3527. +    select(STDERR);
  3528. +    print "oops, apperent pager foulup\n";
  3529. +    $isatty++;
  3530. +    &usage(1);
  3531. +} 
  3532. +
  3533. +sub usage {
  3534. +    local($oops) = @_;
  3535. +    unless (-t STDOUT) {
  3536. +    select(STDERR);
  3537. +    } elsif (!$oops) {
  3538. +    $isatty++;
  3539. +    $| = 1;
  3540. +    print "hit <RETURN> for further explanation: ";
  3541. +    <STDIN>;
  3542. +    open (PIPE, "|". ($ENV{PAGER} || 'more'));
  3543. +    $SIG{PIPE} = PLUMBER;
  3544. +    select(PIPE);
  3545. +    } 
  3546. +
  3547. +    print "usage: $0 [-dpnP] [var=val] [files ...]\n";
  3548. +
  3549. +    exit unless $isatty;
  3550. +
  3551. +    print <<EOF;
  3552. +
  3553. +Options:
  3554. +
  3555. +-w    wide; short for: type_width=45 member_width=35 offset_width=8
  3556. +-x    hex; short for:  offset_fmt=x offset_width=08 size_fmt=x size_width=04
  3557. +
  3558. +-n      do not generate perl code  (default when invoked as pstruct)
  3559. +-p      generate perl code         (default when invoked as c2ph)
  3560. +-v    generate perl code, with C decls as comments
  3561. +
  3562. +-i    do NOT recompute sizes for intrinsic datatypes
  3563. +-a    dump information on intrinsics also
  3564. +
  3565. +-t     trace execution
  3566. +-d    spew reams of debugging output
  3567. +
  3568. +-slist  give comma-separated list a structures to dump
  3569. +
  3570. +
  3571. +Var Name        Default Value    Meaning
  3572. +
  3573. +EOF
  3574. +
  3575. +    &defvar('CC', 'which_compiler to call');
  3576. +    &defvar('CFLAGS', 'how to generate *.s files with stabs');
  3577. +    &defvar('DEFINES','any extra cflags or cpp defines, like -I, -D, -U');
  3578. +
  3579. +    print "\n";
  3580. +
  3581. +    &defvar('type_width', 'width of type field   (column 1)');
  3582. +    &defvar('member_width', 'width of member field (column 2)');
  3583. +    &defvar('offset_width', 'width of offset field (column 3)');
  3584. +    &defvar('size_width', 'width of size field   (column 4)');
  3585. +
  3586. +    print "\n";
  3587. +
  3588. +    &defvar('offset_fmt', 'sprintf format type for offset');
  3589. +    &defvar('size_fmt', 'sprintf format type for size');
  3590. +
  3591. +    print "\n";
  3592. +
  3593. +    &defvar('indent', 'how far to indent each nesting level');
  3594. +
  3595. +   print <<'EOF';
  3596. +
  3597. +    If any *.[ch] files are given, these will be catted together into
  3598. +    a temporary *.c file and sent through:
  3599. +        $CC $CFLAGS $DEFINES 
  3600. +    and the resulting *.s groped for stab information.  If no files are
  3601. +    supplied, then stdin is read directly with the assumption that it
  3602. +    contains stab information.  All other liens will be ignored.  At
  3603. +    most one *.s file should be supplied.
  3604. +
  3605. +EOF
  3606. +    close PIPE;
  3607. +    exit 1;
  3608. +} 
  3609. +
  3610. +sub defvar {
  3611. +    local($var, $msg) = @_;
  3612. +    printf "%-16s%-15s  %s\n", $var, eval "\$$var", $msg;
  3613. +} 
  3614. +
  3615. +$recurse = 1;
  3616. +
  3617. +if (@ARGV) {
  3618. +    if (grep(!/\.[csh]$/,@ARGV)) {
  3619. +    warn "Only *.[csh] files expected!\n";
  3620. +    &usage;
  3621. +    } 
  3622. +    elsif (grep(/\.s$/,@ARGV)) {
  3623. +    if (@ARGV > 1) { 
  3624. +        warn "Only one *.s file allowed!\n";
  3625. +        &usage;
  3626. +    }
  3627. +    } 
  3628. +    elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) {
  3629. +    local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#;
  3630. +    $chdir = "cd $dir; " if $dir;
  3631. +    &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1;
  3632. +    $ARGV[0] =~ s/\.c$/.s/;
  3633. +    } 
  3634. +    else {
  3635. +    $TMP = "/tmp/c2ph.$$.c";
  3636. +    &system("cat @ARGV > $TMP") && exit 1;
  3637. +    &system("cd /tmp; $CC $CFLAGS $DEFINES $TMP") && exit 1;
  3638. +    unlink $TMP;
  3639. +    $TMP =~ s/\.c$/.s/;
  3640. +    @ARGV = ($TMP);
  3641. +    } 
  3642. +}
  3643. +
  3644. +if ($opt_s) {
  3645. +    for (split(/[\s,]+/, $opt_s)) {
  3646. +    $interested{$_}++;
  3647. +    } 
  3648. +} 
  3649. +
  3650. +
  3651. +$| = 1 if $debug;
  3652. +
  3653. +main: {
  3654. +
  3655. +    if ($trace) {
  3656. +    if (-t && !@ARGV) { 
  3657. +        print STDERR "reading from your keyboard: ";
  3658. +    } else {
  3659. +        print STDERR "reading from " . (@ARGV ? "@ARGV" : "<STDIN>").": ";
  3660. +    }
  3661. +    }
  3662. +
  3663. +STAB: while (<>) {
  3664. +    if ($trace && !($. % 10)) {
  3665. +        $lineno = $..'';
  3666. +        print STDERR $lineno, "\b" x length($lineno);
  3667. +    } 
  3668. +    next unless /^\s*\.stabs\s+/;
  3669. +    $line = $_;
  3670. +    s/^\s*\.stabs\s+//; 
  3671. +    &stab; 
  3672. +    }
  3673. +    print STDERR "$.\n" if $trace;
  3674. +    unlink $TMP if $TMP;
  3675. +
  3676. +    &compute_intrinsics if $perl && !$opt_i;
  3677. +
  3678. +    print STDERR "resolving types\n" if $trace;
  3679. +
  3680. +    &resolve_types;
  3681. +    &adjust_start_addrs;
  3682. +
  3683. +    $sum = 2 + $type_width + $member_width;
  3684. +    $pmask1 = "%-${type_width}s %-${member_width}s"; 
  3685. +    $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s";
  3686. +
  3687. +    if ($perl) {
  3688. +    # resolve template -- should be in stab define order, but even this isn't enough.
  3689. +    print STDERR "\nbuilding type templates: " if $trace;
  3690. +    for $i (reverse 0..$#type) {
  3691. +        next unless defined($name = $type[$i]);
  3692. +        next unless defined $struct{$name};
  3693. +        $build_recursed = 0;
  3694. +        &build_template($name) unless defined $template{&psou($name)} ||
  3695. +                    $opt_s && !$interested{$name};
  3696. +    } 
  3697. +    print STDERR "\n\n" if $trace;
  3698. +    }
  3699. +
  3700. +    print STDERR "dumping structs: " if $trace;
  3701. +
  3702. +
  3703. +    foreach $name (sort keys %struct) {
  3704. +    next if $opt_s && !$interested{$name};
  3705. +    print STDERR "$name " if $trace;
  3706. +
  3707. +    undef @sizeof;
  3708. +    undef @typedef;
  3709. +    undef @offsetof;
  3710. +    undef @indices;
  3711. +    undef @typeof;
  3712. +
  3713. +    $mname = &munge($name);
  3714. +
  3715. +    $fname = &psou($name);
  3716. +
  3717. +    print "# " if $perl && $verbose;
  3718. +    $pcode = '';
  3719. +    print "$fname {\n" if !$perl || $verbose; 
  3720. +    $template{$fname} = &scrunch($template{$fname}) if $perl;
  3721. +    &pstruct($name,$name,0); 
  3722. +    print "# " if $perl && $verbose;
  3723. +    print "}\n" if !$perl || $verbose; 
  3724. +    print "\n" if $perl && $verbose;
  3725. +
  3726. +    if ($perl) {
  3727. +        print "$pcode";
  3728. +
  3729. +        printf("\nsub %-32s { %4d; }\n\n", "${mname}'struct", $countof{$name});
  3730. +
  3731. +        print <<EOF;
  3732. +sub ${mname}'typedef { 
  3733. +    local(\$${mname}'index) = shift;
  3734. +    defined \$${mname}'index 
  3735. +    ? \$${mname}'typedef[\$${mname}'index] 
  3736. +    : \$${mname}'typedef;
  3737. +}
  3738. +EOF
  3739. +
  3740. +        print <<EOF;
  3741. +sub ${mname}'sizeof { 
  3742. +    local(\$${mname}'index) = shift;
  3743. +    defined \$${mname}'index 
  3744. +    ? \$${mname}'sizeof[\$${mname}'index] 
  3745. +    : \$${mname}'sizeof;
  3746. +}
  3747. +EOF
  3748. +
  3749. +        print <<EOF;
  3750. +sub ${mname}'offsetof { 
  3751. +    local(\$${mname}'index) = shift;
  3752. +    defined \$${mname}index 
  3753. +    ? \$${mname}'offsetof[\$${mname}'index] 
  3754. +    : \$${mname}'sizeof;
  3755. +}
  3756. +EOF
  3757. +
  3758. +        print <<EOF;
  3759. +sub ${mname}'typeof { 
  3760. +    local(\$${mname}'index) = shift;
  3761. +    defined \$${mname}index 
  3762. +    ? \$${mname}'typeof[\$${mname}'index] 
  3763. +    : '$name';
  3764. +}
  3765. +EOF
  3766. +    
  3767. +
  3768. +        print "\$${mname}'typedef = '" . &scrunch($template{$fname}) 
  3769. +        . "';\n";
  3770. +
  3771. +        print "\$${mname}'sizeof = $sizeof{$name};\n\n";
  3772. +
  3773. +
  3774. +        print "\@${mname}'indices = (", &squishseq(@indices), ");\n";
  3775. +
  3776. +        print "\n";
  3777. +
  3778. +        print "\@${mname}'typedef[\@${mname}'indices] = (",
  3779. +            join("\n\t", '', @typedef), "\n    );\n\n";
  3780. +        print "\@${mname}'sizeof[\@${mname}'indices] = (",
  3781. +            join("\n\t", '', @sizeof), "\n    );\n\n";
  3782. +        print "\@${mname}'offsetof[\@${mname}'indices] = (",
  3783. +            join("\n\t", '', @offsetof), "\n    );\n\n";
  3784. +        print "\@${mname}'typeof[\@${mname}'indices] = (",
  3785. +            join("\n\t", '', @typeof), "\n    );\n\n";
  3786. +
  3787. +        $template_printed{$fname}++;
  3788. +        $size_printed{$fname}++;
  3789. +    } 
  3790. +    print "\n";
  3791. +    }
  3792. +
  3793. +    print STDERR "\n" if $trace;
  3794. +
  3795. +    unless ($perl && $opt_a) { 
  3796. +    print "\n1;\n";
  3797. +    exit;
  3798. +    }
  3799. +
  3800. +
  3801. +
  3802. +    foreach $name (sort bysizevalue keys %intrinsics) {
  3803. +    next if $size_printed{$name};
  3804. +    print '$',&munge($name),"'sizeof = ", $sizeof{$name}, ";\n";
  3805. +    }
  3806. +
  3807. +    print "\n";
  3808. +
  3809. +    sub bysizevalue { $sizeof{$a} <=> $sizeof{$b}; }
  3810. +
  3811. +
  3812. +    foreach $name (sort keys %intrinsics) {
  3813. +    print '$',&munge($name),"'typedef = '", $template{$name}, "';\n";
  3814. +    }
  3815. +
  3816. +    print "\n1;\n";
  3817. +    
  3818. +    exit;
  3819. +}
  3820. +
  3821. +########################################################################################
  3822. +
  3823. +
  3824. +sub stab {
  3825. +    next unless /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/;  # (\d+,\d+) is for sun
  3826. +    s/"//                         || next;
  3827. +    s/",([x\d]+),([x\d]+),([x\d]+),.*//         || next;
  3828. +
  3829. +    next if /^\s*$/;
  3830. +
  3831. +    $size = $3 if $3;
  3832. +
  3833. +
  3834. +    $line = $_;
  3835. +
  3836. +    if (($name, $pdecl) = /^([\$ \w]+):[tT]((\d+)(=[rufs*](\d+))+)$/) {
  3837. +    print "$name is a typedef for some funky pointers: $pdecl\n" if $debug;
  3838. +    &pdecl($pdecl);
  3839. +    next;
  3840. +    }
  3841. +
  3842. +
  3843. +
  3844. +    if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) {  
  3845. +    local($ident) = $2;
  3846. +    push(@intrinsics, $ident);
  3847. +    $typeno = &typeno($3);
  3848. +    $type[$typeno] = $ident;
  3849. +    print STDERR "intrinsic $ident in new type $typeno\n" if $debug; 
  3850. +    next;
  3851. +    }
  3852. +
  3853. +    if (($name, $typeordef, $typeno, $extra, $struct, $_) 
  3854. +    = /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/) 
  3855. +    {
  3856. +    $typeno = &typeno($typeno);  # sun foolery
  3857. +    } 
  3858. +    elsif (/^[\$\w]+:/) {
  3859. +    next; # variable
  3860. +    }
  3861. +    else { 
  3862. +    warn "can't grok stab: <$_> in: $line " if $_;
  3863. +    next;
  3864. +    } 
  3865. +
  3866. +    #warn "got size $size for $name\n";
  3867. +    $sizeof{$name} = $size if $size;
  3868. +
  3869. +    s/;[-\d]*;[-\d]*;$//;  # we don't care about ranges
  3870. +
  3871. +    $typenos{$name} = $typeno;
  3872. +
  3873. +    unless (defined $type[$typeno]) {
  3874. +    &panic("type 0??") unless $typeno;
  3875. +    $type[$typeno] = $name unless defined $type[$typeno];
  3876. +    printf "new type $typeno is $name" if $debug;
  3877. +    if ($extra =~ /\*/ && defined $type[$struct]) {
  3878. +        print ", a typedef for a pointer to " , $type[$struct] if $debug;
  3879. +    }
  3880. +    } else {
  3881. +    printf "%s is type %d", $name, $typeno if $debug;
  3882. +    print ", a typedef for " , $type[$typeno] if $debug;
  3883. +    } 
  3884. +    print "\n" if $debug;
  3885. +    #next unless $extra =~ /[su*]/;
  3886. +
  3887. +    #$type[$struct] = $name;
  3888. +
  3889. +    if ($extra =~ /[us*]/) {
  3890. +    &sou($name, $extra);
  3891. +    $_ = &sdecl($name, $_, 0);
  3892. +    }
  3893. +    elsif (/^=ar/) {
  3894. +    print "it's a bare array typedef -- that's pretty sick\n" if $debug;
  3895. +    $_ = "$typeno$_";
  3896. +    $scripts = '';
  3897. +    $_ = &adecl($_,1);
  3898. +
  3899. +    }
  3900. +    elsif (s/((\w+):t(\d+|\(\d+,\d+\)))?=r?(;\d+;\d+;)?//) {  # the ?'s are for gcc
  3901. +    push(@intrinsics, $2);
  3902. +    $typeno = &typeno($3);
  3903. +    $type[$typeno] = $2;
  3904. +    print STDERR "intrinsic $2 in new type $typeno\n" if $debug; 
  3905. +    }
  3906. +    elsif (s/^=e//) { # blessed by thy compiler; mine won't do this
  3907. +    &edecl;
  3908. +    } 
  3909. +    else {
  3910. +    warn "Funny remainder for $name on line $_ left in $line " if $_;
  3911. +    } 
  3912. +}
  3913. +
  3914. +sub typeno {  # sun thinks types are (0,27) instead of just 27
  3915. +    local($_) = @_;
  3916. +    s/\(\d+,(\d+)\)/$1/;
  3917. +    $_;
  3918. +} 
  3919. +
  3920. +sub pstruct {
  3921. +    local($what,$prefix,$base) = @_; 
  3922. +    local($field, $fieldname, $typeno, $count, $offset, $entry); 
  3923. +    local($fieldtype);
  3924. +    local($type, $tname); 
  3925. +    local($mytype, $mycount, $entry2);
  3926. +    local($struct_count) = 0;
  3927. +    local($pad, $revpad, $length, $prepad, $lastoffset, $lastlength, $fmt);
  3928. +    local($bits,$bytes);
  3929. +    local($template);
  3930. +
  3931. +
  3932. +    local($mname) = &munge($name);
  3933. +
  3934. +    sub munge { 
  3935. +    local($_) = @_;
  3936. +    s/[\s\$\.]/_/g;
  3937. +    $_;
  3938. +    }
  3939. +
  3940. +    local($sname) = &psou($what);
  3941. +
  3942. +    $nesting++;
  3943. +
  3944. +    for $field (split(/;/, $struct{$what})) {
  3945. +    $pad = $prepad = 0;
  3946. +    $entry = ''; 
  3947. +    ($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field); 
  3948. +
  3949. +    $type = $type[$typeno];
  3950. +
  3951. +    $type =~ /([^[]*)(\[.*\])?/;
  3952. +    $mytype = $1;
  3953. +    $count .= $2;
  3954. +    $fieldtype = &psou($mytype);
  3955. +
  3956. +    local($fname) = &psou($name);
  3957. +
  3958. +    if ($build_templates) {
  3959. +
  3960. +        $pad = ($offset - ($lastoffset + $lastlength))/8 
  3961. +        if defined $lastoffset;
  3962. +
  3963. +        if (! $finished_template{$sname}) {
  3964. +        if ($isaunion{$what}) {
  3965. +            $template{$sname} .= 'X' x $revpad . ' '    if $revpad;
  3966. +        } else {
  3967. +            $template{$sname} .= 'x' x $pad    . ' '    if $pad;
  3968. +        }
  3969. +        }
  3970. +
  3971. +        $template = &fetch_template($type) x 
  3972. +                ($count ? &scripts2count($count) : 1);
  3973. +
  3974. +        if (! $finished_template{$sname}) {
  3975. +        $template{$sname} .= $template;
  3976. +        }
  3977. +
  3978. +        $revpad = $length/8 if $isaunion{$what};
  3979. +
  3980. +        ($lastoffset, $lastlength) = ($offset, $length);
  3981. +
  3982. +    } else { 
  3983. +        print '# ' if $perl && $verbose;
  3984. +        $entry = sprintf($pmask1,
  3985. +            ' ' x ($nesting * $indent) . $fieldtype,
  3986. +            "$prefix.$fieldname" . $count); 
  3987. +
  3988. +        $entry =~ s/(\*+)( )/$2$1/; 
  3989. +
  3990. +        printf $pmask2,
  3991. +            $entry,
  3992. +            ($base+$offset)/8,
  3993. +            ($bits = ($base+$offset)%8) ? ".$bits" : "  ",
  3994. +            $length/8,
  3995. +            ($bits = $length % 8) ? ".$bits": ""
  3996. +            if !$perl || $verbose;
  3997. +
  3998. +
  3999. +        if ($perl && $nesting == 1) {
  4000. +        $template = &scrunch(&fetch_template($type) x 
  4001. +                ($count ? &scripts2count($count) : 1));
  4002. +        push(@sizeof, int($length/8) .",\t# $fieldname");
  4003. +        push(@offsetof, int($offset/8) .",\t# $fieldname");
  4004. +        push(@typedef, "'$template', \t# $fieldname");
  4005. +        $type =~ s/(struct|union) //;
  4006. +        push(@typeof, "'$type" . ($count ? $count : '') .
  4007. +            "',\t# $fieldname");
  4008. +        }
  4009. +
  4010. +        print '  ', ' ' x $indent x $nesting, $template
  4011. +                if $perl && $verbose;
  4012. +
  4013. +        print "\n" if !$perl || $verbose;
  4014. +
  4015. +    }    
  4016. +    if ($perl) {
  4017. +        local($mycount) = defined $struct{$mytype} ? $countof{$mytype} : 1;
  4018. +        $mycount *= &scripts2count($count) if $count;
  4019. +        if ($nesting==1 && !$build_templates) {
  4020. +        $pcode .= sprintf("sub %-32s { %4d; }\n", 
  4021. +            "${mname}'${fieldname}", $struct_count);
  4022. +        push(@indices, $struct_count);
  4023. +        }
  4024. +        $struct_count += $mycount;
  4025. +    } 
  4026. +
  4027. +
  4028. +    &pstruct($type, "$prefix.$fieldname", $base+$offset) 
  4029. +        if $recurse && defined $struct{$type}; 
  4030. +    }
  4031. +
  4032. +    $countof{$what} = $struct_count unless defined $countof{$whati};
  4033. +
  4034. +    $template{$sname} .= '$' if $build_templates;
  4035. +    $finished_template{$sname}++;
  4036. +
  4037. +    if ($build_templates && !defined $sizeof{$name}) {
  4038. +    local($fmt) = &scrunch($template{$sname});
  4039. +    print STDERR "no size for $name, punting with $fmt..." if $debug;
  4040. +    eval '$sizeof{$name} = length(pack($fmt, ()))';
  4041. +    if ($@) {
  4042. +        chop $@;
  4043. +        warn "couldn't get size for \$name: $@";
  4044. +    } else {
  4045. +        print STDERR $sizeof{$name}, "\n" if $debUg;
  4046. +    }
  4047. +    } 
  4048. +
  4049. +    --$nesting;
  4050. +}
  4051. +
  4052. +
  4053. +sub psize {
  4054. +    local($me) = @_; 
  4055. +    local($amstruct) = $struct{$me} ?  'struct ' : '';
  4056. +
  4057. +    print '$sizeof{\'', $amstruct, $me, '\'} = '; 
  4058. +    printf "%d;\n", $sizeof{$me}; 
  4059. +}
  4060. +
  4061. +sub pdecl {
  4062. +    local($pdecl) = @_;
  4063. +    local(@pdecls);
  4064. +    local($tname);
  4065. +
  4066. +    warn "pdecl: $pdecl\n" if $debug;
  4067. +
  4068. +    $pdecl =~ s/\(\d+,(\d+)\)/$1/g;
  4069. +    $pdecl =~ s/\*//g; 
  4070. +    @pdecls = split(/=/, $pdecl); 
  4071. +    $typeno = $pdecls[0];
  4072. +    $tname = pop @pdecls;
  4073. +
  4074. +    if ($tname =~ s/^f//) { $tname = "$tname&"; } 
  4075. +    #else { $tname = "$tname*"; } 
  4076. +
  4077. +    for (reverse @pdecls) {
  4078. +    $tname  .= s/^f// ? "&" : "*"; 
  4079. +    #$tname =~ s/^f(.*)/$1&/;
  4080. +    print "type[$_] is $tname\n" if $debug;
  4081. +    $type[$_] = $tname unless defined $type[$_];
  4082. +    } 
  4083. +}
  4084. +
  4085. +
  4086. +
  4087. +sub adecl {
  4088. +    ($arraytype, $unknown, $lower, $upper) = ();
  4089. +    #local($typeno);
  4090. +    # global $typeno, @type
  4091. +    local($_, $typedef) = @_;
  4092. +
  4093. +    while (s/^((\d+)=)?ar(\d+);//) {
  4094. +    ($arraytype, $unknown) = ($2, $3); 
  4095. +    if (s/^(\d+);(\d+);//) {
  4096. +        ($lower, $upper) = ($1, $2); 
  4097. +        $scripts .= '[' .  ($upper+1) . ']'; 
  4098. +    } else {
  4099. +        warn "can't find array bounds: $_"; 
  4100. +    } 
  4101. +    }
  4102. +    if (s/^([\d*f=]*),(\d+),(\d+);//) {
  4103. +    ($start, $length) = ($2, $3); 
  4104. +    local($whatis) = $1;
  4105. +    if ($whatis =~ /^(\d+)=/) {
  4106. +        $typeno = $1;
  4107. +        &pdecl($whatis);
  4108. +    } else {
  4109. +        $typeno = $whatis;
  4110. +    }
  4111. +    } elsif (s/^(\d+)(=[*suf]\d*)//) {
  4112. +    local($whatis) = $2; 
  4113. +
  4114. +    if ($whatis =~ /[f*]/) {
  4115. +        &pdecl($whatis); 
  4116. +    } elsif ($whatis =~ /[su]/) {  # 
  4117. +        print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n" 
  4118. +        if $debug;
  4119. +        #$type[$typeno] = $name unless defined $type[$typeno];
  4120. +        ##printf "new type $typeno is $name" if $debug;
  4121. +        $typeno = $1;
  4122. +        $type[$typeno] = "$prefix.$fieldname";
  4123. +        local($name) = $type[$typeno];
  4124. +        &sou($name, $whatis);
  4125. +        $_ = &sdecl($name, $_, $start+$offset);
  4126. +        1;
  4127. +        $start = $start{$name};
  4128. +        $offset = $sizeof{$name};
  4129. +        $length = $offset;
  4130. +    } else {
  4131. +        warn "what's this? $whatis in $line ";
  4132. +    } 
  4133. +    } elsif (/^\d+$/) {
  4134. +    $typeno = $_;
  4135. +    } else {
  4136. +    warn "bad array stab: $_ in $line ";
  4137. +    next STAB;
  4138. +    } 
  4139. +    #local($wasdef) = defined($type[$typeno]) && $debug;
  4140. +    #if ($typedef) { 
  4141. +    #print "redefining $type[$typeno] to " if $wasdef;
  4142. +    #$type[$typeno] = "$whatis$scripts"; # unless defined $type[$typeno];
  4143. +    #print "$type[$typeno]\n" if $wasdef;
  4144. +    #} else {
  4145. +    #$type[$arraytype] = $type[$typeno] unless defined $type[$arraytype];
  4146. +    #}
  4147. +    $type[$arraytype] = "$type[$typeno]$scripts" if defined $type[$typeno];
  4148. +    print "type[$arraytype] is $type[$arraytype]\n" if $debug;
  4149. +    print "$prefix.$fieldname is an array of $type[$arraytype]\n" if $debug;
  4150. +    $_;
  4151. +}
  4152. +
  4153. +
  4154. +
  4155. +sub sdecl {
  4156. +    local($prefix, $_, $offset) = @_;
  4157. +
  4158. +    local($fieldname, $scripts, $type, $arraytype, $unknown,
  4159. +    $whatis, $pdecl, $upper,$lower, $start,$length) = ();
  4160. +    local($typeno,$sou);
  4161. +
  4162. +
  4163. +SFIELD:
  4164. +    while (/^([^;]+);/) {
  4165. +    $scripts = '';
  4166. +    warn "sdecl $_\n" if $debug;
  4167. +    if (s/^([\$\w]+)://) { 
  4168. +        $fieldname = $1;
  4169. +    } elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # 
  4170. +        $typeno = &typeno($1);
  4171. +        $type[$typeno] = "$prefix.$fieldname";
  4172. +        local($name) = "$prefix.$fieldname";
  4173. +        &sou($name,$2);
  4174. +        $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
  4175. +        $start = $start{$name};
  4176. +        $offset += $sizeof{$name};
  4177. +        #print "done with anon, start is $start, offset is $offset\n";
  4178. +        #next SFIELD;
  4179. +    } else  {
  4180. +        warn "weird field $_ of $line" if $debug;
  4181. +        next STAB;
  4182. +        #$fieldname = &gensym;
  4183. +        #$_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
  4184. +    }
  4185. +
  4186. +    if (/^\d+=ar/) {
  4187. +        $_ = &adecl($_);
  4188. +    }
  4189. +    elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) {
  4190. +        ($start, $length) =  ($2, $3); 
  4191. +        &panic("no length?") unless $length;
  4192. +        $typeno = &typeno($1) if $1;
  4193. +    }
  4194. +    elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) {
  4195. +        ($pdecl, $start, $length) =  ($1,$5,$6); 
  4196. +        &pdecl($pdecl); 
  4197. +    }
  4198. +    elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct
  4199. +        ($typeno, $sou) = ($1, $2);
  4200. +        $typeno = &typeno($typeno);
  4201. +        if (defined($type[$typeno])) {
  4202. +        warn "now how did we get type $1 in $fieldname of $line?";
  4203. +        } else {
  4204. +        print "anon type $typeno is $prefix.$fieldname\n" if $debug;
  4205. +        $type[$typeno] = "$prefix.$fieldname" unless defined $type[$typeno];
  4206. +        };
  4207. +        local($name) = "$prefix.$fieldname";
  4208. +        &sou($name,$sou);
  4209. +        print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug;
  4210. +        $type[$typeno] = "$prefix.$fieldname";
  4211. +        $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); 
  4212. +        $start = $start{$name};
  4213. +        $length = $sizeof{$name};
  4214. +    }
  4215. +    else {
  4216. +        warn "can't grok stab for $name ($_) in line $line "; 
  4217. +        next STAB; 
  4218. +    }
  4219. +
  4220. +    &panic("no length for $prefix.$fieldname") unless $length;
  4221. +    $struct{$name} .= join(',', $fieldname, $typeno, $scripts, $start, $length) . ';';
  4222. +    }
  4223. +    if (s/;\d*,(\d+),(\d+);//) {
  4224. +    local($start, $size) = ($1, $2); 
  4225. +    $sizeof{$prefix} = $size;
  4226. +    print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug; 
  4227. +    $start{$prefix} = $start; 
  4228. +    } 
  4229. +    $_;
  4230. +}
  4231. +
  4232. +sub edecl {
  4233. +    s/;$//;
  4234. +    $enum{$name} = $_;
  4235. +    $_ = '';
  4236. +} 
  4237. +
  4238. +sub resolve_types {
  4239. +    local($sou);
  4240. +    for $i (0 .. $#type) {
  4241. +    next unless defined $type[$i];
  4242. +    $_ = $type[$i];
  4243. +    unless (/\d/) {
  4244. +        print "type[$i] $type[$i]\n" if $debug;
  4245. +        next;
  4246. +    }
  4247. +    print "type[$i] $_ ==> " if $debug;
  4248. +    s/^(\d+)(\**)\&\*(\**)/"$2($3".&type($1) . ')()'/e;
  4249. +    s/^(\d+)\&/&type($1)/e; 
  4250. +    s/^(\d+)/&type($1)/e; 
  4251. +    s/(\*+)([^*]+)(\*+)/$1$3$2/;
  4252. +    s/\((\*+)(\w+)(\*+)\)/$3($1$2)/;
  4253. +    s/^(\d+)([\*\[].*)/&type($1).$2/e;
  4254. +    #s/(\d+)(\*|(\[[\[\]\d\*]+]\])+)/&type($1).$2/ge;
  4255. +    $type[$i] = $_;
  4256. +    print "$_\n" if $debug;
  4257. +    }
  4258. +}
  4259. +sub type { &psou($type[$_[0]] || "<UNDEFINED>"); } 
  4260. +
  4261. +sub adjust_start_addrs {
  4262. +    for (sort keys %start) {
  4263. +    ($basename = $_) =~ s/\.[^.]+$//;
  4264. +    $start{$_} += $start{$basename};
  4265. +    print "start: $_ @ $start{$_}\n" if $debug;
  4266. +    }
  4267. +}
  4268. +
  4269. +sub sou {
  4270. +    local($what, $_) = @_;
  4271. +    /u/ && $isaunion{$what}++;
  4272. +    /s/ && $isastruct{$what}++;
  4273. +}
  4274. +
  4275. +sub psou {
  4276. +    local($what) = @_;
  4277. +    local($prefix) = '';
  4278. +    if ($isaunion{$what})  {
  4279. +    $prefix = 'union ';
  4280. +    } elsif ($isastruct{$what})  {
  4281. +    $prefix = 'struct ';
  4282. +    }
  4283. +    $prefix . $what;
  4284. +}
  4285. +
  4286. +sub scrunch {
  4287. +    local($_) = @_;
  4288. +
  4289. +    study;
  4290. +
  4291. +    s/\$//g;
  4292. +    s/  / /g;
  4293. +    1 while s/(\w) \1/$1$1/g;
  4294. +
  4295. +    # i wanna say this, but perl resists my efforts:
  4296. +    #       s/(\w)(\1+)/$2 . length($1)/ge;
  4297. +
  4298. +    &quick_scrunch;
  4299. +
  4300. +    s/ $//;
  4301. +
  4302. +    $_;
  4303. +}
  4304. +
  4305. +sub buildscrunchlist {
  4306. +    $scrunch_code = "sub quick_scrunch {\n";
  4307. +    for (values %intrinsics) {
  4308. +        $scrunch_code .= "\ts/($_{2,})/'$_' . length(\$1)/ge;\n";
  4309. +    } 
  4310. +    $scrunch_code .= "}\n";
  4311. +    print "$scrunch_code" if $debug;
  4312. +    eval $scrunch_code;
  4313. +    &panic("can't eval scrunch_code $@ \nscrunch_code") if $@;
  4314. +} 
  4315. +
  4316. +sub fetch_template {
  4317. +    local($mytype) = @_;
  4318. +    local($fmt);
  4319. +    local($count) = 1;
  4320. +
  4321. +    &panic("why do you care?") unless $perl;
  4322. +
  4323. +    if ($mytype =~ s/(\[\d+\])+$//) {
  4324. +    $count .= $1;
  4325. +    } 
  4326. +
  4327. +    if ($mytype =~ /\*/) {
  4328. +    $fmt = $template{'pointer'};
  4329. +    } 
  4330. +    elsif (defined $template{$mytype}) {
  4331. +    $fmt = $template{$mytype};
  4332. +    } 
  4333. +    elsif (defined $struct{$mytype}) {
  4334. +    if (!defined $template{&psou($mytype)}) {
  4335. +        &build_template($mytype) unless $mytype eq $name;
  4336. +    } 
  4337. +    elsif ($template{&psou($mytype)} !~ /\$$/) {
  4338. +        #warn "incomplete template for $mytype\n";
  4339. +    } 
  4340. +    $fmt = $template{&psou($mytype)} || '?';
  4341. +    } 
  4342. +    else {
  4343. +    warn "unknown fmt for $mytype\n";
  4344. +    $fmt = '?';
  4345. +    } 
  4346. +
  4347. +    $fmt x $count . ' ';
  4348. +}
  4349. +
  4350. +sub compute_intrinsics {
  4351. +    local($TMP) = "/tmp/c2ph-i.$$.c";
  4352. +    open (TMP, ">$TMP") || die "can't open $TMP: $!";
  4353. +    select(TMP);
  4354. +
  4355. +    print STDERR "computing intrinsic sizes: " if $trace;
  4356. +
  4357. +    undef %intrinsics;
  4358. +
  4359. +    print <<'EOF';
  4360. +main() {
  4361. +    char *mask = "%d %s\n";
  4362. +EOF
  4363. +
  4364. +    for $type (@intrinsics) {
  4365. +    next if $type eq 'void';
  4366. +    print <<"EOF";
  4367. +    printf(mask,sizeof($type), "$type");
  4368. +EOF
  4369. +    } 
  4370. +
  4371. +    print <<'EOF';
  4372. +    printf(mask,sizeof(char *), "pointer");
  4373. +    exit(0);
  4374. +}
  4375. +EOF
  4376. +    close TMP;
  4377. +
  4378. +    select(STDOUT);
  4379. +    open(PIPE, "cd /tmp && $CC $TMP && /tmp/a.out|");
  4380. +    while (<PIPE>) {
  4381. +    chop;
  4382. +    split(' ',$_,2);;
  4383. +    print "intrinsic $_[1] is size $_[0]\n" if $debug;
  4384. +    $sizeof{$_[1]} = $_[0];
  4385. +    $intrinsics{$_[1]} = $template{$_[0]};
  4386. +    } 
  4387. +    close(PIPE) || die "couldn't read intrinsics!";
  4388. +    unlink($TMP, '/tmp/a.out');
  4389. +    print STDERR "done\n" if $trace;
  4390. +} 
  4391. +
  4392. +sub scripts2count {
  4393. +    local($_) = @_;
  4394. +
  4395. +    s/^\[//;
  4396. +    s/\]$//;
  4397. +    s/\]\[/*/g;
  4398. +    $_ = eval;
  4399. +    &panic("$_: $@") if $@;
  4400. +    $_;
  4401. +}
  4402. +
  4403. +sub system {
  4404. +    print STDERR "@_\n" if $trace;
  4405. +    system @_;
  4406. +} 
  4407. +
  4408. +sub build_template { 
  4409. +    local($name) = @_;
  4410. +
  4411. +    &panic("already got a template for $name") if defined $template{$name};
  4412. +
  4413. +    local($build_templates) = 1;
  4414. +
  4415. +    local($lparen) = '(' x $build_recursed;
  4416. +    local($rparen) = ')' x $build_recursed;
  4417. +
  4418. +    print STDERR "$lparen$name$rparen " if $trace;
  4419. +    $build_recursed++;
  4420. +    &pstruct($name,$name,0);
  4421. +    print STDERR "TEMPLATE for $name is ", $template{&psou($name)}, "\n" if $debug;
  4422. +    --$build_recursed;
  4423. +}
  4424. +
  4425. +
  4426. +sub panic {
  4427. +
  4428. +    select(STDERR);
  4429. +
  4430. +    print "\npanic: @_\n";
  4431. +
  4432. +    exit 1 if $] <= 4.003;  # caller broken
  4433. +
  4434. +    local($i,$_);
  4435. +    local($p,$f,$l,$s,$h,$a,@a,@sub);
  4436. +    for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
  4437. +    @a = @DB'args;
  4438. +    for (@a) {
  4439. +        if (/^StB\000/ && length($_) == length($_main{'_main'})) {
  4440. +        $_ = sprintf("%s",$_);
  4441. +        }
  4442. +        else {
  4443. +        s/'/\\'/g;
  4444. +        s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
  4445. +        s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
  4446. +        s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
  4447. +        }
  4448. +    }
  4449. +    $w = $w ? '@ = ' : '$ = ';
  4450. +    $a = $h ? '(' . join(', ', @a) . ')' : '';
  4451. +    push(@sub, "$w&$s$a from file $f line $l\n");
  4452. +    last if $signal;
  4453. +    }
  4454. +    for ($i=0; $i <= $#sub; $i++) {
  4455. +    last if $signal;
  4456. +    print $sub[$i];
  4457. +    }
  4458. +    exit 1;
  4459. +} 
  4460. +
  4461. +sub squishseq {
  4462. +    local($num);
  4463. +    local($last) = -1e8;
  4464. +    local($string);
  4465. +    local($seq) = '..';
  4466. +
  4467. +    while (defined($num = shift)) {
  4468. +        if ($num == ($last + 1)) {
  4469. +            $string .= $seq unless $inseq++;
  4470. +            $last = $num;
  4471. +            next;
  4472. +        } elsif ($inseq) {
  4473. +            $string .= $last unless $last == -1e8;
  4474. +        }
  4475. +
  4476. +        $string .= ',' if defined $string;
  4477. +        $string .= $num;
  4478. +        $last = $num;
  4479. +        $inseq = 0;
  4480. +    }
  4481. +    $string .= $last if $inseq && $last != -e18;
  4482. +    $string;
  4483. +}
  4484. diff -u --new-file --recursive perl-4.036.orig/x2p/Makefile perl-4.036/x2p/Makefile
  4485. --- perl-4.036.orig/x2p/Makefile    Wed Dec 31 18:00:00 1969
  4486. +++ perl-4.036/x2p/Makefile    Tue Jan 17 21:16:30 1995
  4487. @@ -0,0 +1,130 @@
  4488. +# : Makefile.SH,v 4063Revision: 4.0.1.3 4063Date: 92/06/08 16:11:32 $
  4489. +#
  4490. +# $Log:    Makefile.SH,v $
  4491. +# Revision 4.0.1.3  92/06/08  16:11:32  lwall
  4492. +# patch20: SH files didn't work well with symbolic links
  4493. +# patch20: cray didn't give enough memory to /bin/sh
  4494. +# patch20: makefiles now display new shift/reduce expectations
  4495. +# 
  4496. +# Revision 4.0.1.2  91/11/05  19:19:04  lwall
  4497. +# patch11: random cleanup
  4498. +# 
  4499. +# Revision 4.0.1.1  91/06/07  12:12:14  lwall
  4500. +# patch4: cflags now emits entire cc command except for the filename
  4501. +# 
  4502. +# Revision 4.0  91/03/20  01:57:03  lwall
  4503. +# 4.0 baseline.
  4504. +# 
  4505. +# 
  4506. +
  4507. +CC = gcc
  4508. +YACC = bison -y
  4509. +bin = /usr/bin
  4510. +lib = 
  4511. +mansrc = /usr/man/man1
  4512. +manext = 1
  4513. +LDFLAGS = -s
  4514. +SMALL = 
  4515. +LARGE =  
  4516. +mallocsrc = 
  4517. +mallocobj = 
  4518. +shellflags = 
  4519. +
  4520. +libs = -ldbm -lm
  4521. +
  4522. +CCCMD = `sh $(shellflags) cflags $@`
  4523. +
  4524. +public = a2p s2p find2perl
  4525. +
  4526. +private = 
  4527. +
  4528. +manpages = a2p.man s2p.man
  4529. +
  4530. +util =
  4531. +
  4532. +sh = Makefile.SH makedepend.SH
  4533. +
  4534. +h = EXTERN.h INTERN.h ../config.h handy.h hash.h a2p.h str.h util.h
  4535. +
  4536. +c = hash.c $(mallocsrc) str.c util.c walk.c
  4537. +
  4538. +obj = hash.o $(mallocobj) str.o util.o walk.o
  4539. +
  4540. +lintflags = -phbvxac
  4541. +
  4542. +addedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7
  4543. +
  4544. +# grrr
  4545. +SHELL = /bin/sh
  4546. +
  4547. +.c.o:
  4548. +    $(CCCMD) $*.c
  4549. +
  4550. +all: $(public) $(private) $(util)
  4551. +    touch all
  4552. +
  4553. +a2p: $(obj) a2p.o
  4554. +    $(CC) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p
  4555. +
  4556. +a2p.c: a2p.y
  4557. +    @ echo Expect 231 shift/reduce conflicts...
  4558. +    $(YACC) a2p.y
  4559. +    mv y.tab.c a2p.c
  4560. +
  4561. +a2p.o: a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h handy.h ../config.h str.h hash.h
  4562. +    $(CCCMD) $(LARGE) a2p.c
  4563. +
  4564. +install: a2p s2p
  4565. +# won't work with csh
  4566. +    export PATH || exit 1
  4567. +    - mv $(bin)/a2p $(bin)/a2p.old 2>/dev/null
  4568. +    - mv $(bin)/s2p $(bin)/s2p.old 2>/dev/null
  4569. +    - if test `pwd` != $(bin); then cp $(public) $(bin); fi
  4570. +    cd $(bin); \
  4571. +for pub in $(public); do \
  4572. +chmod +x `basename $$pub`; \
  4573. +done
  4574. +    - if test `pwd` != $(mansrc); then \
  4575. +for page in $(manpages); do \
  4576. +cp $$page $(mansrc)/`basename $$page .man`.$(manext); \
  4577. +done; \
  4578. +fi
  4579. +
  4580. +clean:
  4581. +    rm -f a2p *.o a2p.c
  4582. +
  4583. +realclean: clean
  4584. +    rm -f *.orig */*.orig core $(addedbyconf) a2p.c s2p find2perl all cflags
  4585. +
  4586. +# The following lint has practically everything turned on.  Unfortunately,
  4587. +# you have to wade through a lot of mumbo jumbo that can't be suppressed.
  4588. +# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message
  4589. +# for that spot.
  4590. +
  4591. +lint:
  4592. +    lint $(lintflags) $(defs) $(c) > a2p.fuzz
  4593. +
  4594. +depend: $(mallocsrc) ../makedepend
  4595. +    ../makedepend
  4596. +
  4597. +clist:
  4598. +    echo $(c) | tr ' ' '\012' >.clist
  4599. +
  4600. +hlist:
  4601. +    echo $(h) | tr ' ' '\012' >.hlist
  4602. +
  4603. +shlist:
  4604. +    echo $(sh) | tr ' ' '\012' >.shlist
  4605. +
  4606. +config.sh: ../config.sh
  4607. +    rm -f config.sh
  4608. +    ln ../config.sh .
  4609. +
  4610. +malloc.c: ../malloc.c
  4611. +    sed 's/"perl.h"/"..\/perl.h"/' ../malloc.c >malloc.c
  4612. +
  4613. +# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
  4614. +$(obj):
  4615. +    @ echo "You haven't done a "'"make depend" yet!'; exit 1
  4616. +makedepend: makedepend.SH
  4617. +    /bin/sh $(shellflags) makedepend.SH
  4618. diff -u --new-file --recursive perl-4.036.orig/x2p/cflags perl-4.036/x2p/cflags
  4619. --- perl-4.036.orig/x2p/cflags    Wed Dec 31 18:00:00 1969
  4620. +++ perl-4.036/x2p/cflags    Tue Jan 17 21:16:30 1995
  4621. @@ -0,0 +1,55 @@
  4622. +case "$0" in
  4623. +*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
  4624. +esac
  4625. +case $CONFIG in
  4626. +'')
  4627. +    if test ! -f config.sh; then
  4628. +    ln ../config.sh . || \
  4629. +    ln ../../config.sh . || \
  4630. +    ln ../../../config.sh . || \
  4631. +    (echo "Can't find config.sh."; exit 1)
  4632. +    fi 2>/dev/null
  4633. +    . ./config.sh
  4634. +    ;;
  4635. +esac
  4636. +
  4637. +also=': '
  4638. +case $# in
  4639. +1) also='echo 1>&2 "      CCCMD = "'
  4640. +esac
  4641. +
  4642. +case $# in
  4643. +0) set *.c; echo "The current C flags are:" ;;
  4644. +esac
  4645. +
  4646. +set `echo "$* " | sed 's/\.[oc] / /g'`
  4647. +
  4648. +for file do
  4649. +
  4650. +    case "$#" in
  4651. +    1) ;;
  4652. +    *) echo $n "    $file.c    $c" ;;
  4653. +    esac
  4654. +
  4655. +    : allow variables like str_cflags to be evaluated
  4656. +
  4657. +    eval 'eval ${'"${file}_cflags"'-""}'
  4658. +
  4659. +    : or customize here
  4660. +
  4661. +    case "$file" in
  4662. +    a2p) ;;
  4663. +    a2py) ;;
  4664. +    hash) ;;
  4665. +    str) ;;
  4666. +    util) ;;
  4667. +    walk) ;;
  4668. +    *) ;;
  4669. +    esac
  4670. +
  4671. +    echo "$cc -c $ccflags $optimize $large $split"
  4672. +    eval "$also "'"$cc -c $ccflags $optimize $large $split"'
  4673. +
  4674. +    . ./config.sh
  4675. +
  4676. +done
  4677. diff -u --new-file --recursive perl-4.036.orig/x2p/cppstdin perl-4.036/x2p/cppstdin
  4678. --- perl-4.036.orig/x2p/cppstdin    Wed Dec 31 18:00:00 1969
  4679. +++ perl-4.036/x2p/cppstdin    Tue Jan 17 21:16:26 1995
  4680. @@ -0,0 +1 @@
  4681. +cat >.$$.c; gcc -E ${1+"$@"} .$$.c; rm .$$.c
  4682. diff -u --new-file --recursive perl-4.036.orig/x2p/find2perl perl-4.036/x2p/find2perl
  4683. --- perl-4.036.orig/x2p/find2perl    Wed Dec 31 18:00:00 1969
  4684. +++ perl-4.036/x2p/find2perl    Tue Jan 17 21:16:31 1995
  4685. @@ -0,0 +1,568 @@
  4686. +#!/usr/bin/perl
  4687. +
  4688. +eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
  4689. +    if $running_under_some_shell;
  4690. +
  4691. +$bin = "/usr/bin";
  4692. +
  4693. +
  4694. +while ($ARGV[0] =~ /^[^-!(]/) {
  4695. +    push(@roots, shift);
  4696. +}
  4697. +@roots = ('.') unless @roots;
  4698. +for (@roots) { $_ = "e($_); }
  4699. +$roots = join(',', @roots);
  4700. +
  4701. +$indent = 1;
  4702. +
  4703. +while (@ARGV) {
  4704. +    $_ = shift;
  4705. +    s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
  4706. +    if ($_ eq '(') {
  4707. +    $out .= &tab . "(\n";
  4708. +    $indent++;
  4709. +    next;
  4710. +    }
  4711. +    elsif ($_ eq ')') {
  4712. +    $indent--;
  4713. +    $out .= &tab . ")";
  4714. +    }
  4715. +    elsif ($_ eq '!') {
  4716. +    $out .= &tab . "!";
  4717. +    next;
  4718. +    }
  4719. +    elsif ($_ eq 'name') {
  4720. +    $out .= &tab;
  4721. +    $pat = &fileglob_to_re(shift);
  4722. +    $out .= '/' . $pat . "/";
  4723. +    }
  4724. +    elsif ($_ eq 'perm') {
  4725. +    $onum = shift;
  4726. +    die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
  4727. +    if ($onum =~ s/^-//) {
  4728. +        $onum = '0' . sprintf("%o", oct($onum) & 017777);    # s/b 07777 ?
  4729. +        $out .= &tab . "((\$mode & $onum) == $onum)";
  4730. +    }
  4731. +    else {
  4732. +        $onum = '0' . $onum unless $onum =~ /^0/;
  4733. +        $out .= &tab . "((\$mode & 0777) == $onum)";
  4734. +    }
  4735. +    }
  4736. +    elsif ($_ eq 'type') {
  4737. +    ($filetest = shift) =~ tr/s/S/;
  4738. +    $out .= &tab . "-$filetest _";
  4739. +    }
  4740. +    elsif ($_ eq 'print') {
  4741. +    $out .= &tab . 'print("$name\n")';
  4742. +    }
  4743. +    elsif ($_ eq 'print0') {
  4744. +    $out .= &tab . 'print("$name\0")';
  4745. +    }
  4746. +    elsif ($_ eq 'fstype') {
  4747. +    $out .= &tab;
  4748. +    $type = shift;
  4749. +    if ($type eq 'nfs')
  4750. +        { $out .= '$dev < 0'; }
  4751. +    else
  4752. +        { $out .= '$dev >= 0'; }
  4753. +    }
  4754. +    elsif ($_ eq 'user') {
  4755. +    $uname = shift;
  4756. +    $out .= &tab . "\$uid == \$uid{'$uname'}";
  4757. +    $inituser++;
  4758. +    }
  4759. +    elsif ($_ eq 'group') {
  4760. +    $gname = shift;
  4761. +    $out .= &tab . "\$gid == \$gid{'$gname'}";
  4762. +    $initgroup++;
  4763. +    }
  4764. +    elsif ($_ eq 'nouser') {
  4765. +    $out .= &tab . '!defined $uid{$uid}';
  4766. +    $inituser++;
  4767. +    }
  4768. +    elsif ($_ eq 'nogroup') {
  4769. +    $out .= &tab . '!defined $gid{$gid}';
  4770. +    $initgroup++;
  4771. +    }
  4772. +    elsif ($_ eq 'links') {
  4773. +    $out .= &tab . '$nlink ' . &n(shift);
  4774. +    }
  4775. +    elsif ($_ eq 'inum') {
  4776. +    $out .= &tab . '$ino ' . &n(shift);
  4777. +    }
  4778. +    elsif ($_ eq 'size') {
  4779. +    $out .= &tab . 'int((-s _ + 511) / 512) ' . &n(shift);
  4780. +    }
  4781. +    elsif ($_ eq 'atime') {
  4782. +    $out .= &tab . 'int(-A _) ' . &n(shift);
  4783. +    }
  4784. +    elsif ($_ eq 'mtime') {
  4785. +    $out .= &tab . 'int(-M _) ' . &n(shift);
  4786. +    }
  4787. +    elsif ($_ eq 'ctime') {
  4788. +    $out .= &tab . 'int(-C _) ' . &n(shift);
  4789. +    }
  4790. +    elsif ($_ eq 'exec') {
  4791. +    for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
  4792. +    shift;
  4793. +    $_ = "@cmd";
  4794. +    if (m#^(/bin/)?rm -f {}$#) {
  4795. +        if (!@ARGV) {
  4796. +        $out .= &tab . 'unlink($_)';
  4797. +        }
  4798. +        else {
  4799. +        $out .= &tab . '(unlink($_) || 1)';
  4800. +        }
  4801. +    }
  4802. +    elsif (m#^(/bin/)?rm {}$#) {
  4803. +        $out .= &tab . '(unlink($_) || warn "$name: $!\n")';
  4804. +    }
  4805. +    else {
  4806. +        for (@cmd) { s/'/\\'/g; }
  4807. +        $" = "','";
  4808. +        $out .= &tab . "&exec(0, '@cmd')";
  4809. +        $" = ' ';
  4810. +        $initexec++;
  4811. +    }
  4812. +    }
  4813. +    elsif ($_ eq 'ok') {
  4814. +    for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
  4815. +    shift;
  4816. +    for (@cmd) { s/'/\\'/g; }
  4817. +    $" = "','";
  4818. +    $out .= &tab . "&exec(1, '@cmd')";
  4819. +    $" = ' ';
  4820. +    $initexec++;
  4821. +    }
  4822. +    elsif ($_ eq 'prune') {
  4823. +    $out .= &tab . '($prune = 1)';
  4824. +    }
  4825. +    elsif ($_ eq 'xdev') {
  4826. +    $out .= &tab . '(($prune |= ($dev != $topdev)),1)';
  4827. +    }
  4828. +    elsif ($_ eq 'newer') {
  4829. +    $out .= &tab;
  4830. +    $file = shift;
  4831. +    $newername = 'AGE_OF' . $file;
  4832. +    $newername =~ s/[^\w]/_/g;
  4833. +    $newername = '$' . $newername;
  4834. +    $out .= "-M _ < $newername";
  4835. +    $initnewer .= "$newername = -M " . "e($file) . ";\n";
  4836. +    }
  4837. +    elsif ($_ eq 'eval') {
  4838. +    $prog = "e(shift);
  4839. +    $out .= &tab . "eval $prog";
  4840. +    }
  4841. +    elsif ($_ eq 'depth') {
  4842. +    $depth++;
  4843. +    next;
  4844. +    }
  4845. +    elsif ($_ eq 'ls') {
  4846. +    $out .= &tab . "&ls";
  4847. +    $initls++;
  4848. +    }
  4849. +    elsif ($_ eq 'tar') {
  4850. +    $out .= &tab;
  4851. +    die "-tar must have a filename argument\n" unless @ARGV;
  4852. +    $file = shift;
  4853. +    $fh = 'FH' . $file;
  4854. +    $fh =~ s/[^\w]/_/g;
  4855. +    $out .= "&tar($fh)";
  4856. +    $file = '>' . $file;
  4857. +    $initfile .= "open($fh, " . "e($file) .
  4858. +      qq{) || die "Can't open $fh: \$!\\n";\n};
  4859. +    $inittar++;
  4860. +    $flushall = "\n&tflushall;\n";
  4861. +    }
  4862. +    elsif (/^n?cpio$/) {
  4863. +    $depth++;
  4864. +    $out .= &tab;
  4865. +    die "-$_ must have a filename argument\n" unless @ARGV;
  4866. +    $file = shift;
  4867. +    $fh = 'FH' . $file;
  4868. +    $fh =~ s/[^\w]/_/g;
  4869. +    $out .= "&cpio('" . substr($_,0,1) . "', $fh)";
  4870. +    $file = '>' . $file;
  4871. +    $initfile .= "open($fh, " . "e($file) .
  4872. +      qq{) || die "Can't open $fh: \$!\\n";\n};
  4873. +    $initcpio++;
  4874. +    $flushall = "\n&flushall;\n";
  4875. +    }
  4876. +    else {
  4877. +    die "Unrecognized switch: -$_\n";
  4878. +    }
  4879. +    if (@ARGV) {
  4880. +    if ($ARGV[0] eq '-o') {
  4881. +        { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
  4882. +        $statdone = 0 if $indent == 1 && $delayedstat;
  4883. +        $saw_or++;
  4884. +        shift;
  4885. +    }
  4886. +    else {
  4887. +        $out .= " &&" unless $ARGV[0] eq ')';
  4888. +        $out .= "\n";
  4889. +        shift if $ARGV[0] eq '-a';
  4890. +    }
  4891. +    }
  4892. +}
  4893. +
  4894. +print <<"END";
  4895. +#!$bin/perl
  4896. +
  4897. +eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
  4898. +    if \$running_under_some_shell;
  4899. +
  4900. +END
  4901. +
  4902. +if ($initls) {
  4903. +    print <<'END';
  4904. +@rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
  4905. +@moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
  4906. +
  4907. +END
  4908. +}
  4909. +
  4910. +if ($inituser || $initls) {
  4911. +    print 'while (($name, $pw, $uid) = getpwent) {', "\n";
  4912. +    print '    $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
  4913. +    print '    $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
  4914. +    print "}\n\n";
  4915. +}
  4916. +
  4917. +if ($initgroup || $initls) {
  4918. +    print 'while (($name, $pw, $gid) = getgrent) {', "\n";
  4919. +    print '    $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
  4920. +    print '    $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
  4921. +    print "}\n\n";
  4922. +}
  4923. +
  4924. +print $initnewer, "\n" if $initnewer;
  4925. +
  4926. +print $initfile, "\n" if $initfile;
  4927. +
  4928. +$find = $depth ? "finddepth" : "find";
  4929. +print <<"END";
  4930. +require "$find.pl";
  4931. +
  4932. +# Traverse desired filesystems
  4933. +
  4934. +&$find($roots);
  4935. +$flushall
  4936. +exit;
  4937. +
  4938. +sub wanted {
  4939. +$out;
  4940. +}
  4941. +
  4942. +END
  4943. +
  4944. +if ($initexec) {
  4945. +    print <<'END';
  4946. +sub exec {
  4947. +    local($ok, @cmd) = @_;
  4948. +    foreach $word (@cmd) {
  4949. +    $word =~ s#{}#$name#g;
  4950. +    }
  4951. +    if ($ok) {
  4952. +    local($old) = select(STDOUT);
  4953. +    $| = 1;
  4954. +    print "@cmd";
  4955. +    select($old);
  4956. +    return 0 unless <STDIN> =~ /^y/;
  4957. +    }
  4958. +    chdir $cwd;        # sigh
  4959. +    system @cmd;
  4960. +    chdir $dir;
  4961. +    return !$?;
  4962. +}
  4963. +
  4964. +END
  4965. +}
  4966. +
  4967. +if ($initls) {
  4968. +    print <<'END';
  4969. +sub ls {
  4970. +    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
  4971. +      $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  4972. +
  4973. +    $pname = $name;
  4974. +
  4975. +    if (defined $blocks) {
  4976. +    $blocks = int(($blocks + 1) / 2);
  4977. +    }
  4978. +    else {
  4979. +    $blocks = int(($size + 1023) / 1024);
  4980. +    }
  4981. +
  4982. +    if    (-f _) { $perms = '-'; }
  4983. +    elsif (-d _) { $perms = 'd'; }
  4984. +    elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
  4985. +    elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
  4986. +    elsif (-p _) { $perms = 'p'; }
  4987. +    elsif (-S _) { $perms = 's'; }
  4988. +    else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
  4989. +
  4990. +    $tmpmode = $mode;
  4991. +    $tmp = $rwx[$tmpmode & 7];
  4992. +    $tmpmode >>= 3;
  4993. +    $tmp = $rwx[$tmpmode & 7] . $tmp;
  4994. +    $tmpmode >>= 3;
  4995. +    $tmp = $rwx[$tmpmode & 7] . $tmp;
  4996. +    substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
  4997. +    substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
  4998. +    substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
  4999. +    $perms .= $tmp;
  5000. +
  5001. +    $user = $user{$uid} || $uid;
  5002. +    $group = $group{$gid} || $gid;
  5003. +
  5004. +    ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
  5005. +    $moname = $moname[$mon];
  5006. +    if (-M _ > 365.25 / 2) {
  5007. +    $timeyear = '19' . $year;
  5008. +    }
  5009. +    else {
  5010. +    $timeyear = sprintf("%02d:%02d", $hour, $min);
  5011. +    }
  5012. +
  5013. +    printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
  5014. +        $ino,
  5015. +         $blocks,
  5016. +              $perms,
  5017. +                $nlink,
  5018. +                $user,
  5019. +                     $group,
  5020. +                      $sizemm,
  5021. +                          $moname,
  5022. +                         $mday,
  5023. +                             $timeyear,
  5024. +                             $pname;
  5025. +    1;
  5026. +}
  5027. +
  5028. +sub sizemm {
  5029. +    sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
  5030. +}
  5031. +
  5032. +END
  5033. +}
  5034. +
  5035. +if ($initcpio) {
  5036. +print <<'END';
  5037. +sub cpio {
  5038. +    local($nc,$fh) = @_;
  5039. +    local($text);
  5040. +
  5041. +    if ($name eq 'TRAILER!!!') {
  5042. +    $text = '';
  5043. +    $size = 0;
  5044. +    }
  5045. +    else {
  5046. +    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  5047. +      $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  5048. +    if (-f _) {
  5049. +        open(IN, "./$_\0") || do {
  5050. +        warn "Couldn't open $name: $!\n";
  5051. +        return;
  5052. +        };
  5053. +    }
  5054. +    else {
  5055. +        $text = readlink($_);
  5056. +        $size = 0 unless defined $text;
  5057. +    }
  5058. +    }
  5059. +
  5060. +    ($nm = $name) =~ s#^\./##;
  5061. +    $nc{$fh} = $nc;
  5062. +    if ($nc eq 'n') {
  5063. +    $cpout{$fh} .=
  5064. +      sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
  5065. +        070707,
  5066. +        $dev & 0777777,
  5067. +        $ino & 0777777,
  5068. +        $mode & 0777777,
  5069. +        $uid & 0777777,
  5070. +        $gid & 0777777,
  5071. +        $nlink & 0777777,
  5072. +        $rdev & 0177777,
  5073. +        $mtime,
  5074. +        length($nm)+1,
  5075. +        $size,
  5076. +        $nm);
  5077. +    }
  5078. +    else {
  5079. +    $cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
  5080. +    $cpout{$fh} .= pack("SSSSSSSSLSLa*",
  5081. +        070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
  5082. +        length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
  5083. +    }
  5084. +    if ($text ne '') {
  5085. +    $cpout{$fh} .= $text;
  5086. +    }
  5087. +    elsif ($size) {
  5088. +    &flush($fh) while ($l = length($cpout{$fh})) >= 5120;
  5089. +    while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
  5090. +        &flush($fh);
  5091. +        $l = length($cpout{$fh});
  5092. +    }
  5093. +    }
  5094. +    close IN;
  5095. +}
  5096. +
  5097. +sub flush {
  5098. +    local($fh) = @_;
  5099. +
  5100. +    while (length($cpout{$fh}) >= 5120) {
  5101. +    syswrite($fh,$cpout{$fh},5120);
  5102. +    ++$blocks{$fh};
  5103. +    substr($cpout{$fh}, 0, 5120) = '';
  5104. +    }
  5105. +}
  5106. +
  5107. +sub flushall {
  5108. +    $name = 'TRAILER!!!';
  5109. +    foreach $fh (keys %cpout) {
  5110. +    &cpio($nc{$fh},$fh);
  5111. +    $cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
  5112. +    &flush($fh);
  5113. +    print $blocks{$fh} * 10, " blocks\n";
  5114. +    }
  5115. +}
  5116. +
  5117. +END
  5118. +}
  5119. +
  5120. +if ($inittar) {
  5121. +print <<'END';
  5122. +sub tar {
  5123. +    local($fh) = @_;
  5124. +    local($linkname,$header,$l,$slop);
  5125. +    local($linkflag) = "\0";
  5126. +
  5127. +    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  5128. +      $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  5129. +    $nm = $name;
  5130. +    if ($nlink > 1) {
  5131. +    if ($linkname = $linkseen{$fh,$dev,$ino}) {
  5132. +        $linkflag = 1;
  5133. +    }
  5134. +    else {
  5135. +        $linkseen{$fh,$dev,$ino} = $nm;
  5136. +    }
  5137. +    }
  5138. +    if (-f _) {
  5139. +    open(IN, "./$_\0") || do {
  5140. +        warn "Couldn't open $name: $!\n";
  5141. +        return;
  5142. +    };
  5143. +    $size = 0 if $linkflag ne "\0";
  5144. +    }
  5145. +    else {
  5146. +    $linkname = readlink($_);
  5147. +    $linkflag = 2 if defined $linkname;
  5148. +    $nm .= '/' if -d _;
  5149. +    $size = 0;
  5150. +    }
  5151. +
  5152. +    $header = pack("a100a8a8a8a12a12a8a1a100",
  5153. +    $nm,
  5154. +    sprintf("%6o ", $mode & 0777),
  5155. +    sprintf("%6o ", $uid & 0777777),
  5156. +    sprintf("%6o ", $gid & 0777777),
  5157. +    sprintf("%11o ", $size),
  5158. +    sprintf("%11o ", $mtime),
  5159. +    "        ",
  5160. +    $linkflag,
  5161. +    $linkname);
  5162. +    $l = length($header) % 512;
  5163. +    substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
  5164. +    substr($header, 154, 1) = "\0";  # blech
  5165. +    $tarout{$fh} .= $header;
  5166. +    $tarout{$fh} .= "\0" x (512 - $l) if $l;
  5167. +    if ($size) {
  5168. +    &tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
  5169. +    while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
  5170. +        $slop = length($tarout{$fh}) % 512;
  5171. +        $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
  5172. +        &tflush($fh);
  5173. +        $l = length($tarout{$fh});
  5174. +    }
  5175. +    }
  5176. +    close IN;
  5177. +}
  5178. +
  5179. +sub tflush {
  5180. +    local($fh) = @_;
  5181. +
  5182. +    while (length($tarout{$fh}) >= 10240) {
  5183. +    syswrite($fh,$tarout{$fh},10240);
  5184. +    ++$blocks{$fh};
  5185. +    substr($tarout{$fh}, 0, 10240) = '';
  5186. +    }
  5187. +}
  5188. +
  5189. +sub tflushall {
  5190. +    local($len);
  5191. +
  5192. +    foreach $fh (keys %tarout) {
  5193. +    $len = 10240 - length($tarout{$fh});
  5194. +    $len += 10240 if $len < 1024;
  5195. +    $tarout{$fh} .= "\0" x $len;
  5196. +    &tflush($fh);
  5197. +    }
  5198. +}
  5199. +
  5200. +END
  5201. +}
  5202. +
  5203. +exit;
  5204. +
  5205. +############################################################################
  5206. +
  5207. +sub tab {
  5208. +    local($tabstring);
  5209. +
  5210. +    $tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
  5211. +    if (!$statdone) {
  5212. +    if ($_ =~ /^(name|print|prune|exec|ok|\(|\))/) {
  5213. +        $delayedstat++;
  5214. +    }
  5215. +    else {
  5216. +        if ($saw_or) {
  5217. +        $tabstring .= <<'ENDOFSTAT' . $tabstring;
  5218. +($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
  5219. +ENDOFSTAT
  5220. +        }
  5221. +        else {
  5222. +        $tabstring .= <<'ENDOFSTAT' . $tabstring;
  5223. +(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
  5224. +ENDOFSTAT
  5225. +        }
  5226. +        $statdone = 1;
  5227. +    }
  5228. +    }
  5229. +    $tabstring =~ s/^\s+/ / if $out =~ /!$/;
  5230. +    $tabstring;
  5231. +}
  5232. +
  5233. +sub fileglob_to_re {
  5234. +    local($tmp) = @_;
  5235. +
  5236. +    $tmp =~ s/([.^\$()])/\\$1/g;
  5237. +    $tmp =~ s/([?*])/.$1/g;
  5238. +    "^$tmp$";
  5239. +}
  5240. +
  5241. +sub n {
  5242. +    local($n) = @_;
  5243. +
  5244. +    $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
  5245. +    $n =~ s/ 0*(\d)/ $1/;
  5246. +    $n;
  5247. +}
  5248. +
  5249. +sub quote {
  5250. +    local($string) = @_;
  5251. +    $string =~ s/'/\\'/;
  5252. +    "'$string'";
  5253. +}
  5254. diff -u --new-file --recursive perl-4.036.orig/x2p/s2p perl-4.036/x2p/s2p
  5255. --- perl-4.036.orig/x2p/s2p    Wed Dec 31 18:00:00 1969
  5256. +++ perl-4.036/x2p/s2p    Tue Jan 17 21:16:31 1995
  5257. @@ -0,0 +1,758 @@
  5258. +#!/usr/bin/perl
  5259. +
  5260. +eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
  5261. +    if $running_under_some_shell;
  5262. +
  5263. +$bin = '/usr/bin';
  5264. +
  5265. +# $RCSfile: s2p.SH,v $$Revision: 4.0.1.2 $$Date: 92/06/08 17:26:31 $
  5266. +#
  5267. +# $Log:    s2p.SH,v $
  5268. +# Revision 4.0.1.2  92/06/08  17:26:31  lwall
  5269. +# patch20: s2p didn't output portable startup code
  5270. +# patch20: added ... as variant on ..
  5271. +# patch20: s2p didn't translate s/pat/\&/ or s/pat/\$/ or s/pat/\\1/ right
  5272. +# 
  5273. +# Revision 4.0.1.1  91/06/07  12:19:18  lwall
  5274. +# patch4: s2p now handles embedded newlines better and optimizes common idioms
  5275. +# 
  5276. +# Revision 4.0  91/03/20  01:57:59  lwall
  5277. +# 4.0 baseline.
  5278. +# 
  5279. +#
  5280. +
  5281. +$indent = 4;
  5282. +$shiftwidth = 4;
  5283. +$l = '{'; $r = '}';
  5284. +
  5285. +while ($ARGV[0] =~ /^-/) {
  5286. +    $_ = shift;
  5287. +  last if /^--/;
  5288. +    if (/^-D/) {
  5289. +    $debug++;
  5290. +    open(BODY,'>-');
  5291. +    next;
  5292. +    }
  5293. +    if (/^-n/) {
  5294. +    $assumen++;
  5295. +    next;
  5296. +    }
  5297. +    if (/^-p/) {
  5298. +    $assumep++;
  5299. +    next;
  5300. +    }
  5301. +    die "I don't recognize this switch: $_\n";
  5302. +}
  5303. +
  5304. +unless ($debug) {
  5305. +    open(BODY,">/tmp/sperl$$") ||
  5306. +      &Die("Can't open temp file: $!\n");
  5307. +}
  5308. +
  5309. +if (!$assumen && !$assumep) {
  5310. +    print BODY &q(<<'EOT');
  5311. +:    while ($ARGV[0] =~ /^-/) {
  5312. +:        $_ = shift;
  5313. +:      last if /^--/;
  5314. +:        if (/^-n/) {
  5315. +:        $nflag++;
  5316. +:        next;
  5317. +:        }
  5318. +:        die "I don't recognize this switch: $_\\n";
  5319. +:    }
  5320. +:    
  5321. +EOT
  5322. +}
  5323. +
  5324. +print BODY &q(<<'EOT');
  5325. +:    #ifdef PRINTIT
  5326. +:    #ifdef ASSUMEP
  5327. +:    $printit++;
  5328. +:    #else
  5329. +:    $printit++ unless $nflag;
  5330. +:    #endif
  5331. +:    #endif
  5332. +:    <><>
  5333. +:    $\ = "\n";        # automatically add newline on print
  5334. +:    <><>
  5335. +:    #ifdef TOPLABEL
  5336. +:    LINE:
  5337. +:    while (chop($_ = <>)) {
  5338. +:    #else
  5339. +:    LINE:
  5340. +:    while (<>) {
  5341. +:        chop;
  5342. +:    #endif
  5343. +EOT
  5344. +
  5345. +LINE:
  5346. +while (<>) {
  5347. +
  5348. +    # Wipe out surrounding whitespace.
  5349. +
  5350. +    s/[ \t]*(.*)\n$/$1/;
  5351. +
  5352. +    # Perhaps it's a label/comment.
  5353. +
  5354. +    if (/^:/) {
  5355. +    s/^:[ \t]*//;
  5356. +    $label = &make_label($_);
  5357. +    if ($. == 1) {
  5358. +        $toplabel = $label;
  5359. +        if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
  5360. +        $_ = <>;
  5361. +        redo LINE; # Never referenced, so delete it if not a comment.
  5362. +        }
  5363. +    }
  5364. +    $_ = "$label:";
  5365. +    if ($lastlinewaslabel++) {
  5366. +        $indent += 4;
  5367. +        print BODY &tab, ";\n";
  5368. +        $indent -= 4;
  5369. +    }
  5370. +    if ($indent >= 2) {
  5371. +        $indent -= 2;
  5372. +        $indmod = 2;
  5373. +    }
  5374. +    next;
  5375. +    } else {
  5376. +    $lastlinewaslabel = '';
  5377. +    }
  5378. +
  5379. +    # Look for one or two address clauses
  5380. +
  5381. +    $addr1 = '';
  5382. +    $addr2 = '';
  5383. +    if (s/^([0-9]+)//) {
  5384. +    $addr1 = "$1";
  5385. +    $addr1 = "\$. == $addr1" unless /^,/;
  5386. +    }
  5387. +    elsif (s/^\$//) {
  5388. +    $addr1 = 'eof()';
  5389. +    }
  5390. +    elsif (s|^/||) {
  5391. +    $addr1 = &fetchpat('/');
  5392. +    }
  5393. +    if (s/^,//) {
  5394. +    if (s/^([0-9]+)//) {
  5395. +        $addr2 = "$1";
  5396. +    } elsif (s/^\$//) {
  5397. +        $addr2 = "eof()";
  5398. +    } elsif (s|^/||) {
  5399. +        $addr2 = &fetchpat('/');
  5400. +    } else {
  5401. +        &Die("Invalid second address at line $.\n");
  5402. +    }
  5403. +    if ($addr2 =~ /^\d+$/) {
  5404. +        $addr1 .= "..$addr2";
  5405. +    }
  5406. +    else {
  5407. +        $addr1 .= "...$addr2";
  5408. +    }
  5409. +    }
  5410. +
  5411. +    # Now we check for metacommands {, }, and ! and worry
  5412. +    # about indentation.
  5413. +
  5414. +    s/^[ \t]+//;
  5415. +    # a { to keep vi happy
  5416. +    if ($_ eq '}') {
  5417. +    $indent -= 4;
  5418. +    next;
  5419. +    }
  5420. +    if (s/^!//) {
  5421. +    $if = 'unless';
  5422. +    $else = "$r else $l\n";
  5423. +    } else {
  5424. +    $if = 'if';
  5425. +    $else = '';
  5426. +    }
  5427. +    if (s/^{//) {    # a } to keep vi happy
  5428. +    $indmod = 4;
  5429. +    $redo = $_;
  5430. +    $_ = '';
  5431. +    $rmaybe = '';
  5432. +    } else {
  5433. +    $rmaybe = "\n$r";
  5434. +    if ($addr2 || $addr1) {
  5435. +        $space = ' ' x $shiftwidth;
  5436. +    } else {
  5437. +        $space = '';
  5438. +    }
  5439. +    $_ = &transmogrify();
  5440. +    }
  5441. +
  5442. +    # See if we can optimize to modifier form.
  5443. +
  5444. +    if ($addr1) {
  5445. +    if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
  5446. +      $_ !~ / if / && $_ !~ / unless /) {
  5447. +        s/;$/ $if $addr1;/;
  5448. +        $_ = substr($_,$shiftwidth,1000);
  5449. +    } else {
  5450. +        $_ = "$if ($addr1) $l\n$change$_$rmaybe";
  5451. +    }
  5452. +    $change = '';
  5453. +    next LINE;
  5454. +    }
  5455. +} continue {
  5456. +    @lines = split(/\n/,$_);
  5457. +    for (@lines) {
  5458. +    unless (s/^ *<<--//) {
  5459. +        print BODY &tab;
  5460. +    }
  5461. +    print BODY $_, "\n";
  5462. +    }
  5463. +    $indent += $indmod;
  5464. +    $indmod = 0;
  5465. +    if ($redo) {
  5466. +    $_ = $redo;
  5467. +    $redo = '';
  5468. +    redo LINE;
  5469. +    }
  5470. +}
  5471. +if ($lastlinewaslabel++) {
  5472. +    $indent += 4;
  5473. +    print BODY &tab, ";\n";
  5474. +    $indent -= 4;
  5475. +}
  5476. +
  5477. +if ($appendseen || $tseen || !$assumen) {
  5478. +    $printit++ if $dseen || (!$assumen && !$assumep);
  5479. +    print BODY &q(<<'EOT');
  5480. +:    #ifdef SAWNEXT
  5481. +:    }
  5482. +:    continue {
  5483. +:    #endif
  5484. +:    #ifdef PRINTIT
  5485. +:    #ifdef DSEEN
  5486. +:    #ifdef ASSUMEP
  5487. +:        print if $printit++;
  5488. +:    #else
  5489. +:        if ($printit)
  5490. +:        { print; }
  5491. +:        else
  5492. +:        { $printit++ unless $nflag; }
  5493. +:    #endif
  5494. +:    #else
  5495. +:        print if $printit;
  5496. +:    #endif
  5497. +:    #else
  5498. +:        print;
  5499. +:    #endif
  5500. +:    #ifdef TSEEN
  5501. +:        $tflag = 0;
  5502. +:    #endif
  5503. +:    #ifdef APPENDSEEN
  5504. +:        if ($atext) { chop $atext; print $atext; $atext = ''; }
  5505. +:    #endif
  5506. +EOT
  5507. +
  5508. +print BODY &q(<<'EOT');
  5509. +:    }
  5510. +EOT
  5511. +}
  5512. +
  5513. +close BODY;
  5514. +
  5515. +unless ($debug) {
  5516. +    open(HEAD,">/tmp/sperl2$$.c")
  5517. +      || &Die("Can't open temp file 2: $!\n");
  5518. +    print HEAD "#define PRINTIT\n"    if $printit;
  5519. +    print HEAD "#define APPENDSEEN\n"    if $appendseen;
  5520. +    print HEAD "#define TSEEN\n"    if $tseen;
  5521. +    print HEAD "#define DSEEN\n"    if $dseen;
  5522. +    print HEAD "#define ASSUMEN\n"    if $assumen;
  5523. +    print HEAD "#define ASSUMEP\n"    if $assumep;
  5524. +    print HEAD "#define TOPLABEL\n"    if $toplabel;
  5525. +    print HEAD "#define SAWNEXT\n"    if $sawnext;
  5526. +    if ($opens) {print HEAD "$opens\n";}
  5527. +    open(BODY,"/tmp/sperl$$")
  5528. +      || &Die("Can't reopen temp file: $!\n");
  5529. +    while (<BODY>) {
  5530. +    print HEAD $_;
  5531. +    }
  5532. +    close HEAD;
  5533. +
  5534. +    print &q(<<"EOT");
  5535. +:    #!$bin/perl
  5536. +:    eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
  5537. +:        if \$running_under_some_shell;
  5538. +:    
  5539. +EOT
  5540. +    open(BODY,"cc -E /tmp/sperl2$$.c |") ||
  5541. +    &Die("Can't reopen temp file: $!\n");
  5542. +    while (<BODY>) {
  5543. +    /^# [0-9]/ && next;
  5544. +    /^[ \t]*$/ && next;
  5545. +    s/^<><>//;
  5546. +    print;
  5547. +    }
  5548. +}
  5549. +
  5550. +&Cleanup;
  5551. +exit;
  5552. +
  5553. +sub Cleanup {
  5554. +    chdir "/tmp";
  5555. +    unlink "sperl$$", "sperl2$$", "sperl2$$.c";
  5556. +}
  5557. +sub Die {
  5558. +    &Cleanup;
  5559. +    die $_[0];
  5560. +}
  5561. +sub tab {
  5562. +    "\t" x ($indent / 8) . ' ' x ($indent % 8);
  5563. +}
  5564. +sub make_filehandle {
  5565. +    local($_) = $_[0];
  5566. +    local($fname) = $_;
  5567. +    if (!$seen{$fname}) {
  5568. +    $_ = "FH_" . $_ if /^\d/;
  5569. +    s/[^a-zA-Z0-9]/_/g;
  5570. +    s/^_*//;
  5571. +    $_ = "\U$_";
  5572. +    if ($fhseen{$_}) {
  5573. +        for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
  5574. +        $_ .= $tmp;
  5575. +    }
  5576. +    $fhseen{$_} = 1;
  5577. +    $opens .= &q(<<"EOT");
  5578. +:    open($_, '>$fname') || die "Can't create $fname: \$!";
  5579. +EOT
  5580. +    $seen{$fname} = $_;
  5581. +    }
  5582. +    $seen{$fname};
  5583. +}
  5584. +
  5585. +sub make_label {
  5586. +    local($label) = @_;
  5587. +    $label =~ s/[^a-zA-Z0-9]/_/g;
  5588. +    if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
  5589. +    $label = substr($label,0,8);
  5590. +
  5591. +    # Could be a reserved word, so capitalize it.
  5592. +    substr($label,0,1) =~ y/a-z/A-Z/
  5593. +      if $label =~ /^[a-z]/;
  5594. +
  5595. +    $label;
  5596. +}
  5597. +
  5598. +sub transmogrify {
  5599. +    {    # case
  5600. +    if (/^d/) {
  5601. +        $dseen++;
  5602. +        chop($_ = &q(<<'EOT'));
  5603. +:    <<--#ifdef PRINTIT
  5604. +:    $printit = 0;
  5605. +:    <<--#endif
  5606. +:    next LINE;
  5607. +EOT
  5608. +        $sawnext++;
  5609. +        next;
  5610. +    }
  5611. +
  5612. +    if (/^n/) {
  5613. +        chop($_ = &q(<<'EOT'));
  5614. +:    <<--#ifdef PRINTIT
  5615. +:    <<--#ifdef DSEEN
  5616. +:    <<--#ifdef ASSUMEP
  5617. +:    print if $printit++;
  5618. +:    <<--#else
  5619. +:    if ($printit)
  5620. +:        { print; }
  5621. +:    else
  5622. +:        { $printit++ unless $nflag; }
  5623. +:    <<--#endif
  5624. +:    <<--#else
  5625. +:    print if $printit;
  5626. +:    <<--#endif
  5627. +:    <<--#else
  5628. +:    print;
  5629. +:    <<--#endif
  5630. +:    <<--#ifdef APPENDSEEN
  5631. +:    if ($atext) {chop $atext; print $atext; $atext = '';}
  5632. +:    <<--#endif
  5633. +:    $_ = <>;
  5634. +:    chop;
  5635. +:    <<--#ifdef TSEEN
  5636. +:    $tflag = 0;
  5637. +:    <<--#endif
  5638. +EOT
  5639. +        next;
  5640. +    }
  5641. +
  5642. +    if (/^a/) {
  5643. +        $appendseen++;
  5644. +        $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
  5645. +        $lastline = 0;
  5646. +        while (<>) {
  5647. +        s/^[ \t]*//;
  5648. +        s/^[\\]//;
  5649. +        unless (s|\\$||) { $lastline = 1;}
  5650. +        s/^([ \t]*\n)/<><>$1/;
  5651. +        $command .= $_;
  5652. +        $command .= '<<--';
  5653. +        last if $lastline;
  5654. +        }
  5655. +        $_ = $command . "End_Of_Text";
  5656. +        last;
  5657. +    }
  5658. +
  5659. +    if (/^[ic]/) {
  5660. +        if (/^c/) { $change = 1; }
  5661. +        $addr1 = 1 if $addr1 eq '';
  5662. +        $addr1 = '$iter = (' . $addr1 . ')';
  5663. +        $command = $space .
  5664. +          "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
  5665. +        $lastline = 0;
  5666. +        while (<>) {
  5667. +        s/^[ \t]*//;
  5668. +        s/^[\\]//;
  5669. +        unless (s/\\$//) { $lastline = 1;}
  5670. +        s/'/\\'/g;
  5671. +        s/^([ \t]*\n)/<><>$1/;
  5672. +        $command .= $_;
  5673. +        $command .= '<<--';
  5674. +        last if $lastline;
  5675. +        }
  5676. +        $_ = $command . "End_Of_Text";
  5677. +        if ($change) {
  5678. +        $dseen++;
  5679. +        $change = "$_\n";
  5680. +        chop($_ = &q(<<"EOT"));
  5681. +:    <<--#ifdef PRINTIT
  5682. +:    $space\$printit = 0;
  5683. +:    <<--#endif
  5684. +:    ${space}next LINE;
  5685. +EOT
  5686. +        $sawnext++;
  5687. +        }
  5688. +        last;
  5689. +    }
  5690. +
  5691. +    if (/^s/) {
  5692. +        $delim = substr($_,1,1);
  5693. +        $len = length($_);
  5694. +        $repl = $end = 0;
  5695. +        $inbracket = 0;
  5696. +        for ($i = 2; $i < $len; $i++) {
  5697. +        $c = substr($_,$i,1);
  5698. +        if ($c eq $delim) {
  5699. +            if ($inbracket) {
  5700. +            substr($_, $i, 0) = '\\';
  5701. +            $i++;
  5702. +            $len++;
  5703. +            }
  5704. +            else {
  5705. +            if ($repl) {
  5706. +                $end = $i;
  5707. +                last;
  5708. +            } else {
  5709. +                $repl = $i;
  5710. +            }
  5711. +            }
  5712. +        }
  5713. +        elsif ($c eq '\\') {
  5714. +            $i++;
  5715. +            if ($i >= $len) {
  5716. +            $_ .= 'n';
  5717. +            $_ .= <>;
  5718. +            $len = length($_);
  5719. +            $_ = substr($_,0,--$len);
  5720. +            }
  5721. +            elsif (substr($_,$i,1) =~ /^[n]$/) {
  5722. +            ;
  5723. +            }
  5724. +            elsif (!$repl &&
  5725. +              substr($_,$i,1) =~ /^[(){}\w]$/) {
  5726. +            $i--;
  5727. +            $len--;
  5728. +            substr($_, $i, 1) = '';
  5729. +            }
  5730. +            elsif (!$repl &&
  5731. +              substr($_,$i,1) =~ /^[<>]$/) {
  5732. +            substr($_,$i,1) = 'b';
  5733. +            }
  5734. +            elsif ($repl && substr($_,$i,1) =~ /^\d$/) {
  5735. +            substr($_,$i-1,1) = '$';
  5736. +            }
  5737. +        }
  5738. +        elsif ($c eq '&' && $repl) {
  5739. +            substr($_, $i, 0) = '$';
  5740. +            $i++;
  5741. +            $len++;
  5742. +        }
  5743. +        elsif ($c eq '$' && $repl) {
  5744. +            substr($_, $i, 0) = '\\';
  5745. +            $i++;
  5746. +            $len++;
  5747. +        }
  5748. +        elsif ($c eq '[' && !$repl) {
  5749. +            $i++ if substr($_,$i,1) eq '^';
  5750. +            $i++ if substr($_,$i,1) eq ']';
  5751. +            $inbracket = 1;
  5752. +        }
  5753. +        elsif ($c eq ']') {
  5754. +            $inbracket = 0;
  5755. +        }
  5756. +        elsif ($c eq "\t") {
  5757. +            substr($_, $i, 1) = '\\t';
  5758. +            $i++;
  5759. +            $len++;
  5760. +        }
  5761. +        elsif (!$repl && index("()+",$c) >= 0) {
  5762. +            substr($_, $i, 0) = '\\';
  5763. +            $i++;
  5764. +            $len++;
  5765. +        }
  5766. +        }
  5767. +        &Die("Malformed substitution at line $.\n")
  5768. +          unless $end;
  5769. +        $pat = substr($_, 0, $repl + 1);
  5770. +        $repl = substr($_, $repl+1, $end-$repl-1);
  5771. +        $end = substr($_, $end + 1, 1000);
  5772. +        &simplify($pat);
  5773. +        $dol = '$';
  5774. +        $subst = "$pat$repl$delim";
  5775. +        $cmd = '';
  5776. +        while ($end) {
  5777. +        if ($end =~ s/^g//) {
  5778. +            $subst .= 'g';
  5779. +            next;
  5780. +        }
  5781. +        if ($end =~ s/^p//) {
  5782. +            $cmd .= ' && (print)';
  5783. +            next;
  5784. +        }
  5785. +        if ($end =~ s/^w[ \t]*//) {
  5786. +            $fh = &make_filehandle($end);
  5787. +            $cmd .= " && (print $fh \$_)";
  5788. +            $end = '';
  5789. +            next;
  5790. +        }
  5791. +        &Die("Unrecognized substitution command".
  5792. +          "($end) at line $.\n");
  5793. +        }
  5794. +        chop ($_ = &q(<<"EOT"));
  5795. +:    <<--#ifdef TSEEN
  5796. +:    $subst && \$tflag++$cmd;
  5797. +:    <<--#else
  5798. +:    $subst$cmd;
  5799. +:    <<--#endif
  5800. +EOT
  5801. +        next;
  5802. +    }
  5803. +
  5804. +    if (/^p/) {
  5805. +        $_ = 'print;';
  5806. +        next;
  5807. +    }
  5808. +
  5809. +    if (/^w/) {
  5810. +        s/^w[ \t]*//;
  5811. +        $fh = &make_filehandle($_);
  5812. +        $_ = "print $fh \$_;";
  5813. +        next;
  5814. +    }
  5815. +
  5816. +    if (/^r/) {
  5817. +        $appendseen++;
  5818. +        s/^r[ \t]*//;
  5819. +        $file = $_;
  5820. +        $_ = "\$atext .= `cat $file 2>/dev/null`;";
  5821. +        next;
  5822. +    }
  5823. +
  5824. +    if (/^P/) {
  5825. +        $_ = 'print $1 if /^(.*)/;';
  5826. +        next;
  5827. +    }
  5828. +
  5829. +    if (/^D/) {
  5830. +        chop($_ = &q(<<'EOT'));
  5831. +:    s/^.*\n?//;
  5832. +:    redo LINE if $_;
  5833. +:    next LINE;
  5834. +EOT
  5835. +        $sawnext++;
  5836. +        next;
  5837. +    }
  5838. +
  5839. +    if (/^N/) {
  5840. +        chop($_ = &q(<<'EOT'));
  5841. +:    $_ .= "\n";
  5842. +:    $len1 = length;
  5843. +:    $_ .= <>;
  5844. +:    chop if $len1 < length;
  5845. +:    <<--#ifdef TSEEN
  5846. +:    $tflag = 0;
  5847. +:    <<--#endif
  5848. +EOT
  5849. +        next;
  5850. +    }
  5851. +
  5852. +    if (/^h/) {
  5853. +        $_ = '$hold = $_;';
  5854. +        next;
  5855. +    }
  5856. +
  5857. +    if (/^H/) {
  5858. +        $_ = '$hold .= "\n"; $hold .= $_;';
  5859. +        next;
  5860. +    }
  5861. +
  5862. +    if (/^g/) {
  5863. +        $_ = '$_ = $hold;';
  5864. +        next;
  5865. +    }
  5866. +
  5867. +    if (/^G/) {
  5868. +        $_ = '$_ .= "\n"; $_ .= $hold;';
  5869. +        next;
  5870. +    }
  5871. +
  5872. +    if (/^x/) {
  5873. +        $_ = '($_, $hold) = ($hold, $_);';
  5874. +        next;
  5875. +    }
  5876. +
  5877. +    if (/^b$/) {
  5878. +        $_ = 'next LINE;';
  5879. +        $sawnext++;
  5880. +        next;
  5881. +    }
  5882. +
  5883. +    if (/^b/) {
  5884. +        s/^b[ \t]*//;
  5885. +        $lab = &make_label($_);
  5886. +        if ($lab eq $toplabel) {
  5887. +        $_ = 'redo LINE;';
  5888. +        } else {
  5889. +        $_ = "goto $lab;";
  5890. +        }
  5891. +        next;
  5892. +    }
  5893. +
  5894. +    if (/^t$/) {
  5895. +        $_ = 'next LINE if $tflag;';
  5896. +        $sawnext++;
  5897. +        $tseen++;
  5898. +        next;
  5899. +    }
  5900. +
  5901. +    if (/^t/) {
  5902. +        s/^t[ \t]*//;
  5903. +        $lab = &make_label($_);
  5904. +        $_ = q/if ($tflag) {$tflag = 0; /;
  5905. +        if ($lab eq $toplabel) {
  5906. +        $_ .= 'redo LINE;}';
  5907. +        } else {
  5908. +        $_ .= "goto $lab;}";
  5909. +        }
  5910. +        $tseen++;
  5911. +        next;
  5912. +    }
  5913. +
  5914. +    if (/^y/) {
  5915. +        s/abcdefghijklmnopqrstuvwxyz/a-z/g;
  5916. +        s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
  5917. +        s/abcdef/a-f/g;
  5918. +        s/ABCDEF/A-F/g;
  5919. +        s/0123456789/0-9/g;
  5920. +        s/01234567/0-7/g;
  5921. +        $_ .= ';';
  5922. +    }
  5923. +
  5924. +    if (/^=/) {
  5925. +        $_ = 'print $.;';
  5926. +        next;
  5927. +    }
  5928. +
  5929. +    if (/^q/) {
  5930. +        chop($_ = &q(<<'EOT'));
  5931. +:    close(ARGV);
  5932. +:    @ARGV = ();
  5933. +:    next LINE;
  5934. +EOT
  5935. +        $sawnext++;
  5936. +        next;
  5937. +    }
  5938. +    } continue {
  5939. +    if ($space) {
  5940. +        s/^/$space/;
  5941. +        s/(\n)(.)/$1$space$2/g;
  5942. +    }
  5943. +    last;
  5944. +    }
  5945. +    $_;
  5946. +}
  5947. +
  5948. +sub fetchpat {
  5949. +    local($outer) = @_;
  5950. +    local($addr) = $outer;
  5951. +    local($inbracket);
  5952. +    local($prefix,$delim,$ch);
  5953. +
  5954. +    # Process pattern one potential delimiter at a time.
  5955. +
  5956. +    DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
  5957. +    $prefix = $1;
  5958. +    $delim = $2;
  5959. +    if ($delim eq '\\') {
  5960. +        s/(.)//;
  5961. +        $ch = $1;
  5962. +        $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
  5963. +        $ch = 'b' if $ch =~ /^[<>]$/;
  5964. +        $delim .= $ch;
  5965. +    }
  5966. +    elsif ($delim eq '[') {
  5967. +        $inbracket = 1;
  5968. +        s/^\^// && ($delim .= '^');
  5969. +        s/^]// && ($delim .= ']');
  5970. +    }
  5971. +    elsif ($delim eq ']') {
  5972. +        $inbracket = 0;
  5973. +    }
  5974. +    elsif ($inbracket || $delim ne $outer) {
  5975. +        $delim = '\\' . $delim;
  5976. +    }
  5977. +    $addr .= $prefix;
  5978. +    $addr .= $delim;
  5979. +    if ($delim eq $outer && !$inbracket) {
  5980. +        last DELIM;
  5981. +    }
  5982. +    }
  5983. +    $addr =~ s/\t/\\t/g;
  5984. +    &simplify($addr);
  5985. +    $addr;
  5986. +}
  5987. +
  5988. +sub q {
  5989. +    local($string) = @_;
  5990. +    local($*) = 1;
  5991. +    $string =~ s/^:\t?//g;
  5992. +    $string;
  5993. +}
  5994. +
  5995. +sub simplify {
  5996. +    $_[0] =~ s/_a-za-z0-9/\\w/ig;
  5997. +    $_[0] =~ s/a-z_a-z0-9/\\w/ig;
  5998. +    $_[0] =~ s/a-za-z_0-9/\\w/ig;
  5999. +    $_[0] =~ s/a-za-z0-9_/\\w/ig;
  6000. +    $_[0] =~ s/_0-9a-za-z/\\w/ig;
  6001. +    $_[0] =~ s/0-9_a-za-z/\\w/ig;
  6002. +    $_[0] =~ s/0-9a-z_a-z/\\w/ig;
  6003. +    $_[0] =~ s/0-9a-za-z_/\\w/ig;
  6004. +    $_[0] =~ s/\[\\w\]/\\w/g;
  6005. +    $_[0] =~ s/\[^\\w\]/\\W/g;
  6006. +    $_[0] =~ s/\[0-9\]/\\d/g;
  6007. +    $_[0] =~ s/\[^0-9\]/\\D/g;
  6008. +    $_[0] =~ s/\\d\\d\*/\\d+/g;
  6009. +    $_[0] =~ s/\\D\\D\*/\\D+/g;
  6010. +    $_[0] =~ s/\\w\\w\*/\\w+/g;
  6011. +    $_[0] =~ s/\\t\\t\*/\\t+/g;
  6012. +    $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
  6013. +    $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
  6014. +}
  6015. +
  6016.