home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume15 / perl2 / part04 < prev    next >
Encoding:
Internet Message Format  |  1989-01-05  |  49.1 KB
  1. Subject:  v15i093:  Perl, release 2, Part04/15
  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 15, Issue 93
  8. Archive-name: perl2/part04
  9.  
  10. #! /bin/sh
  11.  
  12. # Make a new directory for the perl sources, cd to it, and run kits 1
  13. # thru 15 through sh.  When all 15 kits have been run, read README.
  14.  
  15. echo "This is perl 2.0 kit 4 (of 15).  If kit 4 is complete, the line"
  16. echo '"'"End of kit 4 (of 15)"'" will echo at the end.'
  17. echo ""
  18. export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
  19. mkdir x2p 2>/dev/null
  20. echo Extracting perly.c
  21. sed >perly.c <<'!STUFFY!FUNK!' -e 's/X//'
  22. Xchar rcsid[] = "$Header: perly.c,v 2.0 88/06/05 00:09:56 root Exp $";
  23. X/*
  24. X * $Log:    perly.c,v $
  25. X * Revision 2.0  88/06/05  00:09:56  root
  26. X * Baseline version 2.0.
  27. X * 
  28. X */
  29. X
  30. X#include "EXTERN.h"
  31. X#include "perl.h"
  32. X#include "perly.h"
  33. X
  34. Xextern char *tokename[];
  35. Xextern int yychar;
  36. X
  37. Xstatic int cmd_tosave();
  38. Xstatic int arg_tosave();
  39. Xstatic int spat_tosave();
  40. X
  41. Xmain(argc,argv,env)
  42. Xregister int argc;
  43. Xregister char **argv;
  44. Xregister char **env;
  45. X{
  46. X    register STR *str;
  47. X    register char *s;
  48. X    char *index(), *strcpy(), *getenv();
  49. X    bool dosearch = FALSE;
  50. X
  51. X    uid = (int)getuid();
  52. X    euid = (int)geteuid();
  53. X    linestr = str_new(80);
  54. X    str_nset(linestr,"",0);
  55. X    str = str_make("");        /* first used for -I flags */
  56. X    incstab = aadd(stabent("INC",TRUE));
  57. X    for (argc--,argv++; argc; argc--,argv++) {
  58. X    if (argv[0][0] != '-' || !argv[0][1])
  59. X        break;
  60. X      reswitch:
  61. X    switch (argv[0][1]) {
  62. X    case 'a':
  63. X        minus_a = TRUE;
  64. X        strcpy(argv[0], argv[0]+1);
  65. X        goto reswitch;
  66. X#ifdef DEBUGGING
  67. X    case 'D':
  68. X        debug = atoi(argv[0]+2);
  69. X#ifdef YYDEBUG
  70. X        yydebug = (debug & 1);
  71. X#endif
  72. X        break;
  73. X#endif
  74. X    case 'e':
  75. X        if (!e_fp) {
  76. X            e_tmpname = strcpy(safemalloc(sizeof(TMPPATH)),TMPPATH);
  77. X        mktemp(e_tmpname);
  78. X        e_fp = fopen(e_tmpname,"w");
  79. X        }
  80. X        if (argv[1])
  81. X        fputs(argv[1],e_fp);
  82. X        putc('\n', e_fp);
  83. X        argc--,argv++;
  84. X        break;
  85. X    case 'i':
  86. X        inplace = savestr(argv[0]+2);
  87. X        argvoutstab = stabent("ARGVOUT",TRUE);
  88. X        break;
  89. X    case 'I':
  90. X        str_cat(str,argv[0]);
  91. X        str_cat(str," ");
  92. X        if (argv[0][2]) {
  93. X        apush(incstab->stab_array,str_make(argv[0]+2));
  94. X        }
  95. X        else {
  96. X        apush(incstab->stab_array,str_make(argv[1]));
  97. X        str_cat(str,argv[1]);
  98. X        argc--,argv++;
  99. X        str_cat(str," ");
  100. X        }
  101. X        break;
  102. X    case 'n':
  103. X        minus_n = TRUE;
  104. X        strcpy(argv[0], argv[0]+1);
  105. X        goto reswitch;
  106. X    case 'p':
  107. X        minus_p = TRUE;
  108. X        strcpy(argv[0], argv[0]+1);
  109. X        goto reswitch;
  110. X    case 'P':
  111. X        preprocess = TRUE;
  112. X        strcpy(argv[0], argv[0]+1);
  113. X        goto reswitch;
  114. X    case 's':
  115. X        doswitches = TRUE;
  116. X        strcpy(argv[0], argv[0]+1);
  117. X        goto reswitch;
  118. X    case 'S':
  119. X        dosearch = TRUE;
  120. X        strcpy(argv[0], argv[0]+1);
  121. X        goto reswitch;
  122. X    case 'U':
  123. X        unsafe = TRUE;
  124. X        strcpy(argv[0], argv[0]+1);
  125. X        goto reswitch;
  126. X    case 'v':
  127. X        version();
  128. X        exit(0);
  129. X    case 'w':
  130. X        dowarn = TRUE;
  131. X        strcpy(argv[0], argv[0]+1);
  132. X        goto reswitch;
  133. X    case '-':
  134. X        argc--,argv++;
  135. X        goto switch_end;
  136. X    case 0:
  137. X        break;
  138. X    default:
  139. X        fatal("Unrecognized switch: %s",argv[0]);
  140. X    }
  141. X    }
  142. X  switch_end:
  143. X    if (e_fp) {
  144. X    fclose(e_fp);
  145. X    argc++,argv--;
  146. X    argv[0] = e_tmpname;
  147. X    }
  148. X#ifndef PRIVLIB
  149. X#define PRIVLIB "/usr/local/lib/perl"
  150. X#endif
  151. X    apush(incstab->stab_array,str_make(PRIVLIB));
  152. X
  153. X    str_set(&str_no,No);
  154. X    str_set(&str_yes,Yes);
  155. X    init_eval();
  156. X
  157. X    /* open script */
  158. X
  159. X    if (argv[0] == Nullch)
  160. X    argv[0] = "-";
  161. X    if (dosearch && argv[0][0] != '/' && (s = getenv("PATH"))) {
  162. X    char *xfound = Nullch, *xfailed = Nullch;
  163. X
  164. X    while (*s) {
  165. X        s = cpytill(tokenbuf,s,':');
  166. X        if (*s)
  167. X        s++;
  168. X        if (tokenbuf[0])
  169. X        strcat(tokenbuf,"/");
  170. X        strcat(tokenbuf,argv[0]);
  171. X#ifdef DEBUGGING
  172. X        if (debug & 1)
  173. X        fprintf(stderr,"Looking for %s\n",tokenbuf);
  174. X#endif
  175. X        if (stat(tokenbuf,&statbuf) < 0)        /* not there? */
  176. X        continue;
  177. X        if ((statbuf.st_mode & S_IFMT) == S_IFREG
  178. X         && cando(S_IREAD,TRUE) && cando(S_IEXEC,TRUE)) {
  179. X        xfound = tokenbuf;              /* bingo! */
  180. X        break;
  181. X        }
  182. X        if (!xfailed)
  183. X        xfailed = savestr(tokenbuf);
  184. X    }
  185. X    if (!xfound)
  186. X        fatal("Can't execute %s", xfailed);
  187. X    if (xfailed)
  188. X        safefree(xfailed);
  189. X    argv[0] = savestr(xfound);
  190. X    }
  191. X    filename = savestr(argv[0]);
  192. X    origfilename = savestr(filename);
  193. X    if (strEQ(filename,"-"))
  194. X    argv[0] = "";
  195. X    if (preprocess) {
  196. X    str_cat(str,"-I");
  197. X    str_cat(str,PRIVLIB);
  198. X    sprintf(buf, "\
  199. X/bin/sed -e '/^[^#]/b' \
  200. X -e '/^#[     ]*include[     ]/b' \
  201. X -e '/^#[     ]*define[     ]/b' \
  202. X -e '/^#[     ]*if[     ]/b' \
  203. X -e '/^#[     ]*ifdef[     ]/b' \
  204. X -e '/^#[     ]*ifndef[     ]/b' \
  205. X -e '/^#[     ]*else/b' \
  206. X -e '/^#[     ]*endif/b' \
  207. X -e 's/^#.*//' \
  208. X %s | %s -C %s %s",
  209. X      argv[0], CPPSTDIN, str_get(str), CPPMINUS);
  210. X    rsfp = popen(buf,"r");
  211. X    }
  212. X    else if (!*argv[0])
  213. X    rsfp = stdin;
  214. X    else
  215. X    rsfp = fopen(argv[0],"r");
  216. X    if (rsfp == Nullfp)
  217. X    fatal("Perl script \"%s\" doesn't seem to exist",filename);
  218. X    str_free(str);        /* free -I directories */
  219. X
  220. X    defstab = stabent("_",TRUE);
  221. X
  222. X    /* init tokener */
  223. X
  224. X    bufptr = str_get(linestr);
  225. X
  226. X    /* now parse the report spec */
  227. X
  228. X    if (yyparse())
  229. X    fatal("Execution aborted due to compilation errors.\n");
  230. X
  231. X    if (dowarn) {
  232. X    stab_check('A','Z');
  233. X    stab_check('a','z');
  234. X    }
  235. X
  236. X    preprocess = FALSE;
  237. X    if (e_fp) {
  238. X    e_fp = Nullfp;
  239. X    UNLINK(e_tmpname);
  240. X    }
  241. X    argc--,argv++;    /* skip name of script */
  242. X    if (doswitches) {
  243. X    for (; argc > 0 && **argv == '-'; argc--,argv++) {
  244. X        if (argv[0][1] == '-') {
  245. X        argc--,argv++;
  246. X        break;
  247. X        }
  248. X        str_numset(stabent(argv[0]+1,TRUE)->stab_val,(double)1.0);
  249. X    }
  250. X    }
  251. X    if (argvstab = stabent("ARGV",allstabs)) {
  252. X    aadd(argvstab);
  253. X    for (; argc > 0; argc--,argv++) {
  254. X        apush(argvstab->stab_array,str_make(argv[0]));
  255. X    }
  256. X    }
  257. X    if (envstab = stabent("ENV",allstabs)) {
  258. X    hadd(envstab);
  259. X    for (; *env; env++) {
  260. X        if (!(s = index(*env,'=')))
  261. X        continue;
  262. X        *s++ = '\0';
  263. X        str = str_make(s);
  264. X        str->str_link.str_magic = envstab;
  265. X        hstore(envstab->stab_hash,*env,str);
  266. X        *--s = '=';
  267. X    }
  268. X    }
  269. X    if (sigstab = stabent("SIG",allstabs))
  270. X    hadd(sigstab);
  271. X
  272. X    magicalize("!#?^~=-%0123456789.+&*()<>,\\/[|");
  273. X
  274. X    sawampersand = (stabent("&",FALSE) != Nullstab);
  275. X    if (tmpstab = stabent("0",allstabs))
  276. X    str_set(STAB_STR(tmpstab),origfilename);
  277. X    if (tmpstab = stabent("$",allstabs))
  278. X    str_numset(STAB_STR(tmpstab),(double)getpid());
  279. X
  280. X    tmpstab = stabent("stdin",TRUE);
  281. X    tmpstab->stab_io = stio_new();
  282. X    tmpstab->stab_io->fp = stdin;
  283. X
  284. X    tmpstab = stabent("stdout",TRUE);
  285. X    tmpstab->stab_io = stio_new();
  286. X    tmpstab->stab_io->fp = stdout;
  287. X    defoutstab = tmpstab;
  288. X    curoutstab = tmpstab;
  289. X
  290. X    tmpstab = stabent("stderr",TRUE);
  291. X    tmpstab->stab_io = stio_new();
  292. X    tmpstab->stab_io->fp = stderr;
  293. X
  294. X    savestack = anew(Nullstab);        /* for saving non-local values */
  295. X
  296. X    setjmp(top_env);    /* sets goto_targ on longjump */
  297. X
  298. X#ifdef DEBUGGING
  299. X    if (debug & 1024)
  300. X    dump_cmd(main_root,Nullcmd);
  301. X    if (debug)
  302. X    fprintf(stderr,"\nEXECUTING...\n\n");
  303. X#endif
  304. X
  305. X    /* do it */
  306. X
  307. X    (void) cmd_exec(main_root);
  308. X
  309. X    if (goto_targ)
  310. X    fatal("Can't find label \"%s\"--aborting",goto_targ);
  311. X    exit(0);
  312. X    /* NOTREACHED */
  313. X}
  314. X
  315. Xmagicalize(list)
  316. Xregister char *list;
  317. X{
  318. X    register STAB *stab;
  319. X    char sym[2];
  320. X
  321. X    sym[1] = '\0';
  322. X    while (*sym = *list++) {
  323. X    if (stab = stabent(sym,allstabs)) {
  324. X        stab->stab_flags = SF_VMAGIC;
  325. X        stab->stab_val->str_link.str_magic = stab;
  326. X    }
  327. X    }
  328. X}
  329. X
  330. XARG *
  331. Xmake_split(stab,arg)
  332. Xregister STAB *stab;
  333. Xregister ARG *arg;
  334. X{
  335. X    register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT));
  336. X
  337. X    if (arg->arg_type != O_MATCH) {
  338. X    spat = (SPAT *) safemalloc(sizeof (SPAT));
  339. X    bzero((char *)spat, sizeof(SPAT));
  340. X    spat->spat_next = spat_root;    /* link into spat list */
  341. X    spat_root = spat;
  342. X
  343. X    spat->spat_runtime = arg;
  344. X    arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
  345. X    }
  346. X    arg->arg_type = O_SPLIT;
  347. X    spat = arg[2].arg_ptr.arg_spat;
  348. X    spat->spat_repl = stab2arg(A_STAB,aadd(stab));
  349. X    if (spat->spat_short) {    /* exact match can bypass regexec() */
  350. X    if (!((spat->spat_flags & SPAT_SCANFIRST) &&
  351. X        (spat->spat_flags & SPAT_ALL) )) {
  352. X        str_free(spat->spat_short);
  353. X        spat->spat_short = Nullstr;
  354. X    }
  355. X    }
  356. X    return arg;
  357. X}
  358. X
  359. XSUBR *
  360. Xmake_sub(name,cmd)
  361. Xchar *name;
  362. XCMD *cmd;
  363. X{
  364. X    register SUBR *sub = (SUBR *) safemalloc(sizeof (SUBR));
  365. X    STAB *stab = stabent(name,TRUE);
  366. X
  367. X    if (stab->stab_sub) {
  368. X    if (dowarn) {
  369. X        line_t oldline = line;
  370. X
  371. X        if (cmd)
  372. X        line = cmd->c_line;
  373. X        warn("Subroutine %s redefined",name);
  374. X        line = oldline;
  375. X    }
  376. X    cmd_free(stab->stab_sub->cmd);
  377. X    afree(stab->stab_sub->tosave);
  378. X    safefree((char*)stab->stab_sub);
  379. X    }
  380. X    bzero((char *)sub, sizeof(SUBR));
  381. X    sub->cmd = cmd;
  382. X    sub->filename = filename;
  383. X    tosave = anew(Nullstab);
  384. X    tosave->ary_fill = 0;    /* make 1 based */
  385. X    cmd_tosave(cmd);        /* this builds the tosave array */
  386. X    sub->tosave = tosave;
  387. X    stab->stab_sub = sub;
  388. X}
  389. X
  390. XCMD *
  391. Xblock_head(tail)
  392. Xregister CMD *tail;
  393. X{
  394. X    if (tail == Nullcmd) {
  395. X    return tail;
  396. X    }
  397. X    return tail->c_head;
  398. X}
  399. X
  400. XCMD *
  401. Xappend_line(head,tail)
  402. Xregister CMD *head;
  403. Xregister CMD *tail;
  404. X{
  405. X    if (tail == Nullcmd)
  406. X    return head;
  407. X    if (!tail->c_head)            /* make sure tail is well formed */
  408. X    tail->c_head = tail;
  409. X    if (head != Nullcmd) {
  410. X    tail = tail->c_head;        /* get to start of tail list */
  411. X    if (!head->c_head)
  412. X        head->c_head = head;    /* start a new head list */
  413. X    while (head->c_next) {
  414. X        head->c_next->c_head = head->c_head;
  415. X        head = head->c_next;    /* get to end of head list */
  416. X    }
  417. X    head->c_next = tail;        /* link to end of old list */
  418. X    tail->c_head = head->c_head;    /* propagate head pointer */
  419. X    }
  420. X    while (tail->c_next) {
  421. X    tail->c_next->c_head = tail->c_head;
  422. X    tail = tail->c_next;
  423. X    }
  424. X    return tail;
  425. X}
  426. X
  427. XCMD *
  428. Xmake_acmd(type,stab,cond,arg)
  429. Xint type;
  430. XSTAB *stab;
  431. XARG *cond;
  432. XARG *arg;
  433. X{
  434. X    register CMD *cmd = (CMD *) safemalloc(sizeof (CMD));
  435. X
  436. X    bzero((char *)cmd, sizeof(CMD));
  437. X    cmd->c_type = type;
  438. X    cmd->ucmd.acmd.ac_stab = stab;
  439. X    cmd->ucmd.acmd.ac_expr = arg;
  440. X    cmd->c_expr = cond;
  441. X    if (cond) {
  442. X    opt_arg(cmd,1,1);
  443. X    cmd->c_flags |= CF_COND;
  444. X    }
  445. X    if (cmdline != NOLINE) {
  446. X    cmd->c_line = cmdline;
  447. X    cmdline = NOLINE;
  448. X    }
  449. X    cmd->c_file = filename;
  450. X    return cmd;
  451. X}
  452. X
  453. XCMD *
  454. Xmake_ccmd(type,arg,cblock)
  455. Xint type;
  456. Xregister ARG *arg;
  457. Xstruct compcmd cblock;
  458. X{
  459. X    register CMD *cmd = (CMD *) safemalloc(sizeof (CMD));
  460. X
  461. X    bzero((char *)cmd, sizeof(CMD));
  462. X    cmd->c_type = type;
  463. X    cmd->c_expr = arg;
  464. X    cmd->ucmd.ccmd.cc_true = cblock.comp_true;
  465. X    cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
  466. X    if (arg) {
  467. X    opt_arg(cmd,1,0);
  468. X    cmd->c_flags |= CF_COND;
  469. X    }
  470. X    if (cmdline != NOLINE) {
  471. X    cmd->c_line = cmdline;
  472. X    cmdline = NOLINE;
  473. X    }
  474. X    return cmd;
  475. X}
  476. X
  477. Xvoid
  478. Xopt_arg(cmd,fliporflop,acmd)
  479. Xregister CMD *cmd;
  480. Xint fliporflop;
  481. Xint acmd;
  482. X{
  483. X    register ARG *arg;
  484. X    int opt = CFT_EVAL;
  485. X    int sure = 0;
  486. X    ARG *arg2;
  487. X    char *tmps;    /* for True macro */
  488. X    int context = 0;    /* 0 = normal, 1 = before &&, 2 = before || */
  489. X    int flp = fliporflop;
  490. X
  491. X    if (!cmd)
  492. X    return;
  493. X    arg = cmd->c_expr;
  494. X
  495. X    /* Can we turn && and || into if and unless? */
  496. X
  497. X    if (acmd && !cmd->ucmd.acmd.ac_expr && 
  498. X      (arg->arg_type == O_AND || arg->arg_type == O_OR) ) {
  499. X    dehoist(arg,1);
  500. X    dehoist(arg,2);
  501. X    cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg;
  502. X    cmd->c_expr = arg[1].arg_ptr.arg_arg;
  503. X    if (arg->arg_type == O_OR)
  504. X        cmd->c_flags ^= CF_INVERT;        /* || is like unless */
  505. X    arg->arg_len = 0;
  506. X    arg_free(arg);
  507. X    arg = cmd->c_expr;
  508. X    }
  509. X
  510. X    /* Turn "if (!expr)" into "unless (expr)" */
  511. X
  512. X    while (arg->arg_type == O_NOT) {
  513. X    dehoist(arg,1);
  514. X    cmd->c_flags ^= CF_INVERT;        /* flip sense of cmd */
  515. X    cmd->c_expr = arg[1].arg_ptr.arg_arg;    /* hoist the rest of expr */
  516. X    free_arg(arg);
  517. X    arg = cmd->c_expr;            /* here we go again */
  518. X    }
  519. X
  520. X    if (!arg->arg_len) {        /* sanity check */
  521. X    cmd->c_flags |= opt;
  522. X    return;
  523. X    }
  524. X
  525. X    /* for "cond .. cond" we set up for the initial check */
  526. X
  527. X    if (arg->arg_type == O_FLIP)
  528. X    context |= 4;
  529. X
  530. X    /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
  531. X
  532. X    if (arg->arg_type == O_AND)
  533. X    context |= 1;
  534. X    else if (arg->arg_type == O_OR)
  535. X    context |= 2;
  536. X    if (context && arg[flp].arg_type == A_EXPR) {
  537. X    arg = arg[flp].arg_ptr.arg_arg;
  538. X    flp = 1;
  539. X    }
  540. X
  541. X    if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
  542. X    cmd->c_flags |= opt;
  543. X    return;                /* side effect, can't optimize */
  544. X    }
  545. X
  546. X    if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
  547. X      arg->arg_type == O_AND || arg->arg_type == O_OR) {
  548. X    if (arg[flp].arg_type == A_SINGLE) {
  549. X        opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
  550. X        cmd->c_short = arg[flp].arg_ptr.arg_str;
  551. X        goto literal;
  552. X    }
  553. X    else if (arg[flp].arg_type == A_STAB || arg[flp].arg_type == A_LVAL) {
  554. X        cmd->c_stab  = arg[flp].arg_ptr.arg_stab;
  555. X        opt = CFT_REG;
  556. X      literal:
  557. X        if (!context) {    /* no && or ||? */
  558. X        free_arg(arg);
  559. X        cmd->c_expr = Nullarg;
  560. X        }
  561. X        if (!(context & 1))
  562. X        cmd->c_flags |= CF_EQSURE;
  563. X        if (!(context & 2))
  564. X        cmd->c_flags |= CF_NESURE;
  565. X    }
  566. X    }
  567. X    else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
  568. X         arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
  569. X    if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
  570. X        arg[2].arg_type == A_SPAT &&
  571. X        arg[2].arg_ptr.arg_spat->spat_short ) {
  572. X        cmd->c_stab  = arg[1].arg_ptr.arg_stab;
  573. X        cmd->c_short = arg[2].arg_ptr.arg_spat->spat_short;
  574. X        cmd->c_slen  = arg[2].arg_ptr.arg_spat->spat_slen;
  575. X        if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL &&
  576. X        !(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) &&
  577. X        (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
  578. X        sure |= CF_EQSURE;        /* (SUBST must be forced even */
  579. X                        /* if we know it will work.) */
  580. X        arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
  581. X        arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
  582. X        sure |= CF_NESURE;        /* normally only sure if it fails */
  583. X        if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
  584. X        cmd->c_flags |= CF_FIRSTNEG;
  585. X        if (context & 1) {        /* only sure if thing is false */
  586. X        if (cmd->c_flags & CF_FIRSTNEG)
  587. X            sure &= ~CF_NESURE;
  588. X        else
  589. X            sure &= ~CF_EQSURE;
  590. X        }
  591. X        else if (context & 2) {    /* only sure if thing is true */
  592. X        if (cmd->c_flags & CF_FIRSTNEG)
  593. X            sure &= ~CF_EQSURE;
  594. X        else
  595. X            sure &= ~CF_NESURE;
  596. X        }
  597. X        if (sure & (CF_EQSURE|CF_NESURE)) {    /* if we know anything*/
  598. X        if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
  599. X            opt = CFT_SCAN;
  600. X        else
  601. X            opt = CFT_ANCHOR;
  602. X        if (sure == (CF_EQSURE|CF_NESURE)    /* really sure? */
  603. X            && arg->arg_type == O_MATCH
  604. X            && context & 4
  605. X            && fliporflop == 1) {
  606. X            spat_free(arg[2].arg_ptr.arg_spat);
  607. X            arg[2].arg_ptr.arg_spat = Nullspat;    /* don't do twice */
  608. X        }
  609. X        cmd->c_flags |= sure;
  610. X        }
  611. X    }
  612. X    }
  613. X    else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
  614. X         arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
  615. X    if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
  616. X        if (arg[2].arg_type == A_SINGLE) {
  617. X        cmd->c_stab  = arg[1].arg_ptr.arg_stab;
  618. X        cmd->c_short = arg[2].arg_ptr.arg_str;
  619. X        cmd->c_slen  = 30000;
  620. X        switch (arg->arg_type) {
  621. X        case O_SLT: case O_SGT:
  622. X            sure |= CF_EQSURE;
  623. X            cmd->c_flags |= CF_FIRSTNEG;
  624. X            break;
  625. X        case O_SNE:
  626. X            cmd->c_flags |= CF_FIRSTNEG;
  627. X            /* FALL THROUGH */
  628. X        case O_SEQ:
  629. X            sure |= CF_NESURE|CF_EQSURE;
  630. X            break;
  631. X        }
  632. X        if (context & 1) {    /* only sure if thing is false */
  633. X            if (cmd->c_flags & CF_FIRSTNEG)
  634. X            sure &= ~CF_NESURE;
  635. X            else
  636. X            sure &= ~CF_EQSURE;
  637. X        }
  638. X        else if (context & 2) { /* only sure if thing is true */
  639. X            if (cmd->c_flags & CF_FIRSTNEG)
  640. X            sure &= ~CF_EQSURE;
  641. X            else
  642. X            sure &= ~CF_NESURE;
  643. X        }
  644. X        if (sure & (CF_EQSURE|CF_NESURE)) {
  645. X            opt = CFT_STROP;
  646. X            cmd->c_flags |= sure;
  647. X        }
  648. X        }
  649. X    }
  650. X    }
  651. X    else if (arg->arg_type == O_EQ || arg->arg_type == O_NE ||
  652. X         arg->arg_type == O_LE || arg->arg_type == O_GE ||
  653. X         arg->arg_type == O_LT || arg->arg_type == O_GT) {
  654. X    if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
  655. X        if (arg[2].arg_type == A_SINGLE) {
  656. X        cmd->c_stab  = arg[1].arg_ptr.arg_stab;
  657. X        cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str));
  658. X        cmd->c_slen = arg->arg_type;
  659. X        sure |= CF_NESURE|CF_EQSURE;
  660. X        if (context & 1) {    /* only sure if thing is false */
  661. X            sure &= ~CF_EQSURE;
  662. X        }
  663. X        else if (context & 2) { /* only sure if thing is true */
  664. X            sure &= ~CF_NESURE;
  665. X        }
  666. X        if (sure & (CF_EQSURE|CF_NESURE)) {
  667. X            opt = CFT_NUMOP;
  668. X            cmd->c_flags |= sure;
  669. X        }
  670. X        }
  671. X    }
  672. X    }
  673. X    else if (arg->arg_type == O_ASSIGN &&
  674. X         (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
  675. X         arg[1].arg_ptr.arg_stab == defstab &&
  676. X         arg[2].arg_type == A_EXPR ) {
  677. X    arg2 = arg[2].arg_ptr.arg_arg;
  678. X    if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
  679. X        opt = CFT_GETS;
  680. X        cmd->c_stab = arg2[1].arg_ptr.arg_stab;
  681. X        if (!(arg2[1].arg_ptr.arg_stab->stab_io->flags & IOF_ARGV)) {
  682. X        free_arg(arg2);
  683. X        free_arg(arg);
  684. X        cmd->c_expr = Nullarg;
  685. X        }
  686. X    }
  687. X    }
  688. X    else if (arg->arg_type == O_CHOP &&
  689. X         (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
  690. X    opt = CFT_CHOP;
  691. X    cmd->c_stab = arg[1].arg_ptr.arg_stab;
  692. X    free_arg(arg);
  693. X    cmd->c_expr = Nullarg;
  694. X    }
  695. X    if (context & 4)
  696. X    opt |= CF_FLIP;
  697. X    cmd->c_flags |= opt;
  698. X
  699. X    if (cmd->c_flags & CF_FLIP) {
  700. X    if (fliporflop == 1) {
  701. X        arg = cmd->c_expr;    /* get back to O_FLIP arg */
  702. X        arg[3].arg_ptr.arg_cmd = (CMD*)safemalloc(sizeof(CMD));
  703. X        bcopy((char *)cmd, (char *)arg[3].arg_ptr.arg_cmd, sizeof(CMD));
  704. X        arg[4].arg_ptr.arg_cmd = (CMD*)safemalloc(sizeof(CMD));
  705. X        bcopy((char *)cmd, (char *)arg[4].arg_ptr.arg_cmd, sizeof(CMD));
  706. X        opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd);
  707. X        arg->arg_len = 2;        /* this is a lie */
  708. X    }
  709. X    else {
  710. X        if ((opt & CF_OPTIMIZE) == CFT_EVAL)
  711. X        cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
  712. X    }
  713. X    }
  714. X}
  715. X
  716. XARG *
  717. Xmod_match(type,left,pat)
  718. Xregister ARG *left;
  719. Xregister ARG *pat;
  720. X{
  721. X
  722. X    register SPAT *spat;
  723. X    register ARG *newarg;
  724. X
  725. X    if ((pat->arg_type == O_MATCH ||
  726. X     pat->arg_type == O_SUBST ||
  727. X     pat->arg_type == O_TRANS ||
  728. X     pat->arg_type == O_SPLIT
  729. X    ) &&
  730. X    pat[1].arg_ptr.arg_stab == defstab ) {
  731. X    switch (pat->arg_type) {
  732. X    case O_MATCH:
  733. X        newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH,
  734. X        pat->arg_len,
  735. X        left,Nullarg,Nullarg,0);
  736. X        break;
  737. X    case O_SUBST:
  738. X        newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST,
  739. X        pat->arg_len,
  740. X        left,Nullarg,Nullarg,0));
  741. X        break;
  742. X    case O_TRANS:
  743. X        newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS,
  744. X        pat->arg_len,
  745. X        left,Nullarg,Nullarg,0));
  746. X        break;
  747. X    case O_SPLIT:
  748. X        newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT,
  749. X        pat->arg_len,
  750. X        left,Nullarg,Nullarg,0);
  751. X        break;
  752. X    }
  753. X    if (pat->arg_len >= 2) {
  754. X        newarg[2].arg_type = pat[2].arg_type;
  755. X        newarg[2].arg_ptr = pat[2].arg_ptr;
  756. X        newarg[2].arg_flags = pat[2].arg_flags;
  757. X        if (pat->arg_len >= 3) {
  758. X        newarg[3].arg_type = pat[3].arg_type;
  759. X        newarg[3].arg_ptr = pat[3].arg_ptr;
  760. X        newarg[3].arg_flags = pat[3].arg_flags;
  761. X        }
  762. X    }
  763. X    safefree((char*)pat);
  764. X    }
  765. X    else {
  766. X    spat = (SPAT *) safemalloc(sizeof (SPAT));
  767. X    bzero((char *)spat, sizeof(SPAT));
  768. X    spat->spat_next = spat_root;    /* link into spat list */
  769. X    spat_root = spat;
  770. X
  771. X    spat->spat_runtime = pat;
  772. X    newarg = make_op(type,2,left,Nullarg,Nullarg,0);
  773. X    newarg[2].arg_type = A_SPAT;
  774. X    newarg[2].arg_ptr.arg_spat = spat;
  775. X    newarg[2].arg_flags = AF_SPECIAL;
  776. X    }
  777. X
  778. X    return newarg;
  779. X}
  780. X
  781. XCMD *
  782. Xadd_label(lbl,cmd)
  783. Xchar *lbl;
  784. Xregister CMD *cmd;
  785. X{
  786. X    if (cmd)
  787. X    cmd->c_label = lbl;
  788. X    return cmd;
  789. X}
  790. X
  791. XCMD *
  792. Xaddcond(cmd, arg)
  793. Xregister CMD *cmd;
  794. Xregister ARG *arg;
  795. X{
  796. X    cmd->c_expr = arg;
  797. X    opt_arg(cmd,1,0);
  798. X    cmd->c_flags |= CF_COND;
  799. X    return cmd;
  800. X}
  801. X
  802. XCMD *
  803. Xaddloop(cmd, arg)
  804. Xregister CMD *cmd;
  805. Xregister ARG *arg;
  806. X{
  807. X    cmd->c_expr = arg;
  808. X    opt_arg(cmd,1,0);
  809. X    cmd->c_flags |= CF_COND|CF_LOOP;
  810. X    if (cmd->c_type == C_BLOCK)
  811. X    cmd->c_flags &= ~CF_COND;
  812. X    else {
  813. X    arg = cmd->ucmd.acmd.ac_expr;
  814. X    if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
  815. X        cmd->c_flags &= ~CF_COND;  /* "do {} while" happens at least once */
  816. X    if (arg && arg->arg_type == O_SUBR)
  817. X        cmd->c_flags &= ~CF_COND;  /* likewise for "do subr() while" */
  818. X    }
  819. X    return cmd;
  820. X}
  821. X
  822. XCMD *
  823. Xinvert(cmd)
  824. Xregister CMD *cmd;
  825. X{
  826. X    cmd->c_flags ^= CF_INVERT;
  827. X    return cmd;
  828. X}
  829. X
  830. Xyyerror(s)
  831. Xchar *s;
  832. X{
  833. X    char tmpbuf[128];
  834. X    char *tname = tmpbuf;
  835. X
  836. X    if (yychar > 256) {
  837. X    tname = tokename[yychar-256];
  838. X    if (strEQ(tname,"word"))
  839. X        strcpy(tname,tokenbuf);
  840. X    else if (strEQ(tname,"register"))
  841. X        sprintf(tname,"$%s",tokenbuf);
  842. X    else if (strEQ(tname,"array_length"))
  843. X        sprintf(tname,"$#%s",tokenbuf);
  844. X    }
  845. X    else if (!yychar)
  846. X    strcpy(tname,"EOF");
  847. X    else if (yychar < 32)
  848. X    sprintf(tname,"^%c",yychar+64);
  849. X    else if (yychar == 127)
  850. X    strcpy(tname,"^?");
  851. X    else
  852. X    sprintf(tname,"%c",yychar);
  853. X    sprintf(tokenbuf, "%s in file %s at line %d, next token \"%s\"\n",
  854. X      s,filename,line,tname);
  855. X    if (in_eval)
  856. X    str_set(stabent("@",TRUE)->stab_val,tokenbuf);
  857. X    else
  858. X    fputs(tokenbuf,stderr);
  859. X}
  860. X
  861. XARG *
  862. Xmake_op(type,newlen,arg1,arg2,arg3,dolist)
  863. Xint type;
  864. Xint newlen;
  865. XARG *arg1;
  866. XARG *arg2;
  867. XARG *arg3;
  868. Xint dolist;
  869. X{
  870. X    register ARG *arg;
  871. X    register ARG *chld;
  872. X    register int doarg;
  873. X
  874. X    arg = op_new(newlen);
  875. X    arg->arg_type = type;
  876. X    doarg = opargs[type];
  877. X    if (chld = arg1) {
  878. X    if (!(doarg & 1))
  879. X        arg[1].arg_flags |= AF_SPECIAL;
  880. X    if (doarg & 16)
  881. X        arg[1].arg_flags |= AF_NUMERIC;
  882. X    if (chld->arg_type == O_ITEM &&
  883. X        (hoistable[chld[1].arg_type] || chld[1].arg_type == A_LVAL) ) {
  884. X        arg[1].arg_type = chld[1].arg_type;
  885. X        arg[1].arg_ptr = chld[1].arg_ptr;
  886. X        arg[1].arg_flags |= chld[1].arg_flags;
  887. X        free_arg(chld);
  888. X    }
  889. X    else {
  890. X        arg[1].arg_type = A_EXPR;
  891. X        arg[1].arg_ptr.arg_arg = chld;
  892. X        if (dolist & 1) {
  893. X        if (chld->arg_type == O_LIST) {
  894. X            if (newlen == 1) {    /* we can hoist entire list */
  895. X            chld->arg_type = type;
  896. X            free_arg(arg);
  897. X            arg = chld;
  898. X            }
  899. X            else {
  900. X            arg[1].arg_flags |= AF_SPECIAL;
  901. X            }
  902. X        }
  903. X        else {
  904. X            switch (chld->arg_type) {
  905. X            case O_ARRAY:
  906. X            if (chld->arg_len == 1)
  907. X                arg[1].arg_flags |= AF_SPECIAL;
  908. X            break;
  909. X            case O_ITEM:
  910. X            if (chld[1].arg_type == A_READ ||
  911. X                chld[1].arg_type == A_INDREAD ||
  912. X                chld[1].arg_type == A_GLOB)
  913. X                arg[1].arg_flags |= AF_SPECIAL;
  914. X            break;
  915. X            case O_SPLIT:
  916. X            case O_TMS:
  917. X            case O_EACH:
  918. X            case O_VALUES:
  919. X            case O_KEYS:
  920. X            case O_SORT:
  921. X            arg[1].arg_flags |= AF_SPECIAL;
  922. X            break;
  923. X            }
  924. X        }
  925. X        }
  926. X    }
  927. X    }
  928. X    if (chld = arg2) {
  929. X    if (!(doarg & 2))
  930. X        arg[2].arg_flags |= AF_SPECIAL;
  931. X    if (doarg & 32)
  932. X        arg[2].arg_flags |= AF_NUMERIC;
  933. X    if (chld->arg_type == O_ITEM && 
  934. X        (hoistable[chld[1].arg_type] || 
  935. X         (type == O_ASSIGN && 
  936. X          ((chld[1].arg_type == A_READ && !(arg[1].arg_flags & AF_SPECIAL))
  937. X        ||
  938. X           (chld[1].arg_type == A_INDREAD && !(arg[1].arg_flags & AF_SPECIAL))
  939. X        ||
  940. X           (chld[1].arg_type == A_GLOB && !(arg[1].arg_flags & AF_SPECIAL))
  941. X        ||
  942. X           chld[1].arg_type == A_BACKTICK ) ) ) ) {
  943. X        arg[2].arg_type = chld[1].arg_type;
  944. X        arg[2].arg_ptr = chld[1].arg_ptr;
  945. X        free_arg(chld);
  946. X    }
  947. X    else {
  948. X        arg[2].arg_type = A_EXPR;
  949. X        arg[2].arg_ptr.arg_arg = chld;
  950. X        if ((dolist & 2) &&
  951. X          (chld->arg_type == O_LIST ||
  952. X           (chld->arg_type == O_ARRAY && chld->arg_len == 1) ))
  953. X        arg[2].arg_flags |= AF_SPECIAL;
  954. X    }
  955. X    }
  956. X    if (chld = arg3) {
  957. X    if (!(doarg & 4))
  958. X        arg[3].arg_flags |= AF_SPECIAL;
  959. X    if (doarg & 64)
  960. X        arg[3].arg_flags |= AF_NUMERIC;
  961. X    if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
  962. X        arg[3].arg_type = chld[1].arg_type;
  963. X        arg[3].arg_ptr = chld[1].arg_ptr;
  964. X        free_arg(chld);
  965. X    }
  966. X    else {
  967. X        arg[3].arg_type = A_EXPR;
  968. X        arg[3].arg_ptr.arg_arg = chld;
  969. X        if ((dolist & 4) &&
  970. X          (chld->arg_type == O_LIST ||
  971. X           (chld->arg_type == O_ARRAY && chld->arg_len == 1) ))
  972. X        arg[3].arg_flags |= AF_SPECIAL;
  973. X    }
  974. X    }
  975. X#ifdef DEBUGGING
  976. X    if (debug & 16) {
  977. X    fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
  978. X    if (arg1)
  979. X        fprintf(stderr,",%s=%lx",
  980. X        argname[arg[1].arg_type],arg[1].arg_ptr.arg_arg);
  981. X    if (arg2)
  982. X        fprintf(stderr,",%s=%lx",
  983. X        argname[arg[2].arg_type],arg[2].arg_ptr.arg_arg);
  984. X    if (arg3)
  985. X        fprintf(stderr,",%s=%lx",
  986. X        argname[arg[3].arg_type],arg[3].arg_ptr.arg_arg);
  987. X    fprintf(stderr,")\n");
  988. X    }
  989. X#endif
  990. X    evalstatic(arg);        /* see if we can consolidate anything */
  991. X    return arg;
  992. X}
  993. X
  994. X/* turn 123 into 123 == $. */
  995. X
  996. XARG *
  997. Xflipflip(arg)
  998. Xregister ARG *arg;
  999. X{
  1000. X    if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_SINGLE) {
  1001. X    arg = (ARG*)saferealloc((char*)arg,3*sizeof(ARG));
  1002. X    arg->arg_type = O_EQ;
  1003. X    arg->arg_len = 2;
  1004. X    arg[2].arg_type = A_STAB;
  1005. X    arg[2].arg_flags = 0;
  1006. X    arg[2].arg_ptr.arg_stab = stabent(".",TRUE);
  1007. X    }
  1008. X    return arg;
  1009. X}
  1010. X
  1011. Xvoid
  1012. Xevalstatic(arg)
  1013. Xregister ARG *arg;
  1014. X{
  1015. X    register STR *str;
  1016. X    register STR *s1;
  1017. X    register STR *s2;
  1018. X    double value;        /* must not be register */
  1019. X    register char *tmps;
  1020. X    int i;
  1021. X    unsigned long tmplong;
  1022. X    double exp(), log(), sqrt(), modf();
  1023. X    char *crypt();
  1024. X
  1025. X    if (!arg || !arg->arg_len)
  1026. X    return;
  1027. X
  1028. X    if (arg[1].arg_type == A_SINGLE &&
  1029. X        (arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) {
  1030. X    str = str_new(0);
  1031. X    s1 = arg[1].arg_ptr.arg_str;
  1032. X    if (arg->arg_len > 1)
  1033. X        s2 = arg[2].arg_ptr.arg_str;
  1034. X    else
  1035. X        s2 = Nullstr;
  1036. X    switch (arg->arg_type) {
  1037. X    default:
  1038. X        str_free(str);
  1039. X        str = Nullstr;        /* can't be evaluated yet */
  1040. X        break;
  1041. X    case O_CONCAT:
  1042. X        str_sset(str,s1);
  1043. X        str_scat(str,s2);
  1044. X        break;
  1045. X    case O_REPEAT:
  1046. X        i = (int)str_gnum(s2);
  1047. X        while (i-- > 0)
  1048. X        str_scat(str,s1);
  1049. X        break;
  1050. X    case O_MULTIPLY:
  1051. X        value = str_gnum(s1);
  1052. X        str_numset(str,value * str_gnum(s2));
  1053. X        break;
  1054. X    case O_DIVIDE:
  1055. X        value = str_gnum(s2);
  1056. X        if (value == 0.0)
  1057. X        fatal("Illegal division by constant zero");
  1058. X        str_numset(str,str_gnum(s1) / value);
  1059. X        break;
  1060. X    case O_MODULO:
  1061. X        tmplong = (unsigned long)str_gnum(s2);
  1062. X        if (tmplong == 0L)
  1063. X        fatal("Illegal modulus of constant zero");
  1064. X        str_numset(str,(double)(((unsigned long)str_gnum(s1)) % tmplong));
  1065. X        break;
  1066. X    case O_ADD:
  1067. X        value = str_gnum(s1);
  1068. X        str_numset(str,value + str_gnum(s2));
  1069. X        break;
  1070. X    case O_SUBTRACT:
  1071. X        value = str_gnum(s1);
  1072. X        str_numset(str,value - str_gnum(s2));
  1073. X        break;
  1074. X    case O_LEFT_SHIFT:
  1075. X        value = str_gnum(s1);
  1076. X        i = (int)str_gnum(s2);
  1077. X        str_numset(str,(double)(((unsigned long)value) << i));
  1078. X        break;
  1079. X    case O_RIGHT_SHIFT:
  1080. X        value = str_gnum(s1);
  1081. X        i = (int)str_gnum(s2);
  1082. X        str_numset(str,(double)(((unsigned long)value) >> i));
  1083. X        break;
  1084. X    case O_LT:
  1085. X        value = str_gnum(s1);
  1086. X        str_numset(str,(double)(value < str_gnum(s2)));
  1087. X        break;
  1088. X    case O_GT:
  1089. X        value = str_gnum(s1);
  1090. X        str_numset(str,(double)(value > str_gnum(s2)));
  1091. X        break;
  1092. X    case O_LE:
  1093. X        value = str_gnum(s1);
  1094. X        str_numset(str,(double)(value <= str_gnum(s2)));
  1095. X        break;
  1096. X    case O_GE:
  1097. X        value = str_gnum(s1);
  1098. X        str_numset(str,(double)(value >= str_gnum(s2)));
  1099. X        break;
  1100. X    case O_EQ:
  1101. X        value = str_gnum(s1);
  1102. X        str_numset(str,(double)(value == str_gnum(s2)));
  1103. X        break;
  1104. X    case O_NE:
  1105. X        value = str_gnum(s1);
  1106. X        str_numset(str,(double)(value != str_gnum(s2)));
  1107. X        break;
  1108. X    case O_BIT_AND:
  1109. X        value = str_gnum(s1);
  1110. X        str_numset(str,(double)(((unsigned long)value) &
  1111. X        ((unsigned long)str_gnum(s2))));
  1112. X        break;
  1113. X    case O_XOR:
  1114. X        value = str_gnum(s1);
  1115. X        str_numset(str,(double)(((unsigned long)value) ^
  1116. X        ((unsigned long)str_gnum(s2))));
  1117. X        break;
  1118. X    case O_BIT_OR:
  1119. X        value = str_gnum(s1);
  1120. X        str_numset(str,(double)(((unsigned long)value) |
  1121. X        ((unsigned long)str_gnum(s2))));
  1122. X        break;
  1123. X    case O_AND:
  1124. X        if (str_true(s1))
  1125. X        str = str_make(str_get(s2));
  1126. X        else
  1127. X        str = str_make(str_get(s1));
  1128. X        break;
  1129. X    case O_OR:
  1130. X        if (str_true(s1))
  1131. X        str = str_make(str_get(s1));
  1132. X        else
  1133. X        str = str_make(str_get(s2));
  1134. X        break;
  1135. X    case O_COND_EXPR:
  1136. X        if (arg[3].arg_type != A_SINGLE) {
  1137. X        str_free(str);
  1138. X        str = Nullstr;
  1139. X        }
  1140. X        else {
  1141. X        str = str_make(str_get(str_true(s1) ? s2 : arg[3].arg_ptr.arg_str));
  1142. X        str_free(arg[3].arg_ptr.arg_str);
  1143. X        }
  1144. X        break;
  1145. X    case O_NEGATE:
  1146. X        str_numset(str,(double)(-str_gnum(s1)));
  1147. X        break;
  1148. X    case O_NOT:
  1149. X        str_numset(str,(double)(!str_true(s1)));
  1150. X        break;
  1151. X    case O_COMPLEMENT:
  1152. X        str_numset(str,(double)(~(long)str_gnum(s1)));
  1153. X        break;
  1154. X    case O_LENGTH:
  1155. X        str_numset(str, (double)str_len(s1));
  1156. X        break;
  1157. X    case O_SUBSTR:
  1158. X        if (arg[3].arg_type != A_SINGLE || stabent("[",allstabs)) {
  1159. X        str_free(str);        /* making the fallacious assumption */
  1160. X        str = Nullstr;        /* that any $[ occurs before substr()*/
  1161. X        }
  1162. X        else {
  1163. X        char *beg;
  1164. X        int len = (int)str_gnum(s2);
  1165. X        int tmp;
  1166. X
  1167. X        for (beg = str_get(s1); *beg && len > 0; beg++,len--) ;
  1168. X        len = (int)str_gnum(arg[3].arg_ptr.arg_str);
  1169. X        str_free(arg[3].arg_ptr.arg_str);
  1170. X        if (len > (tmp = strlen(beg)))
  1171. X            len = tmp;
  1172. X        str_nset(str,beg,len);
  1173. X        }
  1174. X        break;
  1175. X    case O_SLT:
  1176. X        tmps = str_get(s1);
  1177. X        str_numset(str,(double)(strLT(tmps,str_get(s2))));
  1178. X        break;
  1179. X    case O_SGT:
  1180. X        tmps = str_get(s1);
  1181. X        str_numset(str,(double)(strGT(tmps,str_get(s2))));
  1182. X        break;
  1183. X    case O_SLE:
  1184. X        tmps = str_get(s1);
  1185. X        str_numset(str,(double)(strLE(tmps,str_get(s2))));
  1186. X        break;
  1187. X    case O_SGE:
  1188. X        tmps = str_get(s1);
  1189. X        str_numset(str,(double)(strGE(tmps,str_get(s2))));
  1190. X        break;
  1191. X    case O_SEQ:
  1192. X        tmps = str_get(s1);
  1193. X        str_numset(str,(double)(strEQ(tmps,str_get(s2))));
  1194. X        break;
  1195. X    case O_SNE:
  1196. X        tmps = str_get(s1);
  1197. X        str_numset(str,(double)(strNE(tmps,str_get(s2))));
  1198. X        break;
  1199. X    case O_CRYPT:
  1200. X#ifdef CRYPT
  1201. X        tmps = str_get(s1);
  1202. X        str_set(str,crypt(tmps,str_get(s2)));
  1203. X#else
  1204. X        fatal(
  1205. X        "The crypt() function is unimplemented due to excessive paranoia.");
  1206. X#endif
  1207. X        break;
  1208. X    case O_EXP:
  1209. X        str_numset(str,exp(str_gnum(s1)));
  1210. X        break;
  1211. X    case O_LOG:
  1212. X        str_numset(str,log(str_gnum(s1)));
  1213. X        break;
  1214. X    case O_SQRT:
  1215. X        str_numset(str,sqrt(str_gnum(s1)));
  1216. X        break;
  1217. X    case O_INT:
  1218. X        value = str_gnum(s1);
  1219. X        if (value >= 0.0)
  1220. X        modf(value,&value);
  1221. X        else {
  1222. X        modf(-value,&value);
  1223. X        value = -value;
  1224. X        }
  1225. X        str_numset(str,value);
  1226. X        break;
  1227. X    case O_ORD:
  1228. X        str_numset(str,(double)(*str_get(s1)));
  1229. X        break;
  1230. X    }
  1231. X    if (str) {
  1232. X        arg->arg_type = O_ITEM;    /* note arg1 type is already SINGLE */
  1233. X        str_free(s1);
  1234. X        str_free(s2);
  1235. X        arg[1].arg_ptr.arg_str = str;
  1236. X    }
  1237. X    }
  1238. X}
  1239. X
  1240. XARG *
  1241. Xl(arg)
  1242. Xregister ARG *arg;
  1243. X{
  1244. X    register int i;
  1245. X    register ARG *arg1;
  1246. X    ARG *tmparg;
  1247. X
  1248. X    arg->arg_flags |= AF_COMMON;    /* XXX should cross-match */
  1249. X                    /* this does unnecessary copying */
  1250. X
  1251. X    if (arg[1].arg_type == A_ARYLEN) {
  1252. X    arg[1].arg_type = A_LARYLEN;
  1253. X    return arg;
  1254. X    }
  1255. X
  1256. X    /* see if it's an array reference */
  1257. X
  1258. X    if (arg[1].arg_type == A_EXPR) {
  1259. X    arg1 = arg[1].arg_ptr.arg_arg;
  1260. X
  1261. X    if (arg1->arg_type == O_LIST && arg->arg_type != O_ITEM) {
  1262. X                        /* assign to list */
  1263. X        arg[1].arg_flags |= AF_SPECIAL;
  1264. X        dehoist(arg,2);
  1265. X        arg[2].arg_flags |= AF_SPECIAL;
  1266. X        for (i = arg1->arg_len; i >= 1; i--) {
  1267. X        switch (arg1[i].arg_type) {
  1268. X        case A_STAB: case A_LVAL:
  1269. X            arg1[i].arg_type = A_LVAL;
  1270. X            break;
  1271. X        case A_EXPR: case A_LEXPR:
  1272. X            arg1[i].arg_type = A_LEXPR;
  1273. X            if (arg1[i].arg_ptr.arg_arg->arg_type == O_ARRAY)
  1274. X            arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY;
  1275. X            else if (arg1[i].arg_ptr.arg_arg->arg_type == O_HASH)
  1276. X            arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH;
  1277. X            if (arg1[i].arg_ptr.arg_arg->arg_type == O_LARRAY)
  1278. X            break;
  1279. X            if (arg1[i].arg_ptr.arg_arg->arg_type == O_LHASH)
  1280. X            break;
  1281. X            /* FALL THROUGH */
  1282. X        default:
  1283. X            sprintf(tokenbuf,
  1284. X              "Illegal item (%s) as lvalue",argname[arg1[i].arg_type]);
  1285. X            yyerror(tokenbuf);
  1286. X        }
  1287. X        }
  1288. X    }
  1289. X    else if (arg1->arg_type == O_ARRAY) {
  1290. X        if (arg1->arg_len == 1 && arg->arg_type != O_ITEM) {
  1291. X                        /* assign to array */
  1292. X        arg[1].arg_flags |= AF_SPECIAL;
  1293. X        dehoist(arg,2);
  1294. X        arg[2].arg_flags |= AF_SPECIAL;
  1295. X        }
  1296. X        else
  1297. X        arg1->arg_type = O_LARRAY;    /* assign to array elem */
  1298. X    }
  1299. X    else if (arg1->arg_type == O_HASH)
  1300. X        arg1->arg_type = O_LHASH;
  1301. X    else if (arg1->arg_type != O_ASSIGN) {
  1302. X        sprintf(tokenbuf,
  1303. X          "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
  1304. X        yyerror(tokenbuf);
  1305. X    }
  1306. X    arg[1].arg_type = A_LEXPR;
  1307. X#ifdef DEBUGGING
  1308. X    if (debug & 16)
  1309. X        fprintf(stderr,"lval LEXPR\n");
  1310. X#endif
  1311. X    return arg;
  1312. X    }
  1313. X
  1314. X    /* not an array reference, should be a register name */
  1315. X
  1316. X    if (arg[1].arg_type != A_STAB && arg[1].arg_type != A_LVAL) {
  1317. X    sprintf(tokenbuf,
  1318. X      "Illegal item (%s) as lvalue",argname[arg[1].arg_type]);
  1319. X    yyerror(tokenbuf);
  1320. X    }
  1321. X    arg[1].arg_type = A_LVAL;
  1322. X#ifdef DEBUGGING
  1323. X    if (debug & 16)
  1324. X    fprintf(stderr,"lval LVAL\n");
  1325. X#endif
  1326. X    return arg;
  1327. X}
  1328. X
  1329. Xdehoist(arg,i)
  1330. XARG *arg;
  1331. X{
  1332. X    ARG *tmparg;
  1333. X
  1334. X    if (arg[i].arg_type != A_EXPR) {    /* dehoist */
  1335. X    tmparg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg,0);
  1336. X    tmparg[1] = arg[i];
  1337. X    arg[i].arg_ptr.arg_arg = tmparg;
  1338. X    arg[i].arg_type = A_EXPR;
  1339. X    }
  1340. X}
  1341. X
  1342. XARG *
  1343. Xaddflags(i,flags,arg)
  1344. Xregister ARG *arg;
  1345. X{
  1346. X    arg[i].arg_flags |= flags;
  1347. X    return arg;
  1348. X}
  1349. X
  1350. XARG *
  1351. Xhide_ary(arg)
  1352. XARG *arg;
  1353. X{
  1354. X    if (arg->arg_type == O_ARRAY)
  1355. X    return make_op(O_ITEM,1,arg,Nullarg,Nullarg,0);
  1356. X    return arg;
  1357. X}
  1358. X
  1359. XARG *
  1360. Xmake_list(arg)
  1361. Xregister ARG *arg;
  1362. X{
  1363. X    register int i;
  1364. X    register ARG *node;
  1365. X    register ARG *nxtnode;
  1366. X    register int j;
  1367. X    STR *tmpstr;
  1368. X
  1369. X    if (!arg) {
  1370. X    arg = op_new(0);
  1371. X    arg->arg_type = O_LIST;
  1372. X    }
  1373. X    if (arg->arg_type != O_COMMA) {
  1374. X    arg->arg_flags |= AF_LISTISH;    /* see listish() below */
  1375. X    return arg;
  1376. X    }
  1377. X    for (i = 2, node = arg; ; i++) {
  1378. X    if (node->arg_len < 2)
  1379. X        break;
  1380. X        if (node[2].arg_type != A_EXPR)
  1381. X        break;
  1382. X    node = node[2].arg_ptr.arg_arg;
  1383. X    if (node->arg_type != O_COMMA)
  1384. X        break;
  1385. X    }
  1386. X    if (i > 2) {
  1387. X    node = arg;
  1388. X    arg = op_new(i);
  1389. X    tmpstr = arg->arg_ptr.arg_str;
  1390. X    *arg = *node;        /* copy everything except the STR */
  1391. X    arg->arg_ptr.arg_str = tmpstr;
  1392. X    for (j = 1; ; ) {
  1393. X        arg[j] = node[1];
  1394. X        ++j;        /* Bug in Xenix compiler */
  1395. X        if (j >= i) {
  1396. X        arg[j] = node[2];
  1397. X        free_arg(node);
  1398. X        break;
  1399. X        }
  1400. X        nxtnode = node[2].arg_ptr.arg_arg;
  1401. X        free_arg(node);
  1402. X        node = nxtnode;
  1403. X    }
  1404. X    }
  1405. X    arg->arg_type = O_LIST;
  1406. X    arg->arg_len = i;
  1407. X    return arg;
  1408. X}
  1409. X
  1410. X/* turn a single item into a list */
  1411. X
  1412. XARG *
  1413. Xlistish(arg)
  1414. XARG *arg;
  1415. X{
  1416. X    if (arg->arg_flags & AF_LISTISH) {
  1417. X    arg = make_op(O_LIST,1,arg,Nullarg,Nullarg,0);
  1418. X    arg[1].arg_flags &= ~AF_SPECIAL;
  1419. X    }
  1420. X    return arg;
  1421. X}
  1422. X
  1423. X/* mark list of local variables */
  1424. X
  1425. XARG *
  1426. Xlocalize(arg)
  1427. XARG *arg;
  1428. X{
  1429. X    arg->arg_flags |= AF_LOCAL;
  1430. X    return arg;
  1431. X}
  1432. X
  1433. XARG *
  1434. Xstab2arg(atype,stab)
  1435. Xint atype;
  1436. Xregister STAB *stab;
  1437. X{
  1438. X    register ARG *arg;
  1439. X
  1440. X    arg = op_new(1);
  1441. X    arg->arg_type = O_ITEM;
  1442. X    arg[1].arg_type = atype;
  1443. X    arg[1].arg_ptr.arg_stab = stab;
  1444. X    return arg;
  1445. X}
  1446. X
  1447. XARG *
  1448. Xcval_to_arg(cval)
  1449. Xregister char *cval;
  1450. X{
  1451. X    register ARG *arg;
  1452. X
  1453. X    arg = op_new(1);
  1454. X    arg->arg_type = O_ITEM;
  1455. X    arg[1].arg_type = A_SINGLE;
  1456. X    arg[1].arg_ptr.arg_str = str_make(cval);
  1457. X    safefree(cval);
  1458. X    return arg;
  1459. X}
  1460. X
  1461. XARG *
  1462. Xop_new(numargs)
  1463. Xint numargs;
  1464. X{
  1465. X    register ARG *arg;
  1466. X
  1467. X    arg = (ARG*)safemalloc((numargs + 1) * sizeof (ARG));
  1468. X    bzero((char *)arg, (numargs + 1) * sizeof (ARG));
  1469. X    arg->arg_ptr.arg_str = str_new(0);
  1470. X    arg->arg_len = numargs;
  1471. X    return arg;
  1472. X}
  1473. X
  1474. Xvoid
  1475. Xfree_arg(arg)
  1476. XARG *arg;
  1477. X{
  1478. X    str_free(arg->arg_ptr.arg_str);
  1479. X    safefree((char*)arg);
  1480. X}
  1481. X
  1482. XARG *
  1483. Xmake_match(type,expr,spat)
  1484. Xint type;
  1485. XARG *expr;
  1486. XSPAT *spat;
  1487. X{
  1488. X    register ARG *arg;
  1489. X
  1490. X    arg = make_op(type,2,expr,Nullarg,Nullarg,0);
  1491. X
  1492. X    arg[2].arg_type = A_SPAT;
  1493. X    arg[2].arg_ptr.arg_spat = spat;
  1494. X#ifdef DEBUGGING
  1495. X    if (debug & 16)
  1496. X    fprintf(stderr,"make_match SPAT=%lx\n",(long)spat);
  1497. X#endif
  1498. X
  1499. X    if (type == O_SUBST || type == O_NSUBST) {
  1500. X    if (arg[1].arg_type != A_STAB)
  1501. X        yyerror("Illegal lvalue");
  1502. X    arg[1].arg_type = A_LVAL;
  1503. X    }
  1504. X    return arg;
  1505. X}
  1506. X
  1507. XARG *
  1508. Xcmd_to_arg(cmd)
  1509. XCMD *cmd;
  1510. X{
  1511. X    register ARG *arg;
  1512. X
  1513. X    arg = op_new(1);
  1514. X    arg->arg_type = O_ITEM;
  1515. X    arg[1].arg_type = A_CMD;
  1516. X    arg[1].arg_ptr.arg_cmd = cmd;
  1517. X    return arg;
  1518. X}
  1519. X
  1520. XCMD *
  1521. Xwopt(cmd)
  1522. Xregister CMD *cmd;
  1523. X{
  1524. X    register CMD *tail;
  1525. X    register ARG *arg = cmd->c_expr;
  1526. X    STAB *asgnstab;
  1527. X
  1528. X    /* hoist "while (<channel>)" up into command block */
  1529. X
  1530. X    if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
  1531. X    cmd->c_flags &= ~CF_OPTIMIZE;    /* clear optimization type */
  1532. X    cmd->c_flags |= CFT_GETS;    /* and set it to do the input */
  1533. X    cmd->c_stab = arg[1].arg_ptr.arg_stab;
  1534. X    if (arg[1].arg_ptr.arg_stab->stab_io->flags & IOF_ARGV) {
  1535. X        cmd->c_expr = l(make_op(O_ASSIGN, 2,    /* fake up "$_ =" */
  1536. X           stab2arg(A_LVAL,defstab), arg, Nullarg,1 ));
  1537. X    }
  1538. X    else {
  1539. X        free_arg(arg);
  1540. X        cmd->c_expr = Nullarg;
  1541. X    }
  1542. X    }
  1543. X    else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) {
  1544. X    cmd->c_flags &= ~CF_OPTIMIZE;    /* clear optimization type */
  1545. X    cmd->c_flags |= CFT_INDGETS;    /* and set it to do the input */
  1546. X    cmd->c_stab = arg[1].arg_ptr.arg_stab;
  1547. X    free_arg(arg);
  1548. X    cmd->c_expr = Nullarg;
  1549. X    }
  1550. X    else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) {
  1551. X    if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY)
  1552. X        asgnstab = cmd->c_stab;
  1553. X    else
  1554. X        asgnstab = defstab;
  1555. X    cmd->c_expr = l(make_op(O_ASSIGN, 2,    /* fake up "$foo =" */
  1556. X       stab2arg(A_LVAL,asgnstab), arg, Nullarg,1 ));
  1557. X    cmd->c_flags &= ~CF_OPTIMIZE;    /* clear optimization type */
  1558. X    }
  1559. X
  1560. X    /* First find the end of the true list */
  1561. X
  1562. X    if (cmd->ucmd.ccmd.cc_true == Nullcmd)
  1563. X    return cmd;
  1564. X    for (tail = cmd->ucmd.ccmd.cc_true; tail->c_next; tail = tail->c_next) ;
  1565. X
  1566. X    /* if there's a continue block, link it to true block and find end */
  1567. X
  1568. X    if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
  1569. X    tail->c_next = cmd->ucmd.ccmd.cc_alt;
  1570. X    for ( ; tail->c_next; tail = tail->c_next) ;
  1571. X    }
  1572. X
  1573. X    /* Here's the real trick: link the end of the list back to the beginning,
  1574. X     * inserting a "last" block to break out of the loop.  This saves one or
  1575. X     * two procedure calls every time through the loop, because of how cmd_exec
  1576. X     * does tail recursion.
  1577. X     */
  1578. X
  1579. X    tail->c_next = (CMD *) safemalloc(sizeof (CMD));
  1580. X    tail = tail->c_next;
  1581. X    if (!cmd->ucmd.ccmd.cc_alt)
  1582. X    cmd->ucmd.ccmd.cc_alt = tail;    /* every loop has a continue now */
  1583. X
  1584. X    bcopy((char *)cmd, (char *)tail, sizeof(CMD));
  1585. X    tail->c_type = C_EXPR;
  1586. X    tail->c_flags ^= CF_INVERT;        /* turn into "last unless" */
  1587. X    tail->c_next = tail->ucmd.ccmd.cc_true;    /* loop directly back to top */
  1588. X    tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg,0);
  1589. X    tail->ucmd.acmd.ac_stab = Nullstab;
  1590. X    return cmd;
  1591. X}
  1592. X
  1593. XCMD *
  1594. Xover(eachstab,cmd)
  1595. XSTAB *eachstab;
  1596. Xregister CMD *cmd;
  1597. X{
  1598. X    /* hoist "for $foo (@bar)" up into command block */
  1599. X
  1600. X    cmd->c_flags &= ~CF_OPTIMIZE;    /* clear optimization type */
  1601. X    cmd->c_flags |= CFT_ARRAY;        /* and set it to do the iteration */
  1602. X    cmd->c_stab = eachstab;
  1603. X
  1604. X    return cmd;
  1605. X}
  1606. X
  1607. Xstatic int gensym = 0;
  1608. X
  1609. XSTAB *
  1610. Xgenstab()
  1611. X{
  1612. X    sprintf(tokenbuf,"_GEN_%d",gensym++);
  1613. X    return stabent(tokenbuf,TRUE);
  1614. X}
  1615. X
  1616. X/* this routine is in perly.c by virtue of being sort of an alternate main() */
  1617. X
  1618. XSTR *
  1619. Xdo_eval(str,optype)
  1620. XSTR *str;
  1621. Xint optype;
  1622. X{
  1623. X    int retval;
  1624. X    CMD *myroot;
  1625. X    ARRAY *ar;
  1626. X    int i;
  1627. X    char *oldfile = filename;
  1628. X    line_t oldline = line;
  1629. X    int oldtmps_base = tmps_base;
  1630. X    int oldsave = savestack->ary_fill;
  1631. X
  1632. X    tmps_base = tmps_max;
  1633. X    str_set(stabent("@",TRUE)->stab_val,"");
  1634. X    if (optype != O_DOFILE) {    /* normal eval */
  1635. X    filename = "(eval)";
  1636. X    line = 1;
  1637. X    str_sset(linestr,str);
  1638. X    }
  1639. X    else {
  1640. X    filename = savestr(str_get(str));    /* can't free this easily */
  1641. X    str_set(linestr,"");
  1642. X    rsfp = fopen(filename,"r");
  1643. X    ar = incstab->stab_array;
  1644. X    if (!rsfp && *filename != '/') {
  1645. X        for (i = 0; i <= ar->ary_fill; i++) {
  1646. X        sprintf(tokenbuf,"%s/%s",str_get(afetch(ar,i)),filename);
  1647. X        rsfp = fopen(tokenbuf,"r");
  1648. X        if (rsfp) {
  1649. X            free(filename);
  1650. X            filename = savestr(tokenbuf);
  1651. X            break;
  1652. X        }
  1653. X        }
  1654. X    }
  1655. X    if (!rsfp) {
  1656. X        filename = oldfile;
  1657. X        tmps_base = oldtmps_base;
  1658. X        return &str_no;
  1659. X    }
  1660. X    line = 0;
  1661. X    }
  1662. X    in_eval++;
  1663. X    bufptr = str_get(linestr);
  1664. X    if (setjmp(eval_env))
  1665. X    retval = 1;
  1666. X    else
  1667. X    retval = yyparse();
  1668. X    myroot = eval_root;        /* in case cmd_exec does another eval! */
  1669. X    if (retval)
  1670. X    str = &str_no;
  1671. X    else {
  1672. X    str = str_static(cmd_exec(eval_root));
  1673. X                /* if we don't save str, free zaps it */
  1674. X    cmd_free(myroot);    /* can't free on error, for some reason */
  1675. X    }
  1676. X    in_eval--;
  1677. X    filename = oldfile;
  1678. X    line = oldline;
  1679. X    tmps_base = oldtmps_base;
  1680. X    if (savestack->ary_fill > oldsave)    /* let them use local() */
  1681. X    restorelist(oldsave);
  1682. X    return str;
  1683. X}
  1684. X
  1685. Xcmd_free(cmd)
  1686. Xregister CMD *cmd;
  1687. X{
  1688. X    register CMD *tofree;
  1689. X    register CMD *head = cmd;
  1690. X
  1691. X    while (cmd) {
  1692. X    if (cmd->c_type != C_WHILE) {    /* WHILE block is duplicated */
  1693. X        if (cmd->c_label)
  1694. X        safefree(cmd->c_label);
  1695. X        if (cmd->c_short)
  1696. X        str_free(cmd->c_short);
  1697. X        if (cmd->c_spat)
  1698. X        spat_free(cmd->c_spat);
  1699. X        if (cmd->c_expr)
  1700. X        arg_free(cmd->c_expr);
  1701. X    }
  1702. X    switch (cmd->c_type) {
  1703. X    case C_WHILE:
  1704. X    case C_BLOCK:
  1705. X    case C_IF:
  1706. X        if (cmd->ucmd.ccmd.cc_true)
  1707. X        cmd_free(cmd->ucmd.ccmd.cc_true);
  1708. X        if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt)
  1709. X        cmd_free(cmd->ucmd.ccmd.cc_alt);
  1710. X        break;
  1711. X    case C_EXPR:
  1712. X        if (cmd->ucmd.acmd.ac_expr)
  1713. X        arg_free(cmd->ucmd.acmd.ac_expr);
  1714. X        break;
  1715. X    }
  1716. X    tofree = cmd;
  1717. X    cmd = cmd->c_next;
  1718. X    safefree((char*)tofree);
  1719. X    if (cmd && cmd == head)        /* reached end of while loop */
  1720. X        break;
  1721. X    }
  1722. X}
  1723. X
  1724. Xarg_free(arg)
  1725. Xregister ARG *arg;
  1726. X{
  1727. X    register int i;
  1728. X
  1729. X    for (i = 1; i <= arg->arg_len; i++) {
  1730. X    switch (arg[i].arg_type) {
  1731. X    case A_NULL:
  1732. X        break;
  1733. X    case A_LEXPR:
  1734. X    case A_EXPR:
  1735. X        arg_free(arg[i].arg_ptr.arg_arg);
  1736. X        break;
  1737. X    case A_CMD:
  1738. X        cmd_free(arg[i].arg_ptr.arg_cmd);
  1739. X        break;
  1740. X    case A_WORD:
  1741. X    case A_STAB:
  1742. X    case A_LVAL:
  1743. X    case A_READ:
  1744. X    case A_GLOB:
  1745. X    case A_ARYLEN:
  1746. X        break;
  1747. X    case A_SINGLE:
  1748. X    case A_DOUBLE:
  1749. X    case A_BACKTICK:
  1750. X        str_free(arg[i].arg_ptr.arg_str);
  1751. X        break;
  1752. X    case A_SPAT:
  1753. X        spat_free(arg[i].arg_ptr.arg_spat);
  1754. X        break;
  1755. X    case A_NUMBER:
  1756. X        break;
  1757. X    }
  1758. X    }
  1759. X    free_arg(arg);
  1760. X}
  1761. X
  1762. Xspat_free(spat)
  1763. Xregister SPAT *spat;
  1764. X{
  1765. X    register SPAT *sp;
  1766. X
  1767. X    if (spat->spat_runtime)
  1768. X    arg_free(spat->spat_runtime);
  1769. X    if (spat->spat_repl) {
  1770. X    arg_free(spat->spat_repl);
  1771. X    }
  1772. X    if (spat->spat_short) {
  1773. X    str_free(spat->spat_short);
  1774. X    }
  1775. X    if (spat->spat_regexp) {
  1776. X    regfree(spat->spat_regexp);
  1777. X    }
  1778. X
  1779. X    /* now unlink from spat list */
  1780. X    if (spat_root == spat)
  1781. X    spat_root = spat->spat_next;
  1782. X    else {
  1783. X    for (sp = spat_root; sp->spat_next != spat; sp = sp->spat_next) ;
  1784. X    sp->spat_next = spat->spat_next;
  1785. X    }
  1786. X
  1787. X    safefree((char*)spat);
  1788. X}
  1789. X
  1790. X/* Recursively descend a command sequence and push the address of any string
  1791. X * that needs saving on recursion onto the tosave array.
  1792. X */
  1793. X
  1794. Xstatic int
  1795. Xcmd_tosave(cmd)
  1796. Xregister CMD *cmd;
  1797. X{
  1798. X    register CMD *head = cmd;
  1799. X
  1800. X    while (cmd) {
  1801. X    if (cmd->c_spat)
  1802. X        spat_tosave(cmd->c_spat);
  1803. X    if (cmd->c_expr)
  1804. X        arg_tosave(cmd->c_expr);
  1805. X    switch (cmd->c_type) {
  1806. X    case C_WHILE:
  1807. X    case C_BLOCK:
  1808. X    case C_IF:
  1809. X        if (cmd->ucmd.ccmd.cc_true)
  1810. X        cmd_tosave(cmd->ucmd.ccmd.cc_true);
  1811. X        if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt)
  1812. X        cmd_tosave(cmd->ucmd.ccmd.cc_alt);
  1813. X        break;
  1814. X    case C_EXPR:
  1815. X        if (cmd->ucmd.acmd.ac_expr)
  1816. X        arg_tosave(cmd->ucmd.acmd.ac_expr);
  1817. X        break;
  1818. X    }
  1819. X    cmd = cmd->c_next;
  1820. X    if (cmd && cmd == head)        /* reached end of while loop */
  1821. X        break;
  1822. X    }
  1823. X}
  1824. X
  1825. Xstatic int
  1826. Xarg_tosave(arg)
  1827. Xregister ARG *arg;
  1828. X{
  1829. X    register int i;
  1830. X    int saving = FALSE;
  1831. X
  1832. X    for (i = 1; i <= arg->arg_len; i++) {
  1833. X    switch (arg[i].arg_type) {
  1834. X    case A_NULL:
  1835. X        break;
  1836. X    case A_LEXPR:
  1837. X    case A_EXPR:
  1838. X        saving |= arg_tosave(arg[i].arg_ptr.arg_arg);
  1839. X        break;
  1840. X    case A_CMD:
  1841. X        cmd_tosave(arg[i].arg_ptr.arg_cmd);
  1842. X        saving = TRUE;    /* assume hanky panky */
  1843. X        break;
  1844. X    case A_WORD:
  1845. X    case A_STAB:
  1846. X    case A_LVAL:
  1847. X    case A_READ:
  1848. X    case A_GLOB:
  1849. X    case A_ARYLEN:
  1850. X    case A_SINGLE:
  1851. X    case A_DOUBLE:
  1852. X    case A_BACKTICK:
  1853. X        break;
  1854. X    case A_SPAT:
  1855. X        saving |= spat_tosave(arg[i].arg_ptr.arg_spat);
  1856. X        break;
  1857. X    case A_NUMBER:
  1858. X        break;
  1859. X    }
  1860. X    }
  1861. X    switch (arg->arg_type) {
  1862. X    case O_EVAL:
  1863. X    case O_SUBR:
  1864. X    saving = TRUE;
  1865. X    }
  1866. X    if (saving)
  1867. X    apush(tosave,arg->arg_ptr.arg_str);
  1868. X    return saving;
  1869. X}
  1870. X
  1871. Xstatic int
  1872. Xspat_tosave(spat)
  1873. Xregister SPAT *spat;
  1874. X{
  1875. X    int saving = FALSE;
  1876. X
  1877. X    if (spat->spat_runtime)
  1878. X    saving |= arg_tosave(spat->spat_runtime);
  1879. X    if (spat->spat_repl) {
  1880. X    saving |= arg_tosave(spat->spat_repl);
  1881. X    }
  1882. X
  1883. X    return saving;
  1884. X}
  1885. !STUFFY!FUNK!
  1886. echo Extracting x2p/Makefile.SH
  1887. sed >x2p/Makefile.SH <<'!STUFFY!FUNK!' -e 's/X//'
  1888. Xcase $CONFIG in
  1889. X'')
  1890. X    if test ! -f config.sh; then
  1891. X    ln ../config.sh . || \
  1892. X    ln ../../config.sh . || \
  1893. X    ln ../../../config.sh . || \
  1894. X    (echo "Can't find config.sh."; exit 1)
  1895. X    fi
  1896. X    . ./config.sh
  1897. X    ;;
  1898. Xesac
  1899. Xcase "$0" in
  1900. X*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
  1901. Xesac
  1902. Xcase "$mallocsrc" in
  1903. X'') ;;
  1904. X*) mallocsrc="../$mallocsrc";;
  1905. Xesac
  1906. Xecho "Extracting x2p/Makefile (with variable substitutions)"
  1907. Xcat >Makefile <<!GROK!THIS!
  1908. X# $Header: Makefile.SH,v 2.0 88/06/05 00:15:31 root Exp $
  1909. X#
  1910. X# $Log:    Makefile.SH,v $
  1911. X# Revision 2.0  88/06/05  00:15:31  root
  1912. X# Baseline version 2.0.
  1913. X# 
  1914. X# 
  1915. X
  1916. XCC = $cc
  1917. Xbin = $bin
  1918. Xlib = $lib
  1919. Xmansrc = $mansrc
  1920. Xmanext = $manext
  1921. XCFLAGS = $ccflags -O
  1922. XLDFLAGS = $ldflags
  1923. XSMALL = $small
  1924. XLARGE = $large $split
  1925. Xmallocsrc = $mallocsrc
  1926. Xmallocobj = $mallocobj
  1927. X
  1928. Xlibs = $libnm -lm
  1929. X!GROK!THIS!
  1930. X
  1931. Xcat >>Makefile <<'!NO!SUBS!'
  1932. X
  1933. Xpublic = a2p s2p
  1934. X
  1935. Xprivate = 
  1936. X
  1937. Xmanpages = a2p.man s2p.man
  1938. X
  1939. Xutil =
  1940. X
  1941. Xsh = Makefile.SH makedepend.SH
  1942. X
  1943. Xh = EXTERN.h INTERN.h config.h handy.h hash.h a2p.h str.h util.h
  1944. X
  1945. Xc = hash.c $(mallocsrc) str.c util.c walk.c
  1946. X
  1947. Xobj = hash.o $(mallocobj) str.o util.o walk.o
  1948. X
  1949. Xlintflags = -phbvxac
  1950. X
  1951. Xaddedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7
  1952. X
  1953. X# grrr
  1954. XSHELL = /bin/sh
  1955. X
  1956. X.c.o:
  1957. X    $(CC) -c $(CFLAGS) $(LARGE) $*.c
  1958. X
  1959. Xall: $(public) $(private) $(util)
  1960. X    touch all
  1961. X
  1962. Xa2p: $(obj) a2p.o
  1963. X    $(CC) $(LDFLAGS) $(LARGE) $(obj) a2p.o $(libs) -o a2p
  1964. X
  1965. Xa2p.c: a2p.y
  1966. X    @ echo Expect 103 shift/reduce errors...
  1967. X    yacc a2p.y
  1968. X    mv y.tab.c a2p.c
  1969. X
  1970. Xa2p.o: a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h handy.h ../config.h
  1971. X    $(CC) -c $(CFLAGS) $(LARGE) a2p.c
  1972. X
  1973. X# if a .h file depends on another .h file...
  1974. X$(h):
  1975. X    touch $@
  1976. Xinstall: a2p s2p
  1977. X# won't work with csh
  1978. X    export PATH || exit 1
  1979. X    - mv $(bin)/a2p $(bin)/a2p.old 2>/dev/null
  1980. X    - mv $(bin)/s2p $(bin)/s2p.old
  1981. X    - if test `pwd` != $(bin); then cp $(public) $(bin); fi
  1982. X    cd $(bin); \
  1983. Xfor pub in $(public); do \
  1984. Xchmod +x `basename $$pub`; \
  1985. Xdone
  1986. X#    chmod +x makedir
  1987. X#    - ./makedir `filexp $(lib)`
  1988. X#    - \
  1989. X#if test `pwd` != `filexp $(lib)`; then \
  1990. X#cp $(private) `filexp $(lib)`; \
  1991. X#fi
  1992. X#    cd `filexp $(lib)`; \
  1993. X#for priv in $(private); do \
  1994. X#chmod +x `basename $$priv`; \
  1995. X#done
  1996. X    - if test `pwd` != $(mansrc); then \
  1997. Xfor page in $(manpages); do \
  1998. Xcp $$page $(mansrc)/`basename $$page .man`.$(manext); \
  1999. Xdone; \
  2000. Xfi
  2001. X
  2002. Xclean:
  2003. X    rm -f *.o
  2004. X
  2005. Xrealclean:
  2006. X    rm -f a2p *.orig */*.orig *.o core $(addedbyconf)
  2007. X
  2008. X# The following lint has practically everything turned on.  Unfortunately,
  2009. X# you have to wade through a lot of mumbo jumbo that can't be suppressed.
  2010. X# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message
  2011. X# for that spot.
  2012. X
  2013. Xlint:
  2014. X    lint $(lintflags) $(defs) $(c) > a2p.fuzz
  2015. X
  2016. Xdepend: ../makedepend
  2017. X    ../makedepend
  2018. X
  2019. Xclist:
  2020. X    echo $(c) | tr ' ' '\012' >.clist
  2021. X
  2022. Xhlist:
  2023. X    echo $(h) | tr ' ' '\012' >.hlist
  2024. X
  2025. Xshlist:
  2026. X    echo $(sh) | tr ' ' '\012' >.shlist
  2027. X
  2028. X# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
  2029. X$(obj):
  2030. X    @ echo "You haven't done a "'"make depend" yet!'; exit 1
  2031. Xmakedepend: makedepend.SH
  2032. X    /bin/sh makedepend.SH
  2033. X!NO!SUBS!
  2034. X$eunicefix Makefile
  2035. Xcase `pwd` in
  2036. X*SH)
  2037. X    $rm -f ../Makefile
  2038. X    ln Makefile ../Makefile
  2039. X    ;;
  2040. Xesac
  2041. !STUFFY!FUNK!
  2042. echo Extracting Wishlist
  2043. sed >Wishlist <<'!STUFFY!FUNK!' -e 's/X//'
  2044. Xdate support
  2045. Xcase statement
  2046. Xioctl() support
  2047. Xrandom numbers
  2048. !STUFFY!FUNK!
  2049. echo ""
  2050. echo "End of kit 4 (of 15)"
  2051. cat /dev/null >kit4isdone
  2052. run=''
  2053. config=''
  2054. for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15; do
  2055.     if test -f kit${iskit}isdone; then
  2056.     run="$run $iskit"
  2057.     else
  2058.     todo="$todo $iskit"
  2059.     fi
  2060. done
  2061. case $todo in
  2062.     '')
  2063.     echo "You have run all your kits.  Please read README and then type Configure."
  2064.     chmod 755 Configure
  2065.     ;;
  2066.     *)  echo "You have run$run."
  2067.     echo "You still need to run$todo."
  2068.     ;;
  2069. esac
  2070. : Someone might mail this, so...
  2071. exit
  2072.  
  2073.