home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume13 / perl / part01 next >
Encoding:
Internet Message Format  |  1988-01-30  |  50.3 KB
  1. Subject:  v13i001:  Perl, a "replacement" for awk and sed, Part01/10
  2. Newsgroups: comp.sources.unix
  3. Sender: sources
  4. Approved: rsalz@uunet.UU.NET
  5.  
  6. Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
  7. Posting-number: Volume 13, Issue 1
  8. Archive-name: perl/part01
  9.  
  10. [  Perl is kind of designed to make awk and sed semi-obsolete.  This posting
  11.    will include the first 10 patches after the main source.  The following
  12.    description is lifted from Larry's manpage. --r$  ]
  13.  
  14.    Perl is a interpreted language optimized for scanning arbitrary text
  15.    files, extracting information from those text files, and printing
  16.    reports based on that information.  It's also a good language for many
  17.    system management tasks.  The language is intended to be practical
  18.    (easy to use, efficient, complete) rather than beautiful (tiny,
  19.    elegant, minimal).  It combines (in the author's opinion, anyway) some
  20.    of the best features of C, sed, awk, and sh, so people familiar with
  21.    those languages should have little difficulty with it.  (Language
  22.    historians will also note some vestiges of csh, Pascal, and even
  23.    BASIC-PLUS.) Expression syntax corresponds quite closely to C
  24.    expression syntax.  If you have a problem that would ordinarily use sed
  25.    or awk or sh, but it exceeds their capabilities or must run a little
  26.    faster, and you don't want to write the silly thing in C, then perl may
  27.    be for you.  There are also translators to turn your sed and awk
  28.    scripts into perl scripts.
  29.  
  30. #! /bin/sh
  31.  
  32. # Make a new directory for the perl sources, cd to it, and run kits 1
  33. # thru 10 through sh.  When all 10 kits have been run, read README.
  34.  
  35. echo "This is perl 1.0 kit 1 (of 10).  If kit 1 is complete, the line"
  36. echo '"'"End of kit 1 (of 10)"'" will echo at the end.'
  37. echo ""
  38. export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
  39. mkdir x2p 2>/dev/null
  40. echo Extracting README
  41. sed >README <<'!STUFFY!FUNK!' -e 's/X//'
  42. X
  43. X            Perl Kit, Version 1.0
  44. X
  45. X            Copyright (c) 1987, Larry Wall
  46. X
  47. XYou may copy the perl kit in whole or in part as long as you don't try to
  48. Xmake money off it, or pretend that you wrote it.
  49. X--------------------------------------------------------------------------
  50. X
  51. XPerl is a language that combines some of the features of C, sed, awk and shell.
  52. XSee the manual page for more hype.
  53. X
  54. XPerl will probably not run on machines with a small address space.
  55. X
  56. XPlease read all the directions below before you proceed any further, and
  57. Xthen follow them carefully.  Failure to do so may void your warranty. :-)
  58. X
  59. XAfter you have unpacked your kit, you should have all the files listed
  60. Xin MANIFEST.
  61. X
  62. XInstallation
  63. X
  64. X1)  Run Configure.  This will figure out various things about your system.
  65. X    Some things Configure will figure out for itself, other things it will
  66. X    ask you about.  It will then proceed to make config.h, config.sh, and
  67. X    Makefile.
  68. X
  69. X    You might possibly have to trim # comments from the front of Configure
  70. X    if your sh doesn't handle them, but all other # comments will be taken
  71. X    care of.
  72. X
  73. X    (If you don't have sh, you'll have to copy the sample file config.H to
  74. X    config.h and edit the config.h to reflect your system's peculiarities.)
  75. X
  76. X2)  Glance through config.h to make sure system dependencies are correct.
  77. X    Most of them should have been taken care of by running the Configure script.
  78. X
  79. X    If you have any additional changes to make to the C definitions, they
  80. X    can be done in the Makefile, or in config.h.  Bear in mind that they will
  81. X    get undone next time you run Configure.
  82. X
  83. X3)  make depend
  84. X
  85. X    This will look for all the includes and modify Makefile accordingly.
  86. X    Configure will offer to do this for you.
  87. X
  88. X4)  make
  89. X
  90. X    This will attempt to make perl in the current directory.
  91. X
  92. X5)  make test
  93. X
  94. X    This will run the regression tests on the perl you just made.
  95. X    If it doesn't say "All tests successful" then something went wrong.
  96. X    See the README in the t subdirectory.
  97. X
  98. X6)  make install
  99. X
  100. X    This will put perl into a public directory (normally /usr/local/bin).
  101. X    It will also try to put the man pages in a reasonable place.  It will not
  102. X    nroff the man page, however.  You may need to be root to do this.  If
  103. X    you are not root, you must own the directories in question and you should
  104. X    ignore any messages about chown not working.
  105. X
  106. X7)  Read the manual entry before running perl.
  107. X
  108. X8)  Go down to the x2p directory and do a "make depend, a "make" and a
  109. X    "make install" to create the awk to perl and sed to perl translators.
  110. X
  111. X9)  IMPORTANT!  Help save the world!  Communicate any problems and suggested
  112. X    patches to me, lwall@jpl-devvax.jpl.nasa.gov (Larry Wall), so we can
  113. X    keep the world in sync.  If you have a problem, there's someone else
  114. X    out there who either has had or will have the same problem.
  115. X
  116. X    If possible, send in patches such that the patch program will apply them.
  117. X    Context diffs are the best, then normal diffs.  Don't send ed scripts--
  118. X    I've probably changed my copy since the version you have.
  119. X
  120. X    Watch for perl patches in comp.sources.bugs.  Patches will generally be
  121. X    in a form usable by the patch program.  If you are just now bringing up
  122. X    perl and aren't sure how many patches there are, write to me and I'll
  123. X    send any you don't have.  Your current patch level is shown in patchlevel.h.
  124. X
  125. !STUFFY!FUNK!
  126. echo Extracting x2p/walk.c
  127. sed >x2p/walk.c <<'!STUFFY!FUNK!' -e 's/X//'
  128. X/* $Header: walk.c,v 1.0 87/12/18 13:07:40 root Exp $
  129. X *
  130. X * $Log:    walk.c,v $
  131. X * Revision 1.0  87/12/18  13:07:40  root
  132. X * Initial revision
  133. X * 
  134. X */
  135. X
  136. X#include "handy.h"
  137. X#include "EXTERN.h"
  138. X#include "util.h"
  139. X#include "a2p.h"
  140. X
  141. Xbool exitval = FALSE;
  142. Xbool realexit = FALSE;
  143. Xint maxtmp = 0;
  144. X
  145. XSTR *
  146. Xwalk(useval,level,node,numericptr)
  147. Xint useval;
  148. Xint level;
  149. Xregister int node;
  150. Xint *numericptr;
  151. X{
  152. X    register int len;
  153. X    register STR *str;
  154. X    register int type;
  155. X    register int i;
  156. X    register STR *tmpstr;
  157. X    STR *tmp2str;
  158. X    char *t;
  159. X    char *d, *s;
  160. X    int numarg;
  161. X    int numeric = FALSE;
  162. X    STR *fstr;
  163. X    char *index();
  164. X
  165. X    if (!node) {
  166. X    *numericptr = 0;
  167. X    return str_make("");
  168. X    }
  169. X    type = ops[node].ival;
  170. X    len = type >> 8;
  171. X    type &= 255;
  172. X    switch (type) {
  173. X    case OPROG:
  174. X    str = walk(0,level,ops[node+1].ival,&numarg);
  175. X    opens = str_new(0);
  176. X    if (do_split && need_entire && !absmaxfld)
  177. X        split_to_array = TRUE;
  178. X    if (do_split && split_to_array)
  179. X        set_array_base = TRUE;
  180. X    if (set_array_base) {
  181. X        str_cat(str,"$[ = 1;\t\t\t# set array base to 1\n");
  182. X    }
  183. X    if (fswitch && !const_FS)
  184. X        const_FS = fswitch;
  185. X    if (saw_FS > 1 || saw_RS)
  186. X        const_FS = 0;
  187. X    if (saw_ORS && need_entire)
  188. X        do_chop = TRUE;
  189. X    if (fswitch) {
  190. X        str_cat(str,"$FS = '");
  191. X        if (index("*+?.[]()|^$\\",fswitch))
  192. X        str_cat(str,"\\");
  193. X        sprintf(tokenbuf,"%c",fswitch);
  194. X        str_cat(str,tokenbuf);
  195. X        str_cat(str,"';\t\t# field separator from -F switch\n");
  196. X    }
  197. X    else if (saw_FS && !const_FS) {
  198. X        str_cat(str,"$FS = '[ \\t\\n]+';\t\t# default field separator\n");
  199. X    }
  200. X    if (saw_OFS) {
  201. X        str_cat(str,"$, = ' ';\t\t# default output field separator\n");
  202. X    }
  203. X    if (saw_ORS) {
  204. X        str_cat(str,"$\\ = \"\\n\";\t\t# default output record separator\n");
  205. X    }
  206. X    if (str->str_cur > 20)
  207. X        str_cat(str,"\n");
  208. X    if (ops[node+2].ival) {
  209. X        str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
  210. X        str_free(fstr);
  211. X        str_cat(str,"\n\n");
  212. X    }
  213. X    if (saw_line_op)
  214. X        str_cat(str,"line: ");
  215. X    str_cat(str,"while (<>) {\n");
  216. X    tab(str,++level);
  217. X    if (saw_FS && !const_FS)
  218. X        do_chop = TRUE;
  219. X    if (do_chop) {
  220. X        str_cat(str,"chop;\t# strip record separator\n");
  221. X        tab(str,level);
  222. X    }
  223. X    arymax = 0;
  224. X    if (namelist) {
  225. X        while (isalpha(*namelist)) {
  226. X        for (d = tokenbuf,s=namelist;
  227. X          isalpha(*s) || isdigit(*s) || *s == '_';
  228. X          *d++ = *s++) ;
  229. X        *d = '\0';
  230. X        while (*s && !isalpha(*s)) s++;
  231. X        namelist = s;
  232. X        nameary[++arymax] = savestr(tokenbuf);
  233. X        }
  234. X    }
  235. X    if (maxfld < arymax)
  236. X        maxfld = arymax;
  237. X    if (do_split)
  238. X        emit_split(str,level);
  239. X    str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
  240. X    str_free(fstr);
  241. X    fixtab(str,--level);
  242. X    str_cat(str,"}\n");
  243. X    if (ops[node+4].ival) {
  244. X        realexit = TRUE;
  245. X        str_cat(str,"\n");
  246. X        tab(str,level);
  247. X        str_scat(str,fstr=walk(0,level,ops[node+4].ival,&numarg));
  248. X        str_free(fstr);
  249. X        str_cat(str,"\n");
  250. X    }
  251. X    if (exitval)
  252. X        str_cat(str,"exit ExitValue;\n");
  253. X    if (do_fancy_opens) {
  254. X        str_cat(str,"\n\
  255. Xsub Pick {\n\
  256. X    ($name) = @_;\n\
  257. X    $fh = $opened{$name};\n\
  258. X    if (!$fh) {\n\
  259. X    $nextfh == 0 && open(fh_0,$name);\n\
  260. X    $nextfh == 1 && open(fh_1,$name);\n\
  261. X    $nextfh == 2 && open(fh_2,$name);\n\
  262. X    $nextfh == 3 && open(fh_3,$name);\n\
  263. X    $nextfh == 4 && open(fh_4,$name);\n\
  264. X    $nextfh == 5 && open(fh_5,$name);\n\
  265. X    $nextfh == 6 && open(fh_6,$name);\n\
  266. X    $nextfh == 7 && open(fh_7,$name);\n\
  267. X    $nextfh == 8 && open(fh_8,$name);\n\
  268. X    $nextfh == 9 && open(fh_9,$name);\n\
  269. X    $fh = $opened{$name} = 'fh_' . $nextfh++;\n\
  270. X    }\n\
  271. X    select($fh);\n\
  272. X}\n\
  273. X");
  274. X    }
  275. X    break;
  276. X    case OHUNKS:
  277. X    str = walk(0,level,ops[node+1].ival,&numarg);
  278. X    str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
  279. X    str_free(fstr);
  280. X    if (len == 3) {
  281. X        str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
  282. X        str_free(fstr);
  283. X    }
  284. X    else {
  285. X    }
  286. X    break;
  287. X    case ORANGE:
  288. X    str = walk(1,level,ops[node+1].ival,&numarg);
  289. X    str_cat(str," .. ");
  290. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  291. X    str_free(fstr);
  292. X    break;
  293. X    case OPAT:
  294. X    goto def;
  295. X    case OREGEX:
  296. X    str = str_new(0);
  297. X    str_set(str,"/");
  298. X    tmpstr=walk(0,level,ops[node+1].ival,&numarg);
  299. X    /* translate \nnn to [\nnn] */
  300. X    for (s = tmpstr->str_ptr, d = tokenbuf; *s; s++, d++) {
  301. X        if (*s == '\\' && isdigit(s[1]) && isdigit(s[2]) && isdigit(s[3])) {
  302. X        *d++ = '[';
  303. X        *d++ = *s++;
  304. X        *d++ = *s++;
  305. X        *d++ = *s++;
  306. X        *d++ = *s;
  307. X        *d = ']';
  308. X        }
  309. X        else
  310. X        *d = *s;
  311. X    }
  312. X    *d = '\0';
  313. X    str_cat(str,tokenbuf);
  314. X    str_free(tmpstr);
  315. X    str_cat(str,"/");
  316. X    break;
  317. X    case OHUNK:
  318. X    if (len == 1) {
  319. X        str = str_new(0);
  320. X        str = walk(0,level,oper1(OPRINT,0),&numarg);
  321. X        str_cat(str," if ");
  322. X        str_scat(str,fstr=walk(0,level,ops[node+1].ival,&numarg));
  323. X        str_free(fstr);
  324. X        str_cat(str,";");
  325. X    }
  326. X    else {
  327. X        tmpstr = walk(0,level,ops[node+1].ival,&numarg);
  328. X        if (*tmpstr->str_ptr) {
  329. X        str = str_new(0);
  330. X        str_set(str,"if (");
  331. X        str_scat(str,tmpstr);
  332. X        str_cat(str,") {\n");
  333. X        tab(str,++level);
  334. X        str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
  335. X        str_free(fstr);
  336. X        fixtab(str,--level);
  337. X        str_cat(str,"}\n");
  338. X        tab(str,level);
  339. X        }
  340. X        else {
  341. X        str = walk(0,level,ops[node+2].ival,&numarg);
  342. X        }
  343. X    }
  344. X    break;
  345. X    case OPPAREN:
  346. X    str = str_new(0);
  347. X    str_set(str,"(");
  348. X    str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg));
  349. X    str_free(fstr);
  350. X    str_cat(str,")");
  351. X    break;
  352. X    case OPANDAND:
  353. X    str = walk(1,level,ops[node+1].ival,&numarg);
  354. X    str_cat(str," && ");
  355. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  356. X    str_free(fstr);
  357. X    break;
  358. X    case OPOROR:
  359. X    str = walk(1,level,ops[node+1].ival,&numarg);
  360. X    str_cat(str," || ");
  361. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  362. X    str_free(fstr);
  363. X    break;
  364. X    case OPNOT:
  365. X    str = str_new(0);
  366. X    str_set(str,"!");
  367. X    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  368. X    str_free(fstr);
  369. X    break;
  370. X    case OCPAREN:
  371. X    str = str_new(0);
  372. X    str_set(str,"(");
  373. X    str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg));
  374. X    str_free(fstr);
  375. X    numeric |= numarg;
  376. X    str_cat(str,")");
  377. X    break;
  378. X    case OCANDAND:
  379. X    str = walk(1,level,ops[node+1].ival,&numarg);
  380. X    numeric = 1;
  381. X    str_cat(str," && ");
  382. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  383. X    str_free(fstr);
  384. X    break;
  385. X    case OCOROR:
  386. X    str = walk(1,level,ops[node+1].ival,&numarg);
  387. X    numeric = 1;
  388. X    str_cat(str," || ");
  389. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  390. X    str_free(fstr);
  391. X    break;
  392. X    case OCNOT:
  393. X    str = str_new(0);
  394. X    str_set(str,"!");
  395. X    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  396. X    str_free(fstr);
  397. X    numeric = 1;
  398. X    break;
  399. X    case ORELOP:
  400. X    str = walk(1,level,ops[node+2].ival,&numarg);
  401. X    numeric |= numarg;
  402. X    tmpstr = walk(0,level,ops[node+1].ival,&numarg);
  403. X    tmp2str = walk(1,level,ops[node+3].ival,&numarg);
  404. X    numeric |= numarg;
  405. X    if (!numeric) {
  406. X        t = tmpstr->str_ptr;
  407. X        if (strEQ(t,"=="))
  408. X        str_set(tmpstr,"eq");
  409. X        else if (strEQ(t,"!="))
  410. X        str_set(tmpstr,"ne");
  411. X        else if (strEQ(t,"<"))
  412. X        str_set(tmpstr,"lt");
  413. X        else if (strEQ(t,"<="))
  414. X        str_set(tmpstr,"le");
  415. X        else if (strEQ(t,">"))
  416. X        str_set(tmpstr,"gt");
  417. X        else if (strEQ(t,">="))
  418. X        str_set(tmpstr,"ge");
  419. X        if (!index(tmpstr->str_ptr,'\'') && !index(tmpstr->str_ptr,'"') &&
  420. X          !index(tmp2str->str_ptr,'\'') && !index(tmp2str->str_ptr,'"') )
  421. X        numeric |= 2;
  422. X    }
  423. X    if (numeric & 2) {
  424. X        if (numeric & 1)        /* numeric is very good guess */
  425. X        str_cat(str," ");
  426. X        else
  427. X        str_cat(str,"\377");
  428. X        numeric = 1;
  429. X    }
  430. X    else
  431. X        str_cat(str," ");
  432. X    str_scat(str,tmpstr);
  433. X    str_free(tmpstr);
  434. X    str_cat(str," ");
  435. X    str_scat(str,tmp2str);
  436. X    str_free(tmp2str);
  437. X    numeric = 1;
  438. X    break;
  439. X    case ORPAREN:
  440. X    str = str_new(0);
  441. X    str_set(str,"(");
  442. X    str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg));
  443. X    str_free(fstr);
  444. X    numeric |= numarg;
  445. X    str_cat(str,")");
  446. X    break;
  447. X    case OMATCHOP:
  448. X    str = walk(1,level,ops[node+2].ival,&numarg);
  449. X    str_cat(str," ");
  450. X    tmpstr = walk(0,level,ops[node+1].ival,&numarg);
  451. X    if (strEQ(tmpstr->str_ptr,"~"))
  452. X        str_cat(str,"=~");
  453. X    else {
  454. X        str_scat(str,tmpstr);
  455. X        str_free(tmpstr);
  456. X    }
  457. X    str_cat(str," ");
  458. X    str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg));
  459. X    str_free(fstr);
  460. X    numeric = 1;
  461. X    break;
  462. X    case OMPAREN:
  463. X    str = str_new(0);
  464. X    str_set(str,"(");
  465. X    str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg));
  466. X    str_free(fstr);
  467. X    numeric |= numarg;
  468. X    str_cat(str,")");
  469. X    break;
  470. X    case OCONCAT:
  471. X    str = walk(1,level,ops[node+1].ival,&numarg);
  472. X    str_cat(str," . ");
  473. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  474. X    str_free(fstr);
  475. X    break;
  476. X    case OASSIGN:
  477. X    str = walk(0,level,ops[node+2].ival,&numarg);
  478. X    str_cat(str," ");
  479. X    tmpstr = walk(0,level,ops[node+1].ival,&numarg);
  480. X    str_scat(str,tmpstr);
  481. X    if (str_len(tmpstr) > 1)
  482. X        numeric = 1;
  483. X    str_free(tmpstr);
  484. X    str_cat(str," ");
  485. X    str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg));
  486. X    str_free(fstr);
  487. X    numeric |= numarg;
  488. X    if (strEQ(str->str_ptr,"$FS = '\240'"))
  489. X        str_set(str,"$FS = '[\240\\n\\t]+'");
  490. X    break;
  491. X    case OADD:
  492. X    str = walk(1,level,ops[node+1].ival,&numarg);
  493. X    str_cat(str," + ");
  494. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  495. X    str_free(fstr);
  496. X    numeric = 1;
  497. X    break;
  498. X    case OSUB:
  499. X    str = walk(1,level,ops[node+1].ival,&numarg);
  500. X    str_cat(str," - ");
  501. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  502. X    str_free(fstr);
  503. X    numeric = 1;
  504. X    break;
  505. X    case OMULT:
  506. X    str = walk(1,level,ops[node+1].ival,&numarg);
  507. X    str_cat(str," * ");
  508. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  509. X    str_free(fstr);
  510. X    numeric = 1;
  511. X    break;
  512. X    case ODIV:
  513. X    str = walk(1,level,ops[node+1].ival,&numarg);
  514. X    str_cat(str," / ");
  515. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  516. X    str_free(fstr);
  517. X    numeric = 1;
  518. X    break;
  519. X    case OMOD:
  520. X    str = walk(1,level,ops[node+1].ival,&numarg);
  521. X    str_cat(str," % ");
  522. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  523. X    str_free(fstr);
  524. X    numeric = 1;
  525. X    break;
  526. X    case OPOSTINCR:
  527. X    str = walk(1,level,ops[node+1].ival,&numarg);
  528. X    str_cat(str,"++");
  529. X    numeric = 1;
  530. X    break;
  531. X    case OPOSTDECR:
  532. X    str = walk(1,level,ops[node+1].ival,&numarg);
  533. X    str_cat(str,"--");
  534. X    numeric = 1;
  535. X    break;
  536. X    case OPREINCR:
  537. X    str = str_new(0);
  538. X    str_set(str,"++");
  539. X    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  540. X    str_free(fstr);
  541. X    numeric = 1;
  542. X    break;
  543. X    case OPREDECR:
  544. X    str = str_new(0);
  545. X    str_set(str,"--");
  546. X    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  547. X    str_free(fstr);
  548. X    numeric = 1;
  549. X    break;
  550. X    case OUMINUS:
  551. X    str = str_new(0);
  552. X    str_set(str,"-");
  553. X    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  554. X    str_free(fstr);
  555. X    numeric = 1;
  556. X    break;
  557. X    case OUPLUS:
  558. X    numeric = 1;
  559. X    goto def;
  560. X    case OPAREN:
  561. X    str = str_new(0);
  562. X    str_set(str,"(");
  563. X    str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg));
  564. X    str_free(fstr);
  565. X    str_cat(str,")");
  566. X    numeric |= numarg;
  567. X    break;
  568. X    case OGETLINE:
  569. X    str = str_new(0);
  570. X    str_set(str,"$_ = <>;\n");
  571. X    tab(str,level);
  572. X    if (do_chop) {
  573. X        str_cat(str,"chop;\t# strip record separator\n");
  574. X        tab(str,level);
  575. X    }
  576. X    if (do_split)
  577. X        emit_split(str,level);
  578. X    break;
  579. X    case OSPRINTF:
  580. X    str = str_new(0);
  581. X    str_set(str,"sprintf(");
  582. X    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  583. X    str_free(fstr);
  584. X    str_cat(str,")");
  585. X    break;
  586. X    case OSUBSTR:
  587. X    str = str_new(0);
  588. X    str_set(str,"substr(");
  589. X    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  590. X    str_free(fstr);
  591. X    str_cat(str,", ");
  592. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  593. X    str_free(fstr);
  594. X    str_cat(str,", ");
  595. X    if (len == 3) {
  596. X        str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg));
  597. X        str_free(fstr);
  598. X    }
  599. X    else
  600. X        str_cat(str,"999999");
  601. X    str_cat(str,")");
  602. X    break;
  603. X    case OSTRING:
  604. X    str = str_new(0);
  605. X    str_set(str,ops[node+1].cval);
  606. X    break;
  607. X    case OSPLIT:
  608. X    str = str_new(0);
  609. X    numeric = 1;
  610. X    tmpstr = walk(1,level,ops[node+2].ival,&numarg);
  611. X    if (useval)
  612. X        str_set(str,"(@");
  613. X    else
  614. X        str_set(str,"@");
  615. X    str_scat(str,tmpstr);
  616. X    str_cat(str," = split(");
  617. X    if (len == 3) {
  618. X        fstr = walk(1,level,ops[node+3].ival,&numarg);
  619. X        if (str_len(fstr) == 3 && *fstr->str_ptr == '\'') {
  620. X        i = fstr->str_ptr[1] & 127;
  621. X        if (index("*+?.[]()|^$\\",i))
  622. X            sprintf(tokenbuf,"/\\%c/",i);
  623. X        else
  624. X            sprintf(tokenbuf,"/%c/",i);
  625. X        str_cat(str,tokenbuf);
  626. X        }
  627. X        else
  628. X        str_scat(str,fstr);
  629. X        str_free(fstr);
  630. X    }
  631. X    else if (const_FS) {
  632. X        sprintf(tokenbuf,"/[%c\\n]/",const_FS);
  633. X        str_cat(str,tokenbuf);
  634. X    }
  635. X    else if (saw_FS)
  636. X        str_cat(str,"$FS");
  637. X    else
  638. X        str_cat(str,"/[ \\t\\n]+/");
  639. X    str_cat(str,", ");
  640. X    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  641. X    str_free(fstr);
  642. X    str_cat(str,")");
  643. X    if (useval) {
  644. X        str_cat(str,")");
  645. X    }
  646. X    str_free(tmpstr);
  647. X    break;
  648. X    case OINDEX:
  649. X    str = str_new(0);
  650. X    str_set(str,"index(");
  651. X    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  652. X    str_free(fstr);
  653. X    str_cat(str,", ");
  654. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  655. X    str_free(fstr);
  656. X    str_cat(str,")");
  657. X    numeric = 1;
  658. X    break;
  659. X    case ONUM:
  660. X    str = walk(1,level,ops[node+1].ival,&numarg);
  661. X    numeric = 1;
  662. X    break;
  663. X    case OSTR:
  664. X    tmpstr = walk(1,level,ops[node+1].ival,&numarg);
  665. X    s = "'";
  666. X    for (t = tmpstr->str_ptr; *t; t++) {
  667. X        if (*t == '\\' || *t == '\'')
  668. X        s = "\"";
  669. X        *t += 128;
  670. X    }
  671. X    str = str_new(0);
  672. X    str_set(str,s);
  673. X    str_scat(str,tmpstr);
  674. X    str_free(tmpstr);
  675. X    str_cat(str,s);
  676. X    break;
  677. X    case OVAR:
  678. X    str = str_new(0);
  679. X    str_set(str,"$");
  680. X    str_scat(str,tmpstr=walk(1,level,ops[node+1].ival,&numarg));
  681. X    if (len == 1) {
  682. X        tmp2str = hfetch(symtab,tmpstr->str_ptr);
  683. X        if (tmp2str && atoi(tmp2str->str_ptr))
  684. X        numeric = 2;
  685. X        if (strEQ(str->str_ptr,"$NR")) {
  686. X        numeric = 1;
  687. X        str_set(str,"$.");
  688. X        }
  689. X        else if (strEQ(str->str_ptr,"$NF")) {
  690. X        numeric = 1;
  691. X        str_set(str,"$#Fld");
  692. X        }
  693. X        else if (strEQ(str->str_ptr,"$0"))
  694. X        str_set(str,"$_");
  695. X    }
  696. X    else {
  697. X        str_cat(tmpstr,"[]");
  698. X        tmp2str = hfetch(symtab,tmpstr->str_ptr);
  699. X        if (tmp2str && atoi(tmp2str->str_ptr))
  700. X        str_cat(str,"[");
  701. X        else
  702. X        str_cat(str,"{");
  703. X        str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  704. X        str_free(fstr);
  705. X        if (tmp2str && atoi(tmp2str->str_ptr))
  706. X        strcpy(tokenbuf,"]");
  707. X        else
  708. X        strcpy(tokenbuf,"}");
  709. X        *tokenbuf += 128;
  710. X        str_cat(str,tokenbuf);
  711. X    }
  712. X    str_free(tmpstr);
  713. X    break;
  714. X    case OFLD:
  715. X    str = str_new(0);
  716. X    if (split_to_array) {
  717. X        str_set(str,"$Fld");
  718. X        str_cat(str,"[");
  719. X        str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  720. X        str_free(fstr);
  721. X        str_cat(str,"]");
  722. X    }
  723. X    else {
  724. X        i = atoi(walk(1,level,ops[node+1].ival,&numarg)->str_ptr);
  725. X        if (i <= arymax)
  726. X        sprintf(tokenbuf,"$%s",nameary[i]);
  727. X        else
  728. X        sprintf(tokenbuf,"$Fld%d",i);
  729. X        str_set(str,tokenbuf);
  730. X    }
  731. X    break;
  732. X    case OVFLD:
  733. X    str = str_new(0);
  734. X    str_set(str,"$Fld[");
  735. X    i = ops[node+1].ival;
  736. X    if ((ops[i].ival & 255) == OPAREN)
  737. X        i = ops[i+1].ival;
  738. X    tmpstr=walk(1,level,i,&numarg);
  739. X    str_scat(str,tmpstr);
  740. X    str_free(tmpstr);
  741. X    str_cat(str,"]");
  742. X    break;
  743. X    case OJUNK:
  744. X    goto def;
  745. X    case OSNEWLINE:
  746. X    str = str_new(2);
  747. X    str_set(str,";\n");
  748. X    tab(str,level);
  749. X    break;
  750. X    case ONEWLINE:
  751. X    str = str_new(1);
  752. X    str_set(str,"\n");
  753. X    tab(str,level);
  754. X    break;
  755. X    case OSCOMMENT:
  756. X    str = str_new(0);
  757. X    str_set(str,";");
  758. X    tmpstr = walk(0,level,ops[node+1].ival,&numarg);
  759. X    for (s = tmpstr->str_ptr; *s && *s != '\n'; s++)
  760. X        *s += 128;
  761. X    str_scat(str,tmpstr);
  762. X    str_free(tmpstr);
  763. X    tab(str,level);
  764. X    break;
  765. X    case OCOMMENT:
  766. X    str = str_new(0);
  767. X    tmpstr = walk(0,level,ops[node+1].ival,&numarg);
  768. X    for (s = tmpstr->str_ptr; *s && *s != '\n'; s++)
  769. X        *s += 128;
  770. X    str_scat(str,tmpstr);
  771. X    str_free(tmpstr);
  772. X    tab(str,level);
  773. X    break;
  774. X    case OCOMMA:
  775. X    str = walk(1,level,ops[node+1].ival,&numarg);
  776. X    str_cat(str,", ");
  777. X    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg));
  778. X    str_free(fstr);
  779. X    break;
  780. X    case OSEMICOLON:
  781. X    str = str_new(1);
  782. X    str_set(str,"; ");
  783. X    break;
  784. X    case OSTATES:
  785. X    str = walk(0,level,ops[node+1].ival,&numarg);
  786. X    str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
  787. X    str_free(fstr);
  788. X    break;
  789. X    case OSTATE:
  790. X    str = str_new(0);
  791. X    if (len >= 1) {
  792. X        str_scat(str,fstr=walk(0,level,ops[node+1].ival,&numarg));
  793. X        str_free(fstr);
  794. X        if (len >= 2) {
  795. X        tmpstr = walk(0,level,ops[node+2].ival,&numarg);
  796. X        if (*tmpstr->str_ptr == ';') {
  797. X            addsemi(str);
  798. X            str_cat(str,tmpstr->str_ptr+1);
  799. X        }
  800. X        str_free(tmpstr);
  801. X        }
  802. X    }
  803. X    break;
  804. X    case OPRINTF:
  805. X    case OPRINT:
  806. X    str = str_new(0);
  807. X    if (len == 3) {        /* output redirection */
  808. X        tmpstr = walk(1,level,ops[node+3].ival,&numarg);
  809. X        tmp2str = walk(1,level,ops[node+2].ival,&numarg);
  810. X        if (!do_fancy_opens) {
  811. X        t = tmpstr->str_ptr;
  812. X        if (*t == '"' || *t == '\'')
  813. X            t = cpytill(tokenbuf,t+1,*t);
  814. X        else
  815. X            fatal("Internal error: OPRINT");
  816. X        d = savestr(t);
  817. X        s = savestr(tokenbuf);
  818. X        for (t = tokenbuf; *t; t++) {
  819. X            *t &= 127;
  820. X            if (!isalpha(*t) && !isdigit(*t))
  821. X            *t = '_';
  822. X        }
  823. X        if (!index(tokenbuf,'_'))
  824. X            strcpy(t,"_fh");
  825. X        str_cat(opens,"open(");
  826. X        str_cat(opens,tokenbuf);
  827. X        str_cat(opens,", ");
  828. X        d[1] = '\0';
  829. X        str_cat(opens,d);
  830. X        str_scat(opens,tmp2str);
  831. X        str_cat(opens,tmpstr->str_ptr+1);
  832. X        if (*tmp2str->str_ptr == '|')
  833. X            str_cat(opens,") || die 'Cannot pipe to \"");
  834. X        else
  835. X            str_cat(opens,") || die 'Cannot create file \"");
  836. X        if (*d == '"')
  837. X            str_cat(opens,"'.\"");
  838. X        str_cat(opens,s);
  839. X        if (*d == '"')
  840. X            str_cat(opens,"\".'");
  841. X        str_cat(opens,"\".';\n");
  842. X        str_free(tmpstr);
  843. X        str_free(tmp2str);
  844. X        safefree(s);
  845. X        safefree(d);
  846. X        }
  847. X        else {
  848. X        sprintf(tokenbuf,"do Pick('%s' . (%s)) &&\n",
  849. X           tmp2str->str_ptr, tmpstr->str_ptr);
  850. X        str_cat(str,tokenbuf);
  851. X        tab(str,level+1);
  852. X        *tokenbuf = '\0';
  853. X        str_free(tmpstr);
  854. X        str_free(tmp2str);
  855. X        }
  856. X    }
  857. X    else
  858. X        strcpy(tokenbuf,"stdout");
  859. X    if (type == OPRINTF)
  860. X        str_cat(str,"printf");
  861. X    else
  862. X        str_cat(str,"print");
  863. X    if (len == 3 || do_fancy_opens) {
  864. X        if (*tokenbuf)
  865. X        str_cat(str," ");
  866. X        str_cat(str,tokenbuf);
  867. X    }
  868. X    tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg);
  869. X    if (!*tmpstr->str_ptr && lval_field) {
  870. X        t = saw_OFS ? "$," : "' '";
  871. X        if (split_to_array) {
  872. X        sprintf(tokenbuf,"join(%s,@Fld)",t);
  873. X        str_cat(tmpstr,tokenbuf);
  874. X        }
  875. X        else {
  876. X        for (i = 1; i < maxfld; i++) {
  877. X            if (i <= arymax)
  878. X            sprintf(tokenbuf,"$%s, ",nameary[i]);
  879. X            else
  880. X            sprintf(tokenbuf,"$Fld%d, ",i);
  881. X            str_cat(tmpstr,tokenbuf);
  882. X        }
  883. X        if (maxfld <= arymax)
  884. X            sprintf(tokenbuf,"$%s",nameary[maxfld]);
  885. X        else
  886. X            sprintf(tokenbuf,"$Fld%d",maxfld);
  887. X        str_cat(tmpstr,tokenbuf);
  888. X        }
  889. X    }
  890. X    if (*tmpstr->str_ptr) {
  891. X        str_cat(str," ");
  892. X        str_scat(str,tmpstr);
  893. X    }
  894. X    else {
  895. X        str_cat(str," $_");
  896. X    }
  897. X    str_free(tmpstr);
  898. X    break;
  899. X    case OLENGTH:
  900. X    str = str_make("length(");
  901. X    goto maybe0;
  902. X    case OLOG:
  903. X    str = str_make("log(");
  904. X    goto maybe0;
  905. X    case OEXP:
  906. X    str = str_make("exp(");
  907. X    goto maybe0;
  908. X    case OSQRT:
  909. X    str = str_make("sqrt(");
  910. X    goto maybe0;
  911. X    case OINT:
  912. X    str = str_make("int(");
  913. X      maybe0:
  914. X    numeric = 1;
  915. X    if (len > 0)
  916. X        tmpstr = walk(1,level,ops[node+1].ival,&numarg);
  917. X    else
  918. X        tmpstr = str_new(0);;
  919. X    if (!*tmpstr->str_ptr) {
  920. X        if (lval_field) {
  921. X        t = saw_OFS ? "$," : "' '";
  922. X        if (split_to_array) {
  923. X            sprintf(tokenbuf,"join(%s,@Fld)",t);
  924. X            str_cat(tmpstr,tokenbuf);
  925. X        }
  926. X        else {
  927. X            sprintf(tokenbuf,"join(%s, ",t);
  928. X            str_cat(tmpstr,tokenbuf);
  929. X            for (i = 1; i < maxfld; i++) {
  930. X            if (i <= arymax)
  931. X                sprintf(tokenbuf,"$%s,",nameary[i]);
  932. X            else
  933. X                sprintf(tokenbuf,"$Fld%d,",i);
  934. X            str_cat(tmpstr,tokenbuf);
  935. X            }
  936. X            if (maxfld <= arymax)
  937. X            sprintf(tokenbuf,"$%s)",nameary[maxfld]);
  938. X            else
  939. X            sprintf(tokenbuf,"$Fld%d)",maxfld);
  940. X            str_cat(tmpstr,tokenbuf);
  941. X        }
  942. X        }
  943. X        else
  944. X        str_cat(tmpstr,"$_");
  945. X    }
  946. X    if (strEQ(tmpstr->str_ptr,"$_")) {
  947. X        if (type == OLENGTH && !do_chop) {
  948. X        str = str_make("(length(");
  949. X        str_cat(tmpstr,") - 1");
  950. X        }
  951. X    }
  952. X    str_scat(str,tmpstr);
  953. X    str_free(tmpstr);
  954. X    str_cat(str,")");
  955. X    break;
  956. X    case OBREAK:
  957. X    str = str_new(0);
  958. X    str_set(str,"last");
  959. X    break;
  960. X    case ONEXT:
  961. X    str = str_new(0);
  962. X    str_set(str,"next line");
  963. X    break;
  964. X    case OEXIT:
  965. X    str = str_new(0);
  966. X    if (realexit) {
  967. X        str_set(str,"exit");
  968. X        if (len == 1) {
  969. X        str_cat(str," ");
  970. X        exitval = TRUE;
  971. X        str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  972. X        str_free(fstr);
  973. X        }
  974. X    }
  975. X    else {
  976. X        if (len == 1) {
  977. X        str_set(str,"ExitValue = ");
  978. X        exitval = TRUE;
  979. X        str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  980. X        str_free(fstr);
  981. X        str_cat(str,"; ");
  982. X        }
  983. X        str_cat(str,"last line");
  984. X    }
  985. X    break;
  986. X    case OCONTINUE:
  987. X    str = str_new(0);
  988. X    str_set(str,"next");
  989. X    break;
  990. X    case OREDIR:
  991. X    goto def;
  992. X    case OIF:
  993. X    str = str_new(0);
  994. X    str_set(str,"if (");
  995. X    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  996. X    str_free(fstr);
  997. X    str_cat(str,") ");
  998. X    str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
  999. X    str_free(fstr);
  1000. X    if (len == 3) {
  1001. X        i = ops[node+3].ival;
  1002. X        if (i) {
  1003. X        if ((ops[i].ival & 255) == OBLOCK) {
  1004. X            i = ops[i+1].ival;
  1005. X            if (i) {
  1006. X            if ((ops[i].ival & 255) != OIF)
  1007. X                i = 0;
  1008. X            }
  1009. X        }
  1010. X        else
  1011. X            i = 0;
  1012. X        }
  1013. X        if (i) {
  1014. X        str_cat(str,"els");
  1015. X        str_scat(str,fstr=walk(0,level,i,&numarg));
  1016. X        str_free(fstr);
  1017. X        }
  1018. X        else {
  1019. X        str_cat(str,"else ");
  1020. X        str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
  1021. X        str_free(fstr);
  1022. X        }
  1023. X    }
  1024. X    break;
  1025. X    case OWHILE:
  1026. X    str = str_new(0);
  1027. X    str_set(str,"while (");
  1028. X    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  1029. X    str_free(fstr);
  1030. X    str_cat(str,") ");
  1031. X    str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
  1032. X    str_free(fstr);
  1033. X    break;
  1034. X    case OFOR:
  1035. X    str = str_new(0);
  1036. X    str_set(str,"for (");
  1037. X    str_scat(str,tmpstr=walk(1,level,ops[node+1].ival,&numarg));
  1038. X    i = numarg;
  1039. X    if (i) {
  1040. X        t = s = tmpstr->str_ptr;
  1041. X        while (isalpha(*t) || isdigit(*t) || *t == '$' || *t == '_')
  1042. X        t++;
  1043. X        i = t - s;
  1044. X        if (i < 2)
  1045. X        i = 0;
  1046. X    }
  1047. X    str_cat(str,"; ");
  1048. X    fstr=walk(1,level,ops[node+2].ival,&numarg);
  1049. X    if (i && (t = index(fstr->str_ptr,0377))) {
  1050. X        if (strnEQ(fstr->str_ptr,s,i))
  1051. X        *t = ' ';
  1052. X    }
  1053. X    str_scat(str,fstr);
  1054. X    str_free(fstr);
  1055. X    str_free(tmpstr);
  1056. X    str_cat(str,"; ");
  1057. X    str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg));
  1058. X    str_free(fstr);
  1059. X    str_cat(str,") ");
  1060. X    str_scat(str,fstr=walk(0,level,ops[node+4].ival,&numarg));
  1061. X    str_free(fstr);
  1062. X    break;
  1063. X    case OFORIN:
  1064. X    tmpstr=walk(0,level,ops[node+2].ival,&numarg);
  1065. X    str = str_new(0);
  1066. X    str_sset(str,tmpstr);
  1067. X    str_cat(str,"[]");
  1068. X    tmp2str = hfetch(symtab,str->str_ptr);
  1069. X    if (tmp2str && atoi(tmp2str->str_ptr)) {
  1070. X        maxtmp++;
  1071. X        fstr=walk(1,level,ops[node+1].ival,&numarg);
  1072. X        sprintf(tokenbuf,
  1073. X          "for ($T_%d = 1; ($%s = $%s[$T_%d]) || $T_%d <= $#%s; $T_%d++)%c",
  1074. X          maxtmp,
  1075. X          fstr->str_ptr,
  1076. X          tmpstr->str_ptr,
  1077. X          maxtmp,
  1078. X          maxtmp,
  1079. X          tmpstr->str_ptr,
  1080. X          maxtmp,
  1081. X          0377);
  1082. X        str_set(str,tokenbuf);
  1083. X        str_free(fstr);
  1084. X        str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
  1085. X        str_free(fstr);
  1086. X    }
  1087. X    else {
  1088. X        str_set(str,"while (($junkkey,$");
  1089. X        str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg));
  1090. X        str_free(fstr);
  1091. X        str_cat(str,") = each(");
  1092. X        str_scat(str,tmpstr);
  1093. X        str_cat(str,")) ");
  1094. X        str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg));
  1095. X        str_free(fstr);
  1096. X    }
  1097. X    str_free(tmpstr);
  1098. X    break;
  1099. X    case OBLOCK:
  1100. X    str = str_new(0);
  1101. X    str_set(str,"{");
  1102. X    if (len == 2) {
  1103. X        str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg));
  1104. X        str_free(fstr);
  1105. X    }
  1106. X    fixtab(str,++level);
  1107. X    str_scat(str,fstr=walk(0,level,ops[node+1].ival,&numarg));
  1108. X    str_free(fstr);
  1109. X    addsemi(str);
  1110. X    fixtab(str,--level);
  1111. X    str_cat(str,"}\n");
  1112. X    tab(str,level);
  1113. X    break;
  1114. X    default:
  1115. X      def:
  1116. X    if (len) {
  1117. X        if (len > 5)
  1118. X        fatal("Garbage length in walk");
  1119. X        str = walk(0,level,ops[node+1].ival,&numarg);
  1120. X        for (i = 2; i<= len; i++) {
  1121. X        str_scat(str,fstr=walk(0,level,ops[node+i].ival,&numarg));
  1122. X        str_free(fstr);
  1123. X        }
  1124. X    }
  1125. X    else {
  1126. X        str = Nullstr;
  1127. X    }
  1128. X    break;
  1129. X    }
  1130. X    if (!str)
  1131. X    str = str_new(0);
  1132. X    *numericptr = numeric;
  1133. X#ifdef DEBUGGING
  1134. X    if (debug & 4) {
  1135. X    printf("%3d %5d %15s %d %4d ",level,node,opname[type],len,str->str_cur);
  1136. X    for (t = str->str_ptr; *t && t - str->str_ptr < 40; t++)
  1137. X        if (*t == '\n')
  1138. X        printf("\\n");
  1139. X        else if (*t == '\t')
  1140. X        printf("\\t");
  1141. X        else
  1142. X        putchar(*t);
  1143. X    putchar('\n');
  1144. X    }
  1145. X#endif
  1146. X    return str;
  1147. X}
  1148. X
  1149. Xtab(str,lvl)
  1150. Xregister STR *str;
  1151. Xregister int lvl;
  1152. X{
  1153. X    while (lvl > 1) {
  1154. X    str_cat(str,"\t");
  1155. X    lvl -= 2;
  1156. X    }
  1157. X    if (lvl)
  1158. X    str_cat(str,"    ");
  1159. X}
  1160. X
  1161. Xfixtab(str,lvl)
  1162. Xregister STR *str;
  1163. Xregister int lvl;
  1164. X{
  1165. X    register char *s;
  1166. X
  1167. X    /* strip trailing white space */
  1168. X
  1169. X    s = str->str_ptr+str->str_cur - 1;
  1170. X    while (s >= str->str_ptr && (*s == ' ' || *s == '\t'))
  1171. X    s--;
  1172. X    s[1] = '\0';
  1173. X    str->str_cur = s + 1 - str->str_ptr;
  1174. X    if (s >= str->str_ptr && *s != '\n')
  1175. X    str_cat(str,"\n");
  1176. X
  1177. X    tab(str,lvl);
  1178. X}
  1179. X
  1180. Xaddsemi(str)
  1181. Xregister STR *str;
  1182. X{
  1183. X    register char *s;
  1184. X
  1185. X    s = str->str_ptr+str->str_cur - 1;
  1186. X    while (s >= str->str_ptr && (*s == ' ' || *s == '\t' || *s == '\n'))
  1187. X    s--;
  1188. X    if (s >= str->str_ptr && *s != ';' && *s != '}')
  1189. X    str_cat(str,";");
  1190. X}
  1191. X
  1192. Xemit_split(str,level)
  1193. Xregister STR *str;
  1194. Xint level;
  1195. X{
  1196. X    register int i;
  1197. X
  1198. X    if (split_to_array)
  1199. X    str_cat(str,"@Fld");
  1200. X    else {
  1201. X    str_cat(str,"(");
  1202. X    for (i = 1; i < maxfld; i++) {
  1203. X        if (i <= arymax)
  1204. X        sprintf(tokenbuf,"$%s,",nameary[i]);
  1205. X        else
  1206. X        sprintf(tokenbuf,"$Fld%d,",i);
  1207. X        str_cat(str,tokenbuf);
  1208. X    }
  1209. X    if (maxfld <= arymax)
  1210. X        sprintf(tokenbuf,"$%s)",nameary[maxfld]);
  1211. X    else
  1212. X        sprintf(tokenbuf,"$Fld%d)",maxfld);
  1213. X    str_cat(str,tokenbuf);
  1214. X    }
  1215. X    if (const_FS) {
  1216. X    sprintf(tokenbuf," = split(/[%c\\n]/);\n",const_FS);
  1217. X    str_cat(str,tokenbuf);
  1218. X    }
  1219. X    else if (saw_FS)
  1220. X    str_cat(str," = split($FS);\n");
  1221. X    else
  1222. X    str_cat(str," = split;\n");
  1223. X    tab(str,level);
  1224. X}
  1225. X
  1226. Xprewalk(numit,level,node,numericptr)
  1227. Xint numit;
  1228. Xint level;
  1229. Xregister int node;
  1230. Xint *numericptr;
  1231. X{
  1232. X    register int len;
  1233. X    register int type;
  1234. X    register int i;
  1235. X    char *t;
  1236. X    char *d, *s;
  1237. X    int numarg;
  1238. X    int numeric = FALSE;
  1239. X
  1240. X    if (!node) {
  1241. X    *numericptr = 0;
  1242. X    return 0;
  1243. X    }
  1244. X    type = ops[node].ival;
  1245. X    len = type >> 8;
  1246. X    type &= 255;
  1247. X    switch (type) {
  1248. X    case OPROG:
  1249. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1250. X    if (ops[node+2].ival) {
  1251. X        prewalk(0,level,ops[node+2].ival,&numarg);
  1252. X    }
  1253. X    ++level;
  1254. X    prewalk(0,level,ops[node+3].ival,&numarg);
  1255. X    --level;
  1256. X    if (ops[node+3].ival) {
  1257. X        prewalk(0,level,ops[node+4].ival,&numarg);
  1258. X    }
  1259. X    break;
  1260. X    case OHUNKS:
  1261. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1262. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1263. X    if (len == 3) {
  1264. X        prewalk(0,level,ops[node+3].ival,&numarg);
  1265. X    }
  1266. X    break;
  1267. X    case ORANGE:
  1268. X    prewalk(1,level,ops[node+1].ival,&numarg);
  1269. X    prewalk(1,level,ops[node+2].ival,&numarg);
  1270. X    break;
  1271. X    case OPAT:
  1272. X    goto def;
  1273. X    case OREGEX:
  1274. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1275. X    break;
  1276. X    case OHUNK:
  1277. X    if (len == 1) {
  1278. X        prewalk(0,level,ops[node+1].ival,&numarg);
  1279. X    }
  1280. X    else {
  1281. X        i = prewalk(0,level,ops[node+1].ival,&numarg);
  1282. X        if (i) {
  1283. X        ++level;
  1284. X        prewalk(0,level,ops[node+2].ival,&numarg);
  1285. X        --level;
  1286. X        }
  1287. X        else {
  1288. X        prewalk(0,level,ops[node+2].ival,&numarg);
  1289. X        }
  1290. X    }
  1291. X    break;
  1292. X    case OPPAREN:
  1293. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1294. X    break;
  1295. X    case OPANDAND:
  1296. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1297. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1298. X    break;
  1299. X    case OPOROR:
  1300. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1301. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1302. X    break;
  1303. X    case OPNOT:
  1304. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1305. X    break;
  1306. X    case OCPAREN:
  1307. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1308. X    numeric |= numarg;
  1309. X    break;
  1310. X    case OCANDAND:
  1311. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1312. X    numeric = 1;
  1313. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1314. X    break;
  1315. X    case OCOROR:
  1316. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1317. X    numeric = 1;
  1318. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1319. X    break;
  1320. X    case OCNOT:
  1321. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1322. X    numeric = 1;
  1323. X    break;
  1324. X    case ORELOP:
  1325. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1326. X    numeric |= numarg;
  1327. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1328. X    prewalk(0,level,ops[node+3].ival,&numarg);
  1329. X    numeric |= numarg;
  1330. X    numeric = 1;
  1331. X    break;
  1332. X    case ORPAREN:
  1333. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1334. X    numeric |= numarg;
  1335. X    break;
  1336. X    case OMATCHOP:
  1337. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1338. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1339. X    prewalk(0,level,ops[node+3].ival,&numarg);
  1340. X    numeric = 1;
  1341. X    break;
  1342. X    case OMPAREN:
  1343. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1344. X    numeric |= numarg;
  1345. X    break;
  1346. X    case OCONCAT:
  1347. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1348. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1349. X    break;
  1350. X    case OASSIGN:
  1351. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1352. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1353. X    prewalk(0,level,ops[node+3].ival,&numarg);
  1354. X    if (numarg || strlen(ops[ops[node+1].ival+1].cval) > 1) {
  1355. X        numericize(ops[node+2].ival);
  1356. X        if (!numarg)
  1357. X        numericize(ops[node+3].ival);
  1358. X    }
  1359. X    numeric |= numarg;
  1360. X    break;
  1361. X    case OADD:
  1362. X    prewalk(1,level,ops[node+1].ival,&numarg);
  1363. X    prewalk(1,level,ops[node+2].ival,&numarg);
  1364. X    numeric = 1;
  1365. X    break;
  1366. X    case OSUB:
  1367. X    prewalk(1,level,ops[node+1].ival,&numarg);
  1368. X    prewalk(1,level,ops[node+2].ival,&numarg);
  1369. X    numeric = 1;
  1370. X    break;
  1371. X    case OMULT:
  1372. X    prewalk(1,level,ops[node+1].ival,&numarg);
  1373. X    prewalk(1,level,ops[node+2].ival,&numarg);
  1374. X    numeric = 1;
  1375. X    break;
  1376. X    case ODIV:
  1377. X    prewalk(1,level,ops[node+1].ival,&numarg);
  1378. X    prewalk(1,level,ops[node+2].ival,&numarg);
  1379. X    numeric = 1;
  1380. X    break;
  1381. X    case OMOD:
  1382. X    prewalk(1,level,ops[node+1].ival,&numarg);
  1383. X    prewalk(1,level,ops[node+2].ival,&numarg);
  1384. X    numeric = 1;
  1385. X    break;
  1386. X    case OPOSTINCR:
  1387. X    prewalk(1,level,ops[node+1].ival,&numarg);
  1388. X    numeric = 1;
  1389. X    break;
  1390. X    case OPOSTDECR:
  1391. X    prewalk(1,level,ops[node+1].ival,&numarg);
  1392. X    numeric = 1;
  1393. X    break;
  1394. X    case OPREINCR:
  1395. X    prewalk(1,level,ops[node+1].ival,&numarg);
  1396. X    numeric = 1;
  1397. X    break;
  1398. X    case OPREDECR:
  1399. X    prewalk(1,level,ops[node+1].ival,&numarg);
  1400. X    numeric = 1;
  1401. X    break;
  1402. X    case OUMINUS:
  1403. X    prewalk(1,level,ops[node+1].ival,&numarg);
  1404. X    numeric = 1;
  1405. X    break;
  1406. X    case OUPLUS:
  1407. X    prewalk(1,level,ops[node+1].ival,&numarg);
  1408. X    numeric = 1;
  1409. X    break;
  1410. X    case OPAREN:
  1411. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1412. X    numeric |= numarg;
  1413. X    break;
  1414. X    case OGETLINE:
  1415. X    break;
  1416. X    case OSPRINTF:
  1417. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1418. X    break;
  1419. X    case OSUBSTR:
  1420. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1421. X    prewalk(1,level,ops[node+2].ival,&numarg);
  1422. X    if (len == 3) {
  1423. X        prewalk(1,level,ops[node+3].ival,&numarg);
  1424. X    }
  1425. X    break;
  1426. X    case OSTRING:
  1427. X    break;
  1428. X    case OSPLIT:
  1429. X    numeric = 1;
  1430. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1431. X    if (len == 3)
  1432. X        prewalk(0,level,ops[node+3].ival,&numarg);
  1433. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1434. X    break;
  1435. X    case OINDEX:
  1436. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1437. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1438. X    numeric = 1;
  1439. X    break;
  1440. X    case ONUM:
  1441. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1442. X    numeric = 1;
  1443. X    break;
  1444. X    case OSTR:
  1445. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1446. X    break;
  1447. X    case OVAR:
  1448. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1449. X    if (len == 1) {
  1450. X        if (numit)
  1451. X        numericize(node);
  1452. X    }
  1453. X    else {
  1454. X        prewalk(0,level,ops[node+2].ival,&numarg);
  1455. X    }
  1456. X    break;
  1457. X    case OFLD:
  1458. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1459. X    break;
  1460. X    case OVFLD:
  1461. X    i = ops[node+1].ival;
  1462. X    prewalk(0,level,i,&numarg);
  1463. X    break;
  1464. X    case OJUNK:
  1465. X    goto def;
  1466. X    case OSNEWLINE:
  1467. X    break;
  1468. X    case ONEWLINE:
  1469. X    break;
  1470. X    case OSCOMMENT:
  1471. X    break;
  1472. X    case OCOMMENT:
  1473. X    break;
  1474. X    case OCOMMA:
  1475. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1476. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1477. X    break;
  1478. X    case OSEMICOLON:
  1479. X    break;
  1480. X    case OSTATES:
  1481. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1482. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1483. X    break;
  1484. X    case OSTATE:
  1485. X    if (len >= 1) {
  1486. X        prewalk(0,level,ops[node+1].ival,&numarg);
  1487. X        if (len >= 2) {
  1488. X        prewalk(0,level,ops[node+2].ival,&numarg);
  1489. X        }
  1490. X    }
  1491. X    break;
  1492. X    case OPRINTF:
  1493. X    case OPRINT:
  1494. X    if (len == 3) {        /* output redirection */
  1495. X        prewalk(0,level,ops[node+3].ival,&numarg);
  1496. X        prewalk(0,level,ops[node+2].ival,&numarg);
  1497. X    }
  1498. X    prewalk(0+(type==OPRINT),level,ops[node+1].ival,&numarg);
  1499. X    break;
  1500. X    case OLENGTH:
  1501. X    goto maybe0;
  1502. X    case OLOG:
  1503. X    goto maybe0;
  1504. X    case OEXP:
  1505. X    goto maybe0;
  1506. X    case OSQRT:
  1507. X    goto maybe0;
  1508. X    case OINT:
  1509. X      maybe0:
  1510. X    numeric = 1;
  1511. X    if (len > 0)
  1512. X        prewalk(type != OLENGTH,level,ops[node+1].ival,&numarg);
  1513. X    break;
  1514. X    case OBREAK:
  1515. X    break;
  1516. X    case ONEXT:
  1517. X    break;
  1518. X    case OEXIT:
  1519. X    if (len == 1) {
  1520. X        prewalk(1,level,ops[node+1].ival,&numarg);
  1521. X    }
  1522. X    break;
  1523. X    case OCONTINUE:
  1524. X    break;
  1525. X    case OREDIR:
  1526. X    goto def;
  1527. X    case OIF:
  1528. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1529. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1530. X    if (len == 3) {
  1531. X        prewalk(0,level,ops[node+3].ival,&numarg);
  1532. X    }
  1533. X    break;
  1534. X    case OWHILE:
  1535. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1536. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1537. X    break;
  1538. X    case OFOR:
  1539. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1540. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1541. X    prewalk(0,level,ops[node+3].ival,&numarg);
  1542. X    prewalk(0,level,ops[node+4].ival,&numarg);
  1543. X    break;
  1544. X    case OFORIN:
  1545. X    prewalk(0,level,ops[node+2].ival,&numarg);
  1546. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1547. X    prewalk(0,level,ops[node+3].ival,&numarg);
  1548. X    break;
  1549. X    case OBLOCK:
  1550. X    if (len == 2) {
  1551. X        prewalk(0,level,ops[node+2].ival,&numarg);
  1552. X    }
  1553. X    ++level;
  1554. X    prewalk(0,level,ops[node+1].ival,&numarg);
  1555. X    --level;
  1556. X    break;
  1557. X    default:
  1558. X      def:
  1559. X    if (len) {
  1560. X        if (len > 5)
  1561. X        fatal("Garbage length in prewalk");
  1562. X        prewalk(0,level,ops[node+1].ival,&numarg);
  1563. X        for (i = 2; i<= len; i++) {
  1564. X        prewalk(0,level,ops[node+i].ival,&numarg);
  1565. X        }
  1566. X    }
  1567. X    break;
  1568. X    }
  1569. X    *numericptr = numeric;
  1570. X    return 1;
  1571. X}
  1572. X
  1573. Xnumericize(node)
  1574. Xregister int node;
  1575. X{
  1576. X    register int len;
  1577. X    register int type;
  1578. X    register int i;
  1579. X    STR *tmpstr;
  1580. X    STR *tmp2str;
  1581. X    int numarg;
  1582. X
  1583. X    type = ops[node].ival;
  1584. X    len = type >> 8;
  1585. X    type &= 255;
  1586. X    if (type == OVAR && len == 1) {
  1587. X    tmpstr=walk(0,0,ops[node+1].ival,&numarg);
  1588. X    tmp2str = str_make("1");
  1589. X    hstore(symtab,tmpstr->str_ptr,tmp2str);
  1590. X    }
  1591. X}
  1592. !STUFFY!FUNK!
  1593. echo Extracting x2p/s2p
  1594. sed >x2p/s2p <<'!STUFFY!FUNK!' -e 's/X//'
  1595. X#!/bin/perl
  1596. X
  1597. X$indent = 4;
  1598. X$shiftwidth = 4;
  1599. X$l = '{'; $r = '}';
  1600. X$tempvar = '1';
  1601. X
  1602. Xwhile ($ARGV[0] =~ '^-') {
  1603. X    $_ = shift;
  1604. X  last if /^--/;
  1605. X    if (/^-D/) {
  1606. X    $debug++;
  1607. X    open(body,'>-');
  1608. X    next;
  1609. X    }
  1610. X    if (/^-n/) {
  1611. X    $assumen++;
  1612. X    next;
  1613. X    }
  1614. X    if (/^-p/) {
  1615. X    $assumep++;
  1616. X    next;
  1617. X    }
  1618. X    die "I don't recognize this switch: $_";
  1619. X}
  1620. X
  1621. Xunless ($debug) {
  1622. X    open(body,">/tmp/sperl$$") || do Die("Can't open temp file.");
  1623. X}
  1624. X
  1625. Xif (!$assumen && !$assumep) {
  1626. X    print body
  1627. X'while ($ARGV[0] =~ /^-/) {
  1628. X    $_ = shift;
  1629. X  last if /^--/;
  1630. X    if (/^-n/) {
  1631. X    $nflag++;
  1632. X    next;
  1633. X    }
  1634. X    die "I don\'t recognize this switch: $_";
  1635. X}
  1636. X
  1637. X';
  1638. X}
  1639. X
  1640. Xprint body '
  1641. X#ifdef PRINTIT
  1642. X#ifdef ASSUMEP
  1643. X$printit++;
  1644. X#else
  1645. X$printit++ unless $nflag;
  1646. X#endif
  1647. X#endif
  1648. Xline: while (<>) {
  1649. X';
  1650. X
  1651. Xline: while (<>) {
  1652. X    s/[ \t]*(.*)\n$/$1/;
  1653. X    if (/^:/) {
  1654. X    s/^:[ \t]*//;
  1655. X    $label = do make_label($_);
  1656. X    if ($. == 1) {
  1657. X        $toplabel = $label;
  1658. X    }
  1659. X    $_ = "$label:";
  1660. X    if ($lastlinewaslabel++) {$_ .= "\t;";}
  1661. X    if ($indent >= 2) {
  1662. X        $indent -= 2;
  1663. X        $indmod = 2;
  1664. X    }
  1665. X    next;
  1666. X    } else {
  1667. X    $lastlinewaslabel = '';
  1668. X    }
  1669. X    $addr1 = '';
  1670. X    $addr2 = '';
  1671. X    if (s/^([0-9]+)//) {
  1672. X    $addr1 = "$1";
  1673. X    }
  1674. X    elsif (s/^\$//) {
  1675. X    $addr1 = 'eof()';
  1676. X    }
  1677. X    elsif (s|^/||) {
  1678. X    $addr1 = '/';
  1679. X    delim: while (s:^([^(|)\\/]*)([(|)\\/])::) {
  1680. X        $prefix = $1;
  1681. X        $delim = $2;
  1682. X        if ($delim eq '\\') {
  1683. X        s/(.)(.*)/$2/;
  1684. X        $ch = $1;
  1685. X        $delim = '' if index("(|)",$ch) >= 0;
  1686. X        $delim .= $1;
  1687. X        }
  1688. X        elsif ($delim ne '/') {
  1689. X        $delim = '\\' . $delim;
  1690. X        }
  1691. X        $addr1 .= $prefix;
  1692. X        $addr1 .= $delim;
  1693. X        if ($delim eq '/') {
  1694. X        last delim;
  1695. X        }
  1696. X    }
  1697. X    }
  1698. X    if (s/^,//) {
  1699. X    if (s/^([0-9]+)//) {
  1700. X        $addr2 = "$1";
  1701. X    } elsif (s/^\$//) {
  1702. X        $addr2 = "eof()";
  1703. X    } elsif (s|^/||) {
  1704. X        $addr2 = '/';
  1705. X        delim: while (s:^([^(|)\\/]*)([(|)\\/])::) {
  1706. X        $prefix = $1;
  1707. X        $delim = $2;
  1708. X        if ($delim eq '\\') {
  1709. X            s/(.)(.*)/$2/;
  1710. X            $ch = $1;
  1711. X            $delim = '' if index("(|)",$ch) >= 0;
  1712. X            $delim .= $1;
  1713. X        }
  1714. X        elsif ($delim ne '/') {
  1715. X            $delim = '\\' . $delim;
  1716. X        }
  1717. X        $addr2 .= $prefix;
  1718. X        $addr2 .= $delim;
  1719. X        if ($delim eq '/') {
  1720. X            last delim;
  1721. X        }
  1722. X        }
  1723. X    } else {
  1724. X        do Die("Invalid second address at line $.: $_");
  1725. X    }
  1726. X    $addr1 .= " .. $addr2";
  1727. X    }
  1728. X                    # a { to keep vi happy
  1729. X    if ($_ eq '}') {
  1730. X    $indent -= 4;
  1731. X    next;
  1732. X    }
  1733. X    if (s/^!//) {
  1734. X    $if = 'unless';
  1735. X    $else = "$r else $l\n";
  1736. X    } else {
  1737. X    $if = 'if';
  1738. X    $else = '';
  1739. X    }
  1740. X    if (s/^{//) {    # a } to keep vi happy
  1741. X    $indmod = 4;
  1742. X    $redo = $_;
  1743. X    $_ = '';
  1744. X    $rmaybe = '';
  1745. X    } else {
  1746. X    $rmaybe = "\n$r";
  1747. X    if ($addr2 || $addr1) {
  1748. X        $space = substr('        ',0,$shiftwidth);
  1749. X    } else {
  1750. X        $space = '';
  1751. X    }
  1752. X    $_ = do transmogrify();
  1753. X    }
  1754. X
  1755. X    if ($addr1) {
  1756. X    if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
  1757. X      $_ !~ / if / && $_ !~ / unless /) {
  1758. X        s/;$/ $if $addr1;/;
  1759. X        $_ = substr($_,$shiftwidth,1000);
  1760. X    } else {
  1761. X        $command = $_;
  1762. X        $_ = "$if ($addr1) $l\n$change$command$rmaybe";
  1763. X    }
  1764. X    $change = '';
  1765. X    next line;
  1766. X    }
  1767. X} continue {
  1768. X    @lines = split(/\n/,$_);
  1769. X    while ($#lines >= 0) {
  1770. X    $_ = shift(lines);
  1771. X    unless (s/^ *<<--//) {
  1772. X        print body substr("\t\t\t\t\t\t\t\t\t\t\t\t",0,$indent / 8),
  1773. X        substr('        ',0,$indent % 8);
  1774. X    }
  1775. X    print body $_, "\n";
  1776. X    }
  1777. X    $indent += $indmod;
  1778. X    $indmod = 0;
  1779. X    if ($redo) {
  1780. X    $_ = $redo;
  1781. X    $redo = '';
  1782. X    redo line;
  1783. X    }
  1784. X}
  1785. X
  1786. Xprint body "}\n";
  1787. Xif ($appendseen || $tseen || !$assumen) {
  1788. X    $printit++ if $dseen || (!$assumen && !$assumep);
  1789. X    print body '
  1790. Xcontinue {
  1791. X#ifdef PRINTIT
  1792. X#ifdef DSEEN
  1793. X#ifdef ASSUMEP
  1794. X    print if $printit++;
  1795. X#else
  1796. X    if ($printit) { print;} else { $printit++ unless $nflag; }
  1797. X#endif
  1798. X#else
  1799. X    print if $printit;
  1800. X#endif
  1801. X#else
  1802. X    print;
  1803. X#endif
  1804. X#ifdef TSEEN
  1805. X    $tflag = \'\';
  1806. X#endif
  1807. X#ifdef APPENDSEEN
  1808. X    if ($atext) { print $atext; $atext = \'\'; }
  1809. X#endif
  1810. X}
  1811. X';
  1812. X}
  1813. X
  1814. Xclose body;
  1815. X
  1816. Xunless ($debug) {
  1817. X    open(head,">/tmp/sperl2$$") || do Die("Can't open temp file 2.\n");
  1818. X    print head "#define PRINTIT\n" if ($printit);
  1819. X    print head "#define APPENDSEEN\n" if ($appendseen);
  1820. X    print head "#define TSEEN\n" if ($tseen);
  1821. X    print head "#define DSEEN\n" if ($dseen);
  1822. X    print head "#define ASSUMEN\n" if ($assumen);
  1823. X    print head "#define ASSUMEP\n" if ($assumep);
  1824. X    if ($opens) {print head "$opens\n";}
  1825. X    open(body,"/tmp/sperl$$") || do Die("Can't reopen temp file.");
  1826. X    while (<body>) {
  1827. X    print head $_;
  1828. X    }
  1829. X    close head;
  1830. X
  1831. X    print "#!/bin/perl\n\n";
  1832. X    open(body,"cc -E /tmp/sperl2$$ |") ||
  1833. X    do Die("Can't reopen temp file.");
  1834. X    while (<body>) {
  1835. X    /^# [0-9]/ && next;
  1836. X    /^[ \t]*$/ && next;
  1837. X    s/^<><>//;
  1838. X    print;
  1839. X    }
  1840. X}
  1841. X
  1842. X`/bin/rm -f /tmp/sperl$$ /tmp/sperl2$$`;
  1843. X
  1844. Xsub Die {
  1845. X    `/bin/rm -f /tmp/sperl$$ /tmp/sperl2$$`;
  1846. X    die $_[0];
  1847. X}
  1848. Xsub make_filehandle {
  1849. X    $fname = $_ = $_[0];
  1850. X    s/[^a-zA-Z]/_/g;
  1851. X    s/^_*//;
  1852. X    if (/^([a-z])([a-z]*)$/) {
  1853. X    $first = $1;
  1854. X    $rest = $2;
  1855. X    $first =~ y/a-z/A-Z/;
  1856. X    $_ = $first . $rest;
  1857. X    }
  1858. X    if (!$seen{$_}) {
  1859. X    $opens .= "open($_,'>$fname') || die \"Can't create $fname.\";\n";
  1860. X    }
  1861. X    $seen{$_} = $_;
  1862. X}
  1863. X
  1864. Xsub make_label {
  1865. X    $label = $_[0];
  1866. X    $label =~ s/[^a-zA-Z0-9]/_/g;
  1867. X    if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
  1868. X    $label = substr($label,0,8);
  1869. X    if ($label =~ /^([a-z])([a-z]*)$/) {
  1870. X    $first = $1;
  1871. X    $rest = $2;
  1872. X    $first =~ y/a-z/A-Z/;
  1873. X    $label = $first . $rest;
  1874. X    }
  1875. X    $label;
  1876. X}
  1877. X
  1878. Xsub transmogrify {
  1879. X    {    # case
  1880. X    if (/^d/) {
  1881. X        $dseen++;
  1882. X        $_ = '
  1883. X<<--#ifdef PRINTIT
  1884. X$printit = \'\';
  1885. X<<--#endif
  1886. Xnext line;';
  1887. X        next;
  1888. X    }
  1889. X
  1890. X    if (/^n/) {
  1891. X        $_ =
  1892. X'<<--#ifdef PRINTIT
  1893. X<<--#ifdef DSEEN
  1894. X<<--#ifdef ASSUMEP
  1895. Xprint if $printit++;
  1896. X<<--#else
  1897. Xif ($printit) { print;} else { $printit++ unless $nflag; }
  1898. X<<--#endif
  1899. X<<--#else
  1900. Xprint if $printit;
  1901. X<<--#endif
  1902. X<<--#else
  1903. Xprint;
  1904. X<<--#endif
  1905. X<<--#ifdef APPENDSEEN
  1906. Xif ($atext) {print $atext; $atext = \'\';}
  1907. X<<--#endif
  1908. X$_ = <>;
  1909. X<<--#ifdef TSEEN
  1910. X$tflag = \'\';
  1911. X<<--#endif';
  1912. X        next;
  1913. X    }
  1914. X
  1915. X    if (/^a/) {
  1916. X        $appendseen++;
  1917. X        $command = $space .  '$atext .=' . "\n<<--'";
  1918. X        $lastline = 0;
  1919. X        while (<>) {
  1920. X        s/^[ \t]*//;
  1921. X        s/^[\\]//;
  1922. X        unless (s|\\$||) { $lastline = 1;}
  1923. X        s/'/\\'/g;
  1924. X        s/^([ \t]*\n)/<><>$1/;
  1925. X        $command .= $_;
  1926. X        $command .= '<<--';
  1927. X        last if $lastline;
  1928. X        }
  1929. X        $_ = $command . "';";
  1930. X        last;
  1931. X    }
  1932. X
  1933. X    if (/^[ic]/) {
  1934. X        if (/^c/) { $change = 1; }
  1935. X        $addr1 = '$iter = (' . $addr1 . ')';
  1936. X        $command = $space .  'if ($iter == 1) { print' . "\n<<--'";
  1937. X        $lastline = 0;
  1938. X        while (<>) {
  1939. X        s/^[ \t]*//;
  1940. X        s/^[\\]//;
  1941. X        unless (s/\\$//) { $lastline = 1;}
  1942. X        s/'/\\'/g;
  1943. X        s/^([ \t]*\n)/<><>$1/;
  1944. X        $command .= $_;
  1945. X        $command .= '<<--';
  1946. X        last if $lastline;
  1947. X        }
  1948. X        $_ = $command . "';}";
  1949. X        if ($change) {
  1950. X        $dseen++;
  1951. X        $change = "$_\n";
  1952. X        $_ = "
  1953. X<<--#ifdef PRINTIT
  1954. X$space\$printit = '';
  1955. X<<--#endif
  1956. X${space}next line;";
  1957. X        }
  1958. X        last;
  1959. X    }
  1960. X
  1961. X    if (/^s/) {
  1962. X        $delim = substr($_,1,1);
  1963. X        $len = length($_);
  1964. X        $repl = $end = 0;
  1965. X        for ($i = 2; $i < $len; $i++) {
  1966. X        $c = substr($_,$i,1);
  1967. X        if ($c eq '\\') {
  1968. X            $i++;
  1969. X            if ($i >= $len) {
  1970. X            $_ .= 'n';
  1971. X            $_ .= <>;
  1972. X            $len = length($_);
  1973. X            $_ = substr($_,0,--$len);
  1974. X            }
  1975. X            elsif (!$repl && index("(|)",substr($_,$i,1)) >= 0) {
  1976. X            $i--;
  1977. X            $len--;
  1978. X            $_ = substr($_,0,$i) . substr($_,$i+1,10000);
  1979. X            }
  1980. X        }
  1981. X        elsif ($c eq $delim) {
  1982. X            if ($repl) {
  1983. X            $end = $i;
  1984. X            last;
  1985. X            } else {
  1986. X            $repl = $i;
  1987. X            }
  1988. X        }
  1989. X        elsif (!$repl && index("(|)",$c) >= 0) {
  1990. X            $_ = substr($_,0,$i) . '\\' . substr($_,$i,10000);
  1991. X            $i++;
  1992. X            $len++;
  1993. X        }
  1994. X        }
  1995. X        print "repl $repl end $end $_\n";
  1996. X        do Die("Malformed substitution at line $.") unless $end;
  1997. X        $pat = substr($_, 0, $repl + 1);
  1998. X        $repl = substr($_, $repl + 1, $end - $repl - 1);
  1999. X        $end = substr($_, $end + 1, 1000);
  2000. X        $dol = '$';
  2001. X        $repl =~ s'&'$&'g;
  2002. X        $repl =~ s/[\\]([0-9])/$dol$1/g;
  2003. X        $subst = "$pat$repl$delim";
  2004. X        $cmd = '';
  2005. X        while ($end) {
  2006. X        if ($end =~ s/^g//) { $subst .= 'g'; next; }
  2007. X        if ($end =~ s/^p//) { $cmd .= ' && (print)'; next; }
  2008. X        if ($end =~ s/^w[ \t]*//) {
  2009. X            $fh = do make_filehandle($end);
  2010. X            $cmd .= " && (print $fh \$_)";
  2011. X            $end = '';
  2012. X            next;
  2013. X        }
  2014. X        do Die("Unrecognized substitution command ($end) at line $.");
  2015. X        }
  2016. X        $_ = $subst . $cmd . ';';
  2017. X        next;
  2018. X    }
  2019. X
  2020. X    if (/^p/) {
  2021. X        $_ = 'print;';
  2022. X        next;
  2023. X    }
  2024. X
  2025. X    if (/^w/) {
  2026. X        s/^w[ \t]*//;
  2027. X        $fh = do make_filehandle($_);
  2028. X        $_ = "print $fh \$_;";
  2029. X        next;
  2030. X    }
  2031. X
  2032. X    if (/^r/) {
  2033. X        $appendseen++;
  2034. X        s/^r[ \t]*//;
  2035. X        $file = $_;
  2036. X        $_ = "\$atext .= `cat $file 2>/dev/null`;";
  2037. X        next;
  2038. X    }
  2039. X
  2040. X    if (/^P/) {
  2041. X        $_ =
  2042. X'if (/(^[^\n]*\n)/) {
  2043. X    print $1;
  2044. X}';
  2045. X        next;
  2046. X    }
  2047. X
  2048. X    if (/^D/) {
  2049. X        $_ =
  2050. X's/^[^\n]*\n//;
  2051. Xif ($_) {redo line;}
  2052. Xnext line;';
  2053. X        next;
  2054. X    }
  2055. X
  2056. X    if (/^N/) {
  2057. X        $_ = '
  2058. X$_ .= <>;
  2059. X<<--#ifdef TSEEN
  2060. X$tflag = \'\';
  2061. X<<--#endif';
  2062. X        next;
  2063. X    }
  2064. X
  2065. X    if (/^h/) {
  2066. X        $_ = '$hold = $_;';
  2067. X        next;
  2068. X    }
  2069. X
  2070. X    if (/^H/) {
  2071. X        $_ = '$hold .= $_ ? $_ : "\n";';
  2072. X        next;
  2073. X    }
  2074. X
  2075. X    if (/^g/) {
  2076. X        $_ = '$_ = $hold;';
  2077. X        next;
  2078. X    }
  2079. X
  2080. X    if (/^G/) {
  2081. X        $_ = '$_ .= $hold ? $hold : "\n";';
  2082. X        next;
  2083. X    }
  2084. X
  2085. X    if (/^x/) {
  2086. X        $_ = '($_, $hold) = ($hold, $_);';
  2087. X        next;
  2088. X    }
  2089. X
  2090. X    if (/^b$/) {
  2091. X        $_ = 'next line;';
  2092. X        next;
  2093. X    }
  2094. X
  2095. X    if (/^b/) {
  2096. X        s/^b[ \t]*//;
  2097. X        $lab = do make_label($_);
  2098. X        if ($lab eq $toplabel) {
  2099. X        $_ = 'redo line;';
  2100. X        } else {
  2101. X        $_ = "goto $lab;";
  2102. X        }
  2103. X        next;
  2104. X    }
  2105. X
  2106. X    if (/^t$/) {
  2107. X        $_ = 'next line if $tflag;';
  2108. X        $tseen++;
  2109. X        next;
  2110. X    }
  2111. X
  2112. X    if (/^t/) {
  2113. X        s/^t[ \t]*//;
  2114. X        $lab = do make_label($_);
  2115. X        if ($lab eq $toplabel) {
  2116. X        $_ = 'if ($tflag) {$tflag = \'\'; redo line;}';
  2117. X        } else {
  2118. X        $_ = "if (\$tflag) {\$tflag = ''; goto $lab;}";
  2119. X        }
  2120. X        $tseen++;
  2121. X        next;
  2122. X    }
  2123. X
  2124. X    if (/^=/) {
  2125. X        $_ = 'print "$.\n";';
  2126. X        next;
  2127. X    }
  2128. X
  2129. X    if (/^q/) {
  2130. X        $_ =
  2131. X'close(ARGV);
  2132. X@ARGV = ();
  2133. Xnext line;';
  2134. X        next;
  2135. X    }
  2136. X    } continue {
  2137. X    if ($space) {
  2138. X        s/^/$space/;
  2139. X        s/(\n)(.)/$1$space$2/g;
  2140. X    }
  2141. X    last;
  2142. X    }
  2143. X    $_;
  2144. X}
  2145. X
  2146. !STUFFY!FUNK!
  2147. echo Extracting patchlevel.h
  2148. sed >patchlevel.h <<'!STUFFY!FUNK!' -e 's/X//'
  2149. X#define PATCHLEVEL 0
  2150. !STUFFY!FUNK!
  2151. echo ""
  2152. echo "End of kit 1 (of 10)"
  2153. cat /dev/null >kit1isdone
  2154. config=true
  2155. for iskit in 1 2 3 4 5 6 7 8 9 10; do
  2156.     if test -f kit${iskit}isdone; then
  2157.     echo "You have run kit ${iskit}."
  2158.     else
  2159.     echo "You still need to run kit ${iskit}."
  2160.     config=false
  2161.     fi
  2162. done
  2163. case $config in
  2164.     true)
  2165.     echo "You have run all your kits.  Please read README and then type Configure."
  2166.     chmod 755 Configure
  2167.     ;;
  2168. esac
  2169. : Someone might mail this, so...
  2170. exit
  2171.