home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume18 / perl / part19 < prev    next >
Encoding:
Internet Message Format  |  1991-04-16  |  49.7 KB
  1. From: lwall@netlabs.com (Larry Wall)
  2. Newsgroups: comp.sources.misc
  3. Subject: v18i037:  perl - The perl programming language, Part19/36
  4. Message-ID: <1991Apr16.185514.1045@sparky.IMD.Sterling.COM>
  5. Date: 16 Apr 91 18:55:14 GMT
  6. Approved: kent@sparky.imd.sterling.com
  7. X-Checksum-Snefru: f1b12bd1 75a613fa 0db685e6 a921a7ac
  8.  
  9. Submitted-by: Larry Wall <lwall@netlabs.com>
  10. Posting-number: Volume 18, Issue 37
  11. Archive-name: perl/part19
  12.  
  13. [There are 36 kits for perl version 4.0.]
  14.  
  15. #! /bin/sh
  16.  
  17. # Make a new directory for the perl sources, cd to it, and run kits 1
  18. # thru 36 through sh.  When all 36 kits have been run, read README.
  19.  
  20. echo "This is perl 4.0 kit 19 (of 36).  If kit 19 is complete, the line"
  21. echo '"'"End of kit 19 (of 36)"'" will echo at the end.'
  22. echo ""
  23. export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
  24. mkdir  2>/dev/null
  25. echo Extracting cmd.c
  26. sed >cmd.c <<'!STUFFY!FUNK!' -e 's/X//'
  27. X/* $RCSfile: cmd.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:36:16 $
  28. X *
  29. X *    Copyright (c) 1989, Larry Wall
  30. X *
  31. X *    You may distribute under the terms of the GNU General Public License
  32. X *    as specified in the README file that comes with the perl 3.0 kit.
  33. X *
  34. X * $Log:    cmd.c,v $
  35. X * Revision 4.0.1.1  91/04/11  17:36:16  lwall
  36. X * patch1: you may now use "die" and "caller" in a signal handler
  37. X * 
  38. X * Revision 4.0  91/03/20  01:04:18  lwall
  39. X * 4.0 baseline.
  40. X * 
  41. X */
  42. X
  43. X#include "EXTERN.h"
  44. X#include "perl.h"
  45. X
  46. X#ifdef I_VARARGS
  47. X#  include <varargs.h>
  48. X#endif
  49. X
  50. Xstatic STR str_chop;
  51. X
  52. Xvoid grow_dlevel();
  53. X
  54. X/* do longjmps() clobber register variables? */
  55. X
  56. X#if defined(cray) || defined(__STDC__)
  57. X#define JMPCLOBBER
  58. X#endif
  59. X
  60. X/* This is the main command loop.  We try to spend as much time in this loop
  61. X * as possible, so lots of optimizations do their activities in here.  This
  62. X * means things get a little sloppy.
  63. X */
  64. X
  65. Xint
  66. Xcmd_exec(cmdparm,gimme,sp)
  67. XCMD *VOLATILE cmdparm;
  68. XVOLATILE int gimme;
  69. XVOLATILE int sp;
  70. X{
  71. X    register CMD *cmd = cmdparm;
  72. X    SPAT *VOLATILE oldspat;
  73. X    VOLATILE int firstsave = savestack->ary_fill;
  74. X    VOLATILE int oldsave;
  75. X    VOLATILE int aryoptsave;
  76. X#ifdef DEBUGGING
  77. X    VOLATILE int olddlevel;
  78. X    VOLATILE int entdlevel;
  79. X#endif
  80. X    register STR *retstr = &str_undef;
  81. X    register char *tmps;
  82. X    register int cmdflags;
  83. X    register int match;
  84. X    register char *go_to = goto_targ;
  85. X    register int newsp = -2;
  86. X    register STR **st = stack->ary_array;
  87. X    FILE *VOLATILE fp;
  88. X    ARRAY *VOLATILE ar;
  89. X
  90. X    lastsize = 0;
  91. X#ifdef DEBUGGING
  92. X    entdlevel = dlevel;
  93. X#endif
  94. Xtail_recursion_entry:
  95. X#ifdef DEBUGGING
  96. X    dlevel = entdlevel;
  97. X#endif
  98. X#ifdef TAINT
  99. X    tainted = 0;    /* Each statement is presumed innocent */
  100. X#endif
  101. X    if (cmd == Nullcmd) {
  102. X    if (gimme == G_ARRAY && newsp > -2)
  103. X        return newsp;
  104. X    else {
  105. X        st[++sp] = retstr;
  106. X        return sp;
  107. X    }
  108. X    }
  109. X    cmdflags = cmd->c_flags;    /* hopefully load register */
  110. X    if (go_to) {
  111. X    if (cmd->c_label && strEQ(go_to,cmd->c_label))
  112. X        goto_targ = go_to = Nullch;        /* here at last */
  113. X    else {
  114. X        switch (cmd->c_type) {
  115. X        case C_IF:
  116. X        oldspat = curspat;
  117. X        oldsave = savestack->ary_fill;
  118. X#ifdef DEBUGGING
  119. X        olddlevel = dlevel;
  120. X#endif
  121. X        retstr = &str_yes;
  122. X        newsp = -2;
  123. X        if (cmd->ucmd.ccmd.cc_true) {
  124. X#ifdef DEBUGGING
  125. X            if (debug) {
  126. X            debname[dlevel] = 't';
  127. X            debdelim[dlevel] = '_';
  128. X            if (++dlevel >= dlmax)
  129. X                grow_dlevel();
  130. X            }
  131. X#endif
  132. X            newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
  133. X            st = stack->ary_array;    /* possibly reallocated */
  134. X            retstr = st[newsp];
  135. X        }
  136. X        if (!goto_targ)
  137. X            go_to = Nullch;
  138. X        curspat = oldspat;
  139. X        if (savestack->ary_fill > oldsave)
  140. X            restorelist(oldsave);
  141. X#ifdef DEBUGGING
  142. X        dlevel = olddlevel;
  143. X#endif
  144. X        cmd = cmd->ucmd.ccmd.cc_alt;
  145. X        goto tail_recursion_entry;
  146. X        case C_ELSE:
  147. X        oldspat = curspat;
  148. X        oldsave = savestack->ary_fill;
  149. X#ifdef DEBUGGING
  150. X        olddlevel = dlevel;
  151. X#endif
  152. X        retstr = &str_undef;
  153. X        newsp = -2;
  154. X        if (cmd->ucmd.ccmd.cc_true) {
  155. X#ifdef DEBUGGING
  156. X            if (debug) {
  157. X            debname[dlevel] = 'e';
  158. X            debdelim[dlevel] = '_';
  159. X            if (++dlevel >= dlmax)
  160. X                grow_dlevel();
  161. X            }
  162. X#endif
  163. X            newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
  164. X            st = stack->ary_array;    /* possibly reallocated */
  165. X            retstr = st[newsp];
  166. X        }
  167. X        if (!goto_targ)
  168. X            go_to = Nullch;
  169. X        curspat = oldspat;
  170. X        if (savestack->ary_fill > oldsave)
  171. X            restorelist(oldsave);
  172. X#ifdef DEBUGGING
  173. X        dlevel = olddlevel;
  174. X#endif
  175. X        break;
  176. X        case C_BLOCK:
  177. X        case C_WHILE:
  178. X        if (!(cmdflags & CF_ONCE)) {
  179. X            cmdflags |= CF_ONCE;
  180. X            if (++loop_ptr >= loop_max) {
  181. X            loop_max += 128;
  182. X            Renew(loop_stack, loop_max, struct loop);
  183. X            }
  184. X            loop_stack[loop_ptr].loop_label = cmd->c_label;
  185. X            loop_stack[loop_ptr].loop_sp = sp;
  186. X#ifdef DEBUGGING
  187. X            if (debug & 4) {
  188. X            deb("(Pushing label #%d %s)\n",
  189. X              loop_ptr, cmd->c_label ? cmd->c_label : "");
  190. X            }
  191. X#endif
  192. X        }
  193. X#ifdef JMPCLOBBER
  194. X        cmdparm = cmd;
  195. X#endif
  196. X        match = setjmp(loop_stack[loop_ptr].loop_env);
  197. X        if (match) {
  198. X            st = stack->ary_array;    /* possibly reallocated */
  199. X#ifdef JMPCLOBBER
  200. X            cmd = cmdparm;
  201. X            cmdflags = cmd->c_flags|CF_ONCE;
  202. X#endif
  203. X            if (savestack->ary_fill > oldsave)
  204. X            restorelist(oldsave);
  205. X            switch (match) {
  206. X            default:
  207. X            fatal("longjmp returned bad value (%d)",match);
  208. X            case O_LAST:    /* not done unless go_to found */
  209. X            go_to = Nullch;
  210. X            if (lastretstr) {
  211. X                retstr = lastretstr;
  212. X                newsp = -2;
  213. X            }
  214. X            else {
  215. X                newsp = sp + lastsize;
  216. X                retstr = st[newsp];
  217. X            }
  218. X#ifdef DEBUGGING
  219. X            olddlevel = dlevel;
  220. X#endif
  221. X            curspat = oldspat;
  222. X            goto next_cmd;
  223. X            case O_NEXT:    /* not done unless go_to found */
  224. X            go_to = Nullch;
  225. X#ifdef JMPCLOBBER
  226. X            newsp = -2;
  227. X            retstr = &str_undef;
  228. X#endif
  229. X            goto next_iter;
  230. X            case O_REDO:    /* not done unless go_to found */
  231. X            go_to = Nullch;
  232. X#ifdef JMPCLOBBER
  233. X            newsp = -2;
  234. X            retstr = &str_undef;
  235. X#endif
  236. X            goto doit;
  237. X            }
  238. X        }
  239. X        oldspat = curspat;
  240. X        oldsave = savestack->ary_fill;
  241. X#ifdef DEBUGGING
  242. X        olddlevel = dlevel;
  243. X#endif
  244. X        if (cmd->ucmd.ccmd.cc_true) {
  245. X#ifdef DEBUGGING
  246. X            if (debug) {
  247. X            debname[dlevel] = 't';
  248. X            debdelim[dlevel] = '_';
  249. X            if (++dlevel >= dlmax)
  250. X                grow_dlevel();
  251. X            }
  252. X#endif
  253. X            newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
  254. X            st = stack->ary_array;    /* possibly reallocated */
  255. X            retstr = st[newsp];
  256. X        }
  257. X        if (!goto_targ) {
  258. X            go_to = Nullch;
  259. X            goto next_iter;
  260. X        }
  261. X#ifdef DEBUGGING
  262. X        dlevel = olddlevel;
  263. X#endif
  264. X        if (cmd->ucmd.ccmd.cc_alt) {
  265. X#ifdef DEBUGGING
  266. X            if (debug) {
  267. X            debname[dlevel] = 'a';
  268. X            debdelim[dlevel] = '_';
  269. X            if (++dlevel >= dlmax)
  270. X                grow_dlevel();
  271. X            }
  272. X#endif
  273. X            newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme && (cmdflags & CF_TERM),sp);
  274. X            st = stack->ary_array;    /* possibly reallocated */
  275. X            retstr = st[newsp];
  276. X        }
  277. X        if (goto_targ)
  278. X            break;
  279. X        go_to = Nullch;
  280. X        goto finish_while;
  281. X        }
  282. X        cmd = cmd->c_next;
  283. X        if (cmd && cmd->c_head == cmd)
  284. X                    /* reached end of while loop */
  285. X        return sp;        /* targ isn't in this block */
  286. X        if (cmdflags & CF_ONCE) {
  287. X#ifdef DEBUGGING
  288. X        if (debug & 4) {
  289. X            tmps = loop_stack[loop_ptr].loop_label;
  290. X            deb("(Popping label #%d %s)\n",loop_ptr,
  291. X            tmps ? tmps : "" );
  292. X        }
  293. X#endif
  294. X        loop_ptr--;
  295. X        }
  296. X        goto tail_recursion_entry;
  297. X    }
  298. X    }
  299. X
  300. Xuntil_loop:
  301. X
  302. X    /* Set line number so run-time errors can be located */
  303. X
  304. X    curcmd = cmd;
  305. X
  306. X#ifdef DEBUGGING
  307. X    if (debug) {
  308. X    if (debug & 2) {
  309. X        deb("%s    (%lx)    r%lx    t%lx    a%lx    n%lx    cs%lx\n",
  310. X        cmdname[cmd->c_type],cmd,cmd->c_expr,
  311. X        cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt,cmd->c_next,
  312. X        curspat);
  313. X    }
  314. X    debname[dlevel] = cmdname[cmd->c_type][0];
  315. X    debdelim[dlevel] = '!';
  316. X    if (++dlevel >= dlmax)
  317. X        grow_dlevel();
  318. X    }
  319. X#endif
  320. X
  321. X    /* Here is some common optimization */
  322. X
  323. X    if (cmdflags & CF_COND) {
  324. X    switch (cmdflags & CF_OPTIMIZE) {
  325. X
  326. X    case CFT_FALSE:
  327. X        retstr = cmd->c_short;
  328. X        newsp = -2;
  329. X        match = FALSE;
  330. X        if (cmdflags & CF_NESURE)
  331. X        goto maybe;
  332. X        break;
  333. X    case CFT_TRUE:
  334. X        retstr = cmd->c_short;
  335. X        newsp = -2;
  336. X        match = TRUE;
  337. X        if (cmdflags & CF_EQSURE)
  338. X        goto flipmaybe;
  339. X        break;
  340. X
  341. X    case CFT_REG:
  342. X        retstr = STAB_STR(cmd->c_stab);
  343. X        newsp = -2;
  344. X        match = str_true(retstr);    /* => retstr = retstr, c2 should fix */
  345. X        if (cmdflags & (match ? CF_EQSURE : CF_NESURE))
  346. X        goto flipmaybe;
  347. X        break;
  348. X
  349. X    case CFT_ANCHOR:    /* /^pat/ optimization */
  350. X        if (multiline) {
  351. X        if (*cmd->c_short->str_ptr && !(cmdflags & CF_EQSURE))
  352. X            goto scanner;    /* just unanchor it */
  353. X        else
  354. X            break;        /* must evaluate */
  355. X        }
  356. X        /* FALL THROUGH */
  357. X    case CFT_STROP:        /* string op optimization */
  358. X        retstr = STAB_STR(cmd->c_stab);
  359. X        newsp = -2;
  360. X#ifndef I286
  361. X        if (*cmd->c_short->str_ptr == *str_get(retstr) &&
  362. X            bcmp(cmd->c_short->str_ptr, str_get(retstr),
  363. X              cmd->c_slen) == 0 ) {
  364. X        if (cmdflags & CF_EQSURE) {
  365. X            if (sawampersand && (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
  366. X            curspat = Nullspat;
  367. X            if (leftstab)
  368. X                str_nset(stab_val(leftstab),"",0);
  369. X            if (amperstab)
  370. X                str_sset(stab_val(amperstab),cmd->c_short);
  371. X            if (rightstab)
  372. X                str_nset(stab_val(rightstab),
  373. X                  retstr->str_ptr + cmd->c_slen,
  374. X                  retstr->str_cur - cmd->c_slen);
  375. X            }
  376. X            if (cmd->c_spat)
  377. X            lastspat = cmd->c_spat;
  378. X            match = !(cmdflags & CF_FIRSTNEG);
  379. X            retstr = &str_yes;
  380. X            goto flipmaybe;
  381. X        }
  382. X        }
  383. X        else if (cmdflags & CF_NESURE) {
  384. X        match = cmdflags & CF_FIRSTNEG;
  385. X        retstr = &str_no;
  386. X        goto flipmaybe;
  387. X        }
  388. X#else
  389. X        {
  390. X        char *zap1, *zap2, zap1c, zap2c;
  391. X        int  zaplen;
  392. X
  393. X        zap1 = cmd->c_short->str_ptr;
  394. X        zap2 = str_get(retstr);
  395. X        zap1c = *zap1;
  396. X        zap2c = *zap2;
  397. X        zaplen = cmd->c_slen;
  398. X        if ((zap1c == zap2c) && (bcmp(zap1, zap2, zaplen) == 0)) {
  399. X            if (cmdflags & CF_EQSURE) {
  400. X            if (sawampersand &&
  401. X              (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
  402. X                curspat = Nullspat;
  403. X                if (leftstab)
  404. X                str_nset(stab_val(leftstab),"",0);
  405. X                if (amperstab)
  406. X                str_sset(stab_val(amperstab),cmd->c_short);
  407. X                if (rightstab)
  408. X                str_nset(stab_val(rightstab),
  409. X                     retstr->str_ptr + cmd->c_slen,
  410. X                     retstr->str_cur - cmd->c_slen);
  411. X            }
  412. X            if (cmd->c_spat)
  413. X                lastspat = cmd->c_spat;
  414. X             match = !(cmdflags & CF_FIRSTNEG);
  415. X             retstr = &str_yes;
  416. X             goto flipmaybe;
  417. X            }
  418. X        }
  419. X        else if (cmdflags & CF_NESURE) {
  420. X            match = cmdflags & CF_FIRSTNEG;
  421. X            retstr = &str_no;
  422. X            goto flipmaybe;
  423. X        }
  424. X        }
  425. X#endif
  426. X        break;            /* must evaluate */
  427. X
  428. X    case CFT_SCAN:            /* non-anchored search */
  429. X      scanner:
  430. X        retstr = STAB_STR(cmd->c_stab);
  431. X        newsp = -2;
  432. X        if (retstr->str_pok & SP_STUDIED)
  433. X        if (screamfirst[cmd->c_short->str_rare] >= 0)
  434. X            tmps = screaminstr(retstr, cmd->c_short);
  435. X        else
  436. X            tmps = Nullch;
  437. X        else {
  438. X        tmps = str_get(retstr);        /* make sure it's pok */
  439. X#ifndef lint
  440. X        tmps = fbminstr((unsigned char*)tmps,
  441. X            (unsigned char*)tmps + retstr->str_cur, cmd->c_short);
  442. X#endif
  443. X        }
  444. X        if (tmps) {
  445. X        if (cmdflags & CF_EQSURE) {
  446. X            ++cmd->c_short->str_u.str_useful;
  447. X            if (sawampersand) {
  448. X            curspat = Nullspat;
  449. X            if (leftstab)
  450. X                str_nset(stab_val(leftstab),retstr->str_ptr,
  451. X                  tmps - retstr->str_ptr);
  452. X            if (amperstab)
  453. X                str_nset(stab_val(amperstab),
  454. X                  tmps, cmd->c_short->str_cur);
  455. X            if (rightstab)
  456. X                str_nset(stab_val(rightstab),
  457. X                  tmps + cmd->c_short->str_cur,
  458. X                  retstr->str_cur - (tmps - retstr->str_ptr) -
  459. X                cmd->c_short->str_cur);
  460. X            }
  461. X            lastspat = cmd->c_spat;
  462. X            match = !(cmdflags & CF_FIRSTNEG);
  463. X            retstr = &str_yes;
  464. X            goto flipmaybe;
  465. X        }
  466. X        else
  467. X            hint = tmps;
  468. X        }
  469. X        else {
  470. X        if (cmdflags & CF_NESURE) {
  471. X            ++cmd->c_short->str_u.str_useful;
  472. X            match = cmdflags & CF_FIRSTNEG;
  473. X            retstr = &str_no;
  474. X            goto flipmaybe;
  475. X        }
  476. X        }
  477. X        if (--cmd->c_short->str_u.str_useful < 0) {
  478. X        cmdflags &= ~CF_OPTIMIZE;
  479. X        cmdflags |= CFT_EVAL;    /* never try this optimization again */
  480. X        cmd->c_flags = (cmdflags & ~CF_ONCE);
  481. X        }
  482. X        break;            /* must evaluate */
  483. X
  484. X    case CFT_NUMOP:        /* numeric op optimization */
  485. X        retstr = STAB_STR(cmd->c_stab);
  486. X        newsp = -2;
  487. X        switch (cmd->c_slen) {
  488. X        case O_EQ:
  489. X        if (dowarn) {
  490. X            if ((!retstr->str_nok && !looks_like_number(retstr)))
  491. X            warn("Possible use of == on string value");
  492. X        }
  493. X        match = (str_gnum(retstr) == cmd->c_short->str_u.str_nval);
  494. X        break;
  495. X        case O_NE:
  496. X        match = (str_gnum(retstr) != cmd->c_short->str_u.str_nval);
  497. X        break;
  498. X        case O_LT:
  499. X        match = (str_gnum(retstr) <  cmd->c_short->str_u.str_nval);
  500. X        break;
  501. X        case O_LE:
  502. X        match = (str_gnum(retstr) <= cmd->c_short->str_u.str_nval);
  503. X        break;
  504. X        case O_GT:
  505. X        match = (str_gnum(retstr) >  cmd->c_short->str_u.str_nval);
  506. X        break;
  507. X        case O_GE:
  508. X        match = (str_gnum(retstr) >= cmd->c_short->str_u.str_nval);
  509. X        break;
  510. X        }
  511. X        if (match) {
  512. X        if (cmdflags & CF_EQSURE) {
  513. X            retstr = &str_yes;
  514. X            goto flipmaybe;
  515. X        }
  516. X        }
  517. X        else if (cmdflags & CF_NESURE) {
  518. X        retstr = &str_no;
  519. X        goto flipmaybe;
  520. X        }
  521. X        break;            /* must evaluate */
  522. X
  523. X    case CFT_INDGETS:        /* while (<$foo>) */
  524. X        last_in_stab = stabent(str_get(STAB_STR(cmd->c_stab)),TRUE);
  525. X        if (!stab_io(last_in_stab))
  526. X        stab_io(last_in_stab) = stio_new();
  527. X        goto dogets;
  528. X    case CFT_GETS:            /* really a while (<file>) */
  529. X        last_in_stab = cmd->c_stab;
  530. X      dogets:
  531. X        fp = stab_io(last_in_stab)->ifp;
  532. X        retstr = stab_val(defstab);
  533. X        newsp = -2;
  534. X      keepgoing:
  535. X        if (fp && str_gets(retstr, fp, 0)) {
  536. X        if (*retstr->str_ptr == '0' && retstr->str_cur == 1)
  537. X            match = FALSE;
  538. X        else
  539. X            match = TRUE;
  540. X        stab_io(last_in_stab)->lines++;
  541. X        }
  542. X        else if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  543. X        if (!fp)
  544. X            goto doeval;    /* first time through */
  545. X        fp = nextargv(last_in_stab);
  546. X        if (fp)
  547. X            goto keepgoing;
  548. X        (void)do_close(last_in_stab,FALSE);
  549. X        stab_io(last_in_stab)->flags |= IOF_START;
  550. X        retstr = &str_undef;
  551. X        match = FALSE;
  552. X        }
  553. X        else {
  554. X        retstr = &str_undef;
  555. X        match = FALSE;
  556. X        }
  557. X        goto flipmaybe;
  558. X    case CFT_EVAL:
  559. X        break;
  560. X    case CFT_UNFLIP:
  561. X        while (tmps_max > tmps_base) {    /* clean up after last eval */
  562. X        str_free(tmps_list[tmps_max]);
  563. X        tmps_list[tmps_max--] = Nullstr;
  564. X        }
  565. X        newsp = eval(cmd->c_expr,gimme && (cmdflags & CF_TERM),sp);
  566. X        st = stack->ary_array;    /* possibly reallocated */
  567. X        retstr = st[newsp];
  568. X        match = str_true(retstr);
  569. X        if (cmd->c_expr->arg_type == O_FLIP)    /* undid itself? */
  570. X        cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
  571. X        goto maybe;
  572. X    case CFT_CHOP:
  573. X        retstr = stab_val(cmd->c_stab);
  574. X        newsp = -2;
  575. X        match = (retstr->str_cur != 0);
  576. X        tmps = str_get(retstr);
  577. X        tmps += retstr->str_cur - match;
  578. X        str_nset(&str_chop,tmps,match);
  579. X        *tmps = '\0';
  580. X        retstr->str_nok = 0;
  581. X        retstr->str_cur = tmps - retstr->str_ptr;
  582. X        STABSET(retstr);
  583. X        retstr = &str_chop;
  584. X        goto flipmaybe;
  585. X    case CFT_ARRAY:
  586. X        match = cmd->c_short->str_u.str_useful; /* just to get register */
  587. X
  588. X        if (match < 0) {        /* first time through here? */
  589. X        ar = stab_array(cmd->c_expr[1].arg_ptr.arg_stab);
  590. X        aryoptsave = savestack->ary_fill;
  591. X        savesptr(&stab_val(cmd->c_stab));
  592. X        savelong(&cmd->c_short->str_u.str_useful);
  593. X        }
  594. X        else {
  595. X        ar = stab_xarray(cmd->c_expr[1].arg_ptr.arg_stab);
  596. X        if (cmd->c_type != C_WHILE && savestack->ary_fill > firstsave)
  597. X            restorelist(firstsave);
  598. X        }
  599. X
  600. X        if (match >= ar->ary_fill) {    /* we're in LAST, probably */
  601. X        retstr = &str_undef;
  602. X        cmd->c_short->str_u.str_useful = -1;    /* actually redundant */
  603. X        match = FALSE;
  604. X        }
  605. X        else {
  606. X        match++;
  607. X        if (!(retstr = ar->ary_array[match]))
  608. X            retstr = afetch(ar,match,TRUE);
  609. X        stab_val(cmd->c_stab) = retstr;
  610. X        cmd->c_short->str_u.str_useful = match;
  611. X        match = TRUE;
  612. X        }
  613. X        newsp = -2;
  614. X        goto maybe;
  615. X    case CFT_D1:
  616. X        break;
  617. X    case CFT_D0:
  618. X        if (DBsingle->str_u.str_nval != 0)
  619. X        break;
  620. X        if (DBsignal->str_u.str_nval != 0)
  621. X        break;
  622. X        if (DBtrace->str_u.str_nval != 0)
  623. X        break;
  624. X        goto next_cmd;
  625. X    }
  626. X
  627. X    /* we have tried to make this normal case as abnormal as possible */
  628. X
  629. X    doeval:
  630. X    if (gimme == G_ARRAY) {
  631. X        lastretstr = Nullstr;
  632. X        lastspbase = sp;
  633. X        lastsize = newsp - sp;
  634. X        if (lastsize < 0)
  635. X        lastsize = 0;
  636. X    }
  637. X    else
  638. X        lastretstr = retstr;
  639. X    while (tmps_max > tmps_base) {    /* clean up after last eval */
  640. X        str_free(tmps_list[tmps_max]);
  641. X        tmps_list[tmps_max--] = Nullstr;
  642. X    }
  643. X    newsp = eval(cmd->c_expr,
  644. X      gimme && (cmdflags & CF_TERM) && cmd->c_type == C_EXPR &&
  645. X        !cmd->ucmd.acmd.ac_expr,
  646. X      sp);
  647. X    st = stack->ary_array;    /* possibly reallocated */
  648. X    retstr = st[newsp];
  649. X    if (newsp > sp && retstr)
  650. X        match = str_true(retstr);
  651. X    else
  652. X        match = FALSE;
  653. X    goto maybe;
  654. X
  655. X    /* if flipflop was true, flop it */
  656. X
  657. X    flipmaybe:
  658. X    if (match && cmdflags & CF_FLIP) {
  659. X        while (tmps_max > tmps_base) {    /* clean up after last eval */
  660. X        str_free(tmps_list[tmps_max]);
  661. X        tmps_list[tmps_max--] = Nullstr;
  662. X        }
  663. X        if (cmd->c_expr->arg_type == O_FLOP) {    /* currently toggled? */
  664. X        newsp = eval(cmd->c_expr,G_SCALAR,sp);/*let eval undo it*/
  665. X        cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
  666. X        }
  667. X        else {
  668. X        newsp = eval(cmd->c_expr,G_SCALAR,sp);/* let eval do it */
  669. X        if (cmd->c_expr->arg_type == O_FLOP)    /* still toggled? */
  670. X            cmdflags = copyopt(cmd,cmd->c_expr[4].arg_ptr.arg_cmd);
  671. X        }
  672. X    }
  673. X    else if (cmdflags & CF_FLIP) {
  674. X        if (cmd->c_expr->arg_type == O_FLOP) {    /* currently toggled? */
  675. X        match = TRUE;                /* force on */
  676. X        }
  677. X    }
  678. X
  679. X    /* at this point, match says whether our expression was true */
  680. X
  681. X    maybe:
  682. X    if (cmdflags & CF_INVERT)
  683. X        match = !match;
  684. X    if (!match)
  685. X        goto next_cmd;
  686. X    }
  687. X#ifdef TAINT
  688. X    tainted = 0;    /* modifier doesn't affect regular expression */
  689. X#endif
  690. X
  691. X    /* now to do the actual command, if any */
  692. X
  693. X    switch (cmd->c_type) {
  694. X    case C_NULL:
  695. X    fatal("panic: cmd_exec");
  696. X    case C_EXPR:            /* evaluated for side effects */
  697. X    if (cmd->ucmd.acmd.ac_expr) {    /* more to do? */
  698. X        if (gimme == G_ARRAY) {
  699. X        lastretstr = Nullstr;
  700. X        lastspbase = sp;
  701. X        lastsize = newsp - sp;
  702. X        if (lastsize < 0)
  703. X            lastsize = 0;
  704. X        }
  705. X        else
  706. X        lastretstr = retstr;
  707. X        while (tmps_max > tmps_base) {    /* clean up after last eval */
  708. X        str_free(tmps_list[tmps_max]);
  709. X        tmps_list[tmps_max--] = Nullstr;
  710. X        }
  711. X        newsp = eval(cmd->ucmd.acmd.ac_expr,gimme && (cmdflags&CF_TERM),sp);
  712. X        st = stack->ary_array;    /* possibly reallocated */
  713. X        retstr = st[newsp];
  714. X    }
  715. X    break;
  716. X    case C_NSWITCH:
  717. X    {
  718. X        double value = str_gnum(STAB_STR(cmd->c_stab));
  719. X
  720. X        match = (int)value;
  721. X        if (value < 0.0) {
  722. X        if (((double)match) > value)
  723. X            --match;        /* was fractional--truncate other way */
  724. X        }
  725. X    }
  726. X    goto doswitch;
  727. X    case C_CSWITCH:
  728. X    match = *(str_get(STAB_STR(cmd->c_stab))) & 255;
  729. X      doswitch:
  730. X    match -= cmd->ucmd.scmd.sc_offset;
  731. X    if (match < 0)
  732. X        match = 0;
  733. X    else if (match > cmd->ucmd.scmd.sc_max)
  734. X        match = cmd->ucmd.scmd.sc_max;
  735. X    cmd = cmd->ucmd.scmd.sc_next[match];
  736. X    goto tail_recursion_entry;
  737. X    case C_NEXT:
  738. X    cmd = cmd->ucmd.ccmd.cc_alt;
  739. X    goto tail_recursion_entry;
  740. X    case C_ELSIF:
  741. X    fatal("panic: ELSIF");
  742. X    case C_IF:
  743. X    oldspat = curspat;
  744. X    oldsave = savestack->ary_fill;
  745. X#ifdef DEBUGGING
  746. X    olddlevel = dlevel;
  747. X#endif
  748. X    retstr = &str_yes;
  749. X    newsp = -2;
  750. X    if (cmd->ucmd.ccmd.cc_true) {
  751. X#ifdef DEBUGGING
  752. X        if (debug) {
  753. X        debname[dlevel] = 't';
  754. X        debdelim[dlevel] = '_';
  755. X        if (++dlevel >= dlmax)
  756. X            grow_dlevel();
  757. X        }
  758. X#endif
  759. X        newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
  760. X        st = stack->ary_array;    /* possibly reallocated */
  761. X        retstr = st[newsp];
  762. X    }
  763. X    curspat = oldspat;
  764. X    if (savestack->ary_fill > oldsave)
  765. X        restorelist(oldsave);
  766. X#ifdef DEBUGGING
  767. X    dlevel = olddlevel;
  768. X#endif
  769. X    cmd = cmd->ucmd.ccmd.cc_alt;
  770. X    goto tail_recursion_entry;
  771. X    case C_ELSE:
  772. X    oldspat = curspat;
  773. X    oldsave = savestack->ary_fill;
  774. X#ifdef DEBUGGING
  775. X    olddlevel = dlevel;
  776. X#endif
  777. X    retstr = &str_undef;
  778. X    newsp = -2;
  779. X    if (cmd->ucmd.ccmd.cc_true) {
  780. X#ifdef DEBUGGING
  781. X        if (debug) {
  782. X        debname[dlevel] = 'e';
  783. X        debdelim[dlevel] = '_';
  784. X        if (++dlevel >= dlmax)
  785. X            grow_dlevel();
  786. X        }
  787. X#endif
  788. X        newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
  789. X        st = stack->ary_array;    /* possibly reallocated */
  790. X        retstr = st[newsp];
  791. X    }
  792. X    curspat = oldspat;
  793. X    if (savestack->ary_fill > oldsave)
  794. X        restorelist(oldsave);
  795. X#ifdef DEBUGGING
  796. X    dlevel = olddlevel;
  797. X#endif
  798. X    break;
  799. X    case C_BLOCK:
  800. X    case C_WHILE:
  801. X    if (!(cmdflags & CF_ONCE)) {    /* first time through here? */
  802. X        cmdflags |= CF_ONCE;
  803. X        if (++loop_ptr >= loop_max) {
  804. X        loop_max += 128;
  805. X        Renew(loop_stack, loop_max, struct loop);
  806. X        }
  807. X        loop_stack[loop_ptr].loop_label = cmd->c_label;
  808. X        loop_stack[loop_ptr].loop_sp = sp;
  809. X#ifdef DEBUGGING
  810. X        if (debug & 4) {
  811. X        deb("(Pushing label #%d %s)\n",
  812. X          loop_ptr, cmd->c_label ? cmd->c_label : "");
  813. X        }
  814. X#endif
  815. X    }
  816. X#ifdef JMPCLOBBER
  817. X    cmdparm = cmd;
  818. X#endif
  819. X    match = setjmp(loop_stack[loop_ptr].loop_env);
  820. X    if (match) {
  821. X        st = stack->ary_array;    /* possibly reallocated */
  822. X#ifdef JMPCLOBBER
  823. X        cmd = cmdparm;
  824. X        cmdflags = cmd->c_flags|CF_ONCE;
  825. X        go_to = goto_targ;
  826. X#endif
  827. X        if (savestack->ary_fill > oldsave)
  828. X        restorelist(oldsave);
  829. X        switch (match) {
  830. X        default:
  831. X        fatal("longjmp returned bad value (%d)",match);
  832. X        case O_LAST:
  833. X        if (lastretstr) {
  834. X            retstr = lastretstr;
  835. X            newsp = -2;
  836. X        }
  837. X        else {
  838. X            newsp = sp + lastsize;
  839. X            retstr = st[newsp];
  840. X        }
  841. X        curspat = oldspat;
  842. X        goto next_cmd;
  843. X        case O_NEXT:
  844. X#ifdef JMPCLOBBER
  845. X        newsp = -2;
  846. X        retstr = &str_undef;
  847. X#endif
  848. X        goto next_iter;
  849. X        case O_REDO:
  850. X#ifdef DEBUGGING
  851. X        dlevel = olddlevel;
  852. X#endif
  853. X#ifdef JMPCLOBBER
  854. X        newsp = -2;
  855. X        retstr = &str_undef;
  856. X#endif
  857. X        goto doit;
  858. X        }
  859. X    }
  860. X    oldspat = curspat;
  861. X    oldsave = savestack->ary_fill;
  862. X#ifdef DEBUGGING
  863. X    olddlevel = dlevel;
  864. X#endif
  865. X    doit:
  866. X    if (cmd->ucmd.ccmd.cc_true) {
  867. X#ifdef DEBUGGING
  868. X        if (debug) {
  869. X        debname[dlevel] = 't';
  870. X        debdelim[dlevel] = '_';
  871. X        if (++dlevel >= dlmax)
  872. X            grow_dlevel();
  873. X        }
  874. X#endif
  875. X        newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
  876. X        st = stack->ary_array;    /* possibly reallocated */
  877. X        retstr = st[newsp];
  878. X    }
  879. X    /* actually, this spot is rarely reached anymore since the above
  880. X     * cmd_exec() returns through longjmp().  Hooray for structure.
  881. X     */
  882. X      next_iter:
  883. X#ifdef DEBUGGING
  884. X    dlevel = olddlevel;
  885. X#endif
  886. X    if (cmd->ucmd.ccmd.cc_alt) {
  887. X#ifdef DEBUGGING
  888. X        if (debug) {
  889. X        debname[dlevel] = 'a';
  890. X        debdelim[dlevel] = '_';
  891. X        if (++dlevel >= dlmax)
  892. X            grow_dlevel();
  893. X        }
  894. X#endif
  895. X        newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme && (cmdflags & CF_TERM),sp);
  896. X        st = stack->ary_array;    /* possibly reallocated */
  897. X        retstr = st[newsp];
  898. X    }
  899. X      finish_while:
  900. X    curspat = oldspat;
  901. X    if (savestack->ary_fill > oldsave) {
  902. X        if (cmdflags & CF_TERM) {
  903. X        for (match = sp + 1; match <= newsp; match++)
  904. X            st[match] = str_mortal(st[match]);
  905. X        retstr = st[newsp];
  906. X        }
  907. X        restorelist(oldsave);
  908. X    }
  909. X#ifdef DEBUGGING
  910. X    dlevel = olddlevel - 1;
  911. X#endif
  912. X    if (cmd->c_type != C_BLOCK)
  913. X        goto until_loop;    /* go back and evaluate conditional again */
  914. X    }
  915. X    if (cmdflags & CF_LOOP) {
  916. X    cmdflags |= CF_COND;        /* now test the condition */
  917. X#ifdef DEBUGGING
  918. X    dlevel = entdlevel;
  919. X#endif
  920. X    goto until_loop;
  921. X    }
  922. X  next_cmd:
  923. X    if (cmdflags & CF_ONCE) {
  924. X#ifdef DEBUGGING
  925. X    if (debug & 4) {
  926. X        tmps = loop_stack[loop_ptr].loop_label;
  927. X        deb("(Popping label #%d %s)\n",loop_ptr, tmps ? tmps : "");
  928. X    }
  929. X#endif
  930. X    loop_ptr--;
  931. X    if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY &&
  932. X      savestack->ary_fill > aryoptsave)
  933. X        restorelist(aryoptsave);
  934. X    }
  935. X    cmd = cmd->c_next;
  936. X    goto tail_recursion_entry;
  937. X}
  938. X
  939. X#ifdef DEBUGGING
  940. X#  ifndef I_VARARGS
  941. X/*VARARGS1*/
  942. Xdeb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
  943. Xchar *pat;
  944. X{
  945. X    register int i;
  946. X
  947. X    fprintf(stderr,"%-4ld",(long)curcmd->c_line);
  948. X    for (i=0; i<dlevel; i++)
  949. X    fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
  950. X    fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
  951. X}
  952. X#  else
  953. X/*VARARGS1*/
  954. Xdeb(va_alist)
  955. Xva_dcl
  956. X{
  957. X    va_list args;
  958. X    char *pat;
  959. X    register int i;
  960. X
  961. X    va_start(args);
  962. X    fprintf(stderr,"%-4ld",(long)curcmd->c_line);
  963. X    for (i=0; i<dlevel; i++)
  964. X    fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
  965. X
  966. X    pat = va_arg(args, char *);
  967. X    (void) vfprintf(stderr,pat,args);
  968. X    va_end( args );
  969. X}
  970. X#  endif
  971. X#endif
  972. X
  973. Xcopyopt(cmd,which)
  974. Xregister CMD *cmd;
  975. Xregister CMD *which;
  976. X{
  977. X    cmd->c_flags &= CF_ONCE|CF_COND|CF_LOOP;
  978. X    cmd->c_flags |= which->c_flags;
  979. X    cmd->c_short = which->c_short;
  980. X    cmd->c_slen = which->c_slen;
  981. X    cmd->c_stab = which->c_stab;
  982. X    return cmd->c_flags;
  983. X}
  984. X
  985. XARRAY *
  986. Xsaveary(stab)
  987. XSTAB *stab;
  988. X{
  989. X    register STR *str;
  990. X
  991. X    str = Str_new(10,0);
  992. X    str->str_state = SS_SARY;
  993. X    str->str_u.str_stab = stab;
  994. X    if (str->str_ptr) {
  995. X    Safefree(str->str_ptr);
  996. X    str->str_ptr = Nullch;
  997. X    str->str_len = 0;
  998. X    }
  999. X    str->str_ptr = (char*)stab_array(stab);
  1000. X    (void)apush(savestack,str); /* save array ptr */
  1001. X    stab_xarray(stab) = Null(ARRAY*);
  1002. X    return stab_xarray(aadd(stab));
  1003. X}
  1004. X
  1005. XHASH *
  1006. Xsavehash(stab)
  1007. XSTAB *stab;
  1008. X{
  1009. X    register STR *str;
  1010. X
  1011. X    str = Str_new(11,0);
  1012. X    str->str_state = SS_SHASH;
  1013. X    str->str_u.str_stab = stab;
  1014. X    if (str->str_ptr) {
  1015. X    Safefree(str->str_ptr);
  1016. X    str->str_ptr = Nullch;
  1017. X    str->str_len = 0;
  1018. X    }
  1019. X    str->str_ptr = (char*)stab_hash(stab);
  1020. X    (void)apush(savestack,str); /* save hash ptr */
  1021. X    stab_xhash(stab) = Null(HASH*);
  1022. X    return stab_xhash(hadd(stab));
  1023. X}
  1024. X
  1025. Xvoid
  1026. Xsaveitem(item)
  1027. Xregister STR *item;
  1028. X{
  1029. X    register STR *str;
  1030. X
  1031. X    (void)apush(savestack,item);        /* remember the pointer */
  1032. X    str = Str_new(12,0);
  1033. X    str_sset(str,item);
  1034. X    (void)apush(savestack,str);            /* remember the value */
  1035. X}
  1036. X
  1037. Xvoid
  1038. Xsaveint(intp)
  1039. Xint *intp;
  1040. X{
  1041. X    register STR *str;
  1042. X
  1043. X    str = Str_new(13,0);
  1044. X    str->str_state = SS_SINT;
  1045. X    str->str_u.str_useful = (long)*intp;    /* remember value */
  1046. X    if (str->str_ptr) {
  1047. X    Safefree(str->str_ptr);
  1048. X    str->str_len = 0;
  1049. X    }
  1050. X    str->str_ptr = (char*)intp;        /* remember pointer */
  1051. X    (void)apush(savestack,str);
  1052. X}
  1053. X
  1054. Xvoid
  1055. Xsavelong(longp)
  1056. Xlong *longp;
  1057. X{
  1058. X    register STR *str;
  1059. X
  1060. X    str = Str_new(14,0);
  1061. X    str->str_state = SS_SLONG;
  1062. X    str->str_u.str_useful = *longp;        /* remember value */
  1063. X    if (str->str_ptr) {
  1064. X    Safefree(str->str_ptr);
  1065. X    str->str_len = 0;
  1066. X    }
  1067. X    str->str_ptr = (char*)longp;        /* remember pointer */
  1068. X    (void)apush(savestack,str);
  1069. X}
  1070. X
  1071. Xvoid
  1072. Xsavesptr(sptr)
  1073. XSTR **sptr;
  1074. X{
  1075. X    register STR *str;
  1076. X
  1077. X    str = Str_new(15,0);
  1078. X    str->str_state = SS_SSTRP;
  1079. X    str->str_magic = *sptr;        /* remember value */
  1080. X    if (str->str_ptr) {
  1081. X    Safefree(str->str_ptr);
  1082. X    str->str_len = 0;
  1083. X    }
  1084. X    str->str_ptr = (char*)sptr;        /* remember pointer */
  1085. X    (void)apush(savestack,str);
  1086. X}
  1087. X
  1088. Xvoid
  1089. Xsavenostab(stab)
  1090. XSTAB *stab;
  1091. X{
  1092. X    register STR *str;
  1093. X
  1094. X    str = Str_new(16,0);
  1095. X    str->str_state = SS_SNSTAB;
  1096. X    str->str_magic = (STR*)stab;    /* remember which stab to free */
  1097. X    (void)apush(savestack,str);
  1098. X}
  1099. X
  1100. Xvoid
  1101. Xsavehptr(hptr)
  1102. XHASH **hptr;
  1103. X{
  1104. X    register STR *str;
  1105. X
  1106. X    str = Str_new(17,0);
  1107. X    str->str_state = SS_SHPTR;
  1108. X    str->str_u.str_hash = *hptr;    /* remember value */
  1109. X    if (str->str_ptr) {
  1110. X    Safefree(str->str_ptr);
  1111. X    str->str_len = 0;
  1112. X    }
  1113. X    str->str_ptr = (char*)hptr;        /* remember pointer */
  1114. X    (void)apush(savestack,str);
  1115. X}
  1116. X
  1117. Xvoid
  1118. Xsaveaptr(aptr)
  1119. XARRAY **aptr;
  1120. X{
  1121. X    register STR *str;
  1122. X
  1123. X    str = Str_new(17,0);
  1124. X    str->str_state = SS_SAPTR;
  1125. X    str->str_u.str_array = *aptr;    /* remember value */
  1126. X    if (str->str_ptr) {
  1127. X    Safefree(str->str_ptr);
  1128. X    str->str_len = 0;
  1129. X    }
  1130. X    str->str_ptr = (char*)aptr;        /* remember pointer */
  1131. X    (void)apush(savestack,str);
  1132. X}
  1133. X
  1134. Xvoid
  1135. Xsavelist(sarg,maxsarg)
  1136. Xregister STR **sarg;
  1137. Xint maxsarg;
  1138. X{
  1139. X    register STR *str;
  1140. X    register int i;
  1141. X
  1142. X    for (i = 1; i <= maxsarg; i++) {
  1143. X    (void)apush(savestack,sarg[i]);        /* remember the pointer */
  1144. X    str = Str_new(18,0);
  1145. X    str_sset(str,sarg[i]);
  1146. X    (void)apush(savestack,str);            /* remember the value */
  1147. X    sarg[i]->str_u.str_useful = -1;
  1148. X    }
  1149. X}
  1150. X
  1151. Xvoid
  1152. Xrestorelist(base)
  1153. Xint base;
  1154. X{
  1155. X    register STR *str;
  1156. X    register STR *value;
  1157. X    register STAB *stab;
  1158. X
  1159. X    if (base < -1)
  1160. X    fatal("panic: corrupt saved stack index");
  1161. X    while (savestack->ary_fill > base) {
  1162. X    value = apop(savestack);
  1163. X    switch (value->str_state) {
  1164. X    case SS_NORM:                /* normal string */
  1165. X    case SS_INCR:
  1166. X        str = apop(savestack);
  1167. X        str_replace(str,value);
  1168. X        STABSET(str);
  1169. X        break;
  1170. X    case SS_SARY:                /* array reference */
  1171. X        stab = value->str_u.str_stab;
  1172. X        afree(stab_xarray(stab));
  1173. X        stab_xarray(stab) = (ARRAY*)value->str_ptr;
  1174. X        value->str_ptr = Nullch;
  1175. X        str_free(value);
  1176. X        break;
  1177. X    case SS_SHASH:                /* hash reference */
  1178. X        stab = value->str_u.str_stab;
  1179. X        (void)hfree(stab_xhash(stab), FALSE);
  1180. X        stab_xhash(stab) = (HASH*)value->str_ptr;
  1181. X        value->str_ptr = Nullch;
  1182. X        str_free(value);
  1183. X        break;
  1184. X    case SS_SINT:                /* int reference */
  1185. X        *((int*)value->str_ptr) = (int)value->str_u.str_useful;
  1186. X        value->str_ptr = Nullch;
  1187. X        str_free(value);
  1188. X        break;
  1189. X    case SS_SLONG:                /* long reference */
  1190. X        *((long*)value->str_ptr) = value->str_u.str_useful;
  1191. X        value->str_ptr = Nullch;
  1192. X        str_free(value);
  1193. X        break;
  1194. X    case SS_SSTRP:                /* STR* reference */
  1195. X        *((STR**)value->str_ptr) = value->str_magic;
  1196. X        value->str_magic = Nullstr;
  1197. X        value->str_ptr = Nullch;
  1198. X        str_free(value);
  1199. X        break;
  1200. X    case SS_SHPTR:                /* HASH* reference */
  1201. X        *((HASH**)value->str_ptr) = value->str_u.str_hash;
  1202. X        value->str_ptr = Nullch;
  1203. X        str_free(value);
  1204. X        break;
  1205. X    case SS_SAPTR:                /* ARRAY* reference */
  1206. X        *((ARRAY**)value->str_ptr) = value->str_u.str_array;
  1207. X        value->str_ptr = Nullch;
  1208. X        str_free(value);
  1209. X        break;
  1210. X    case SS_SNSTAB:
  1211. X        stab = (STAB*)value->str_magic;
  1212. X        value->str_magic = Nullstr;
  1213. X        (void)stab_clear(stab);
  1214. X        str_free(value);
  1215. X        break;
  1216. X    case SS_SCSV:                /* callsave structure */
  1217. X        {
  1218. X        CSV *csv = (CSV*) value->str_ptr;
  1219. X
  1220. X        curcmd = csv->curcmd;
  1221. X        curcsv = csv->curcsv;
  1222. X        csv->sub->depth = csv->depth;
  1223. X        if (csv->hasargs) {        /* put back old @_ */
  1224. X            afree(csv->argarray);
  1225. X            stab_xarray(defstab) = csv->savearray;
  1226. X        }
  1227. X        str_free(value);
  1228. X        }
  1229. X        break;
  1230. X    default:
  1231. X        fatal("panic: restorelist inconsistency");
  1232. X    }
  1233. X    }
  1234. X}
  1235. X
  1236. X#ifdef DEBUGGING
  1237. Xvoid
  1238. Xgrow_dlevel()
  1239. X{
  1240. X    dlmax += 128;
  1241. X    Renew(debname, dlmax, char);
  1242. X    Renew(debdelim, dlmax, char);
  1243. X}
  1244. X#endif
  1245. !STUFFY!FUNK!
  1246. echo Extracting perl.h
  1247. sed >perl.h <<'!STUFFY!FUNK!' -e 's/X//'
  1248. X/* $RCSfile: perl.h,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:51 $
  1249. X *
  1250. X *    Copyright (c) 1989, Larry Wall
  1251. X *
  1252. X *    You may distribute under the terms of the GNU General Public License
  1253. X *    as specified in the README file that comes with the perl 3.0 kit.
  1254. X *
  1255. X * $Log:    perl.h,v $
  1256. X * Revision 4.0.1.1  91/04/11  17:49:51  lwall
  1257. X * patch1: hopefully straightened out some of the Xenix mess
  1258. X * 
  1259. X * Revision 4.0  91/03/20  01:37:56  lwall
  1260. X * 4.0 baseline.
  1261. X * 
  1262. X */
  1263. X
  1264. X#define VOIDWANT 1
  1265. X#include "config.h"
  1266. X
  1267. X#ifdef MSDOS
  1268. X/* This stuff now in the MS-DOS config.h file. */
  1269. X#else /* !MSDOS */
  1270. X
  1271. X/*
  1272. X * The following symbols are defined if your operating system supports
  1273. X * functions by that name.  All Unixes I know of support them, thus they
  1274. X * are not checked by the configuration script, but are directly defined
  1275. X * here.
  1276. X */
  1277. X#define HAS_ALARM
  1278. X#define HAS_CHOWN
  1279. X#define HAS_CHROOT
  1280. X#define HAS_FORK
  1281. X#define HAS_GETLOGIN
  1282. X#define HAS_GETPPID
  1283. X#define HAS_KILL
  1284. X#define HAS_LINK
  1285. X#define HAS_PIPE
  1286. X#define HAS_WAIT
  1287. X#define HAS_UMASK
  1288. X/*
  1289. X * The following symbols are defined if your operating system supports
  1290. X * password and group functions in general.  All Unix systems do.
  1291. X */
  1292. X#define HAS_GROUP
  1293. X#define HAS_PASSWD
  1294. X
  1295. X#endif /* !MSDOS */
  1296. X
  1297. X#if defined(HASVOLATILE) || defined(__STDC__)
  1298. X#define VOLATILE volatile
  1299. X#else
  1300. X#define VOLATILE
  1301. X#endif
  1302. X
  1303. X#ifdef IAMSUID
  1304. X#   ifndef TAINT
  1305. X#    define TAINT
  1306. X#   endif
  1307. X#endif
  1308. X
  1309. X#ifndef HAS_VFORK
  1310. X#   define vfork fork
  1311. X#endif
  1312. X
  1313. X#ifdef HAS_GETPGRP2
  1314. X#   ifndef HAS_GETPGRP
  1315. X#    define HAS_GETPGRP
  1316. X#   endif
  1317. X#   define getpgrp getpgrp2
  1318. X#endif
  1319. X
  1320. X#ifdef HAS_SETPGRP2
  1321. X#   ifndef HAS_SETPGRP
  1322. X#    define HAS_SETPGRP
  1323. X#   endif
  1324. X#   define setpgrp setpgrp2
  1325. X#endif
  1326. X
  1327. X#include <stdio.h>
  1328. X#include <ctype.h>
  1329. X#include <setjmp.h>
  1330. X#ifndef MSDOS
  1331. X#include <sys/param.h>    /* if this needs types.h we're still wrong */
  1332. X#endif
  1333. X#ifdef __STDC__
  1334. X/* Use all the "standard" definitions */
  1335. X#include <stdlib.h>
  1336. X#include <string.h>
  1337. X#endif /* __STDC__ */
  1338. X
  1339. X#if defined(HAS_MEMCMP) && defined(mips) && BYTEORDER == 0x1234
  1340. X#undef HAS_MEMCMP
  1341. X#endif
  1342. X
  1343. X#ifdef HAS_MEMCPY
  1344. X
  1345. X#  ifndef __STDC__
  1346. X#    ifndef memcpy
  1347. Xextern char * memcpy(), *memset();
  1348. Xextern int memcmp();
  1349. X#    endif /* ndef memcpy */
  1350. X#  endif /* ndef __STDC__ */
  1351. X
  1352. X#define bcopy(s1,s2,l) memcpy(s2,s1,l)
  1353. X#define bzero(s,l) memset(s,0,l)
  1354. X#endif /* HAS_MEMCPY */
  1355. X
  1356. X#ifndef HAS_BCMP        /* prefer bcmp slightly 'cuz it doesn't order */
  1357. X#define bcmp(s1,s2,l) memcmp(s1,s2,l)
  1358. X#endif
  1359. X
  1360. X#ifndef _TYPES_        /* If types.h defines this it's easy. */
  1361. X#ifndef major        /* Does everyone's types.h define this? */
  1362. X#include <sys/types.h>
  1363. X#endif
  1364. X#endif
  1365. X
  1366. X#ifdef I_NETINET_IN
  1367. X#include <netinet/in.h>
  1368. X#endif
  1369. X
  1370. X#include <sys/stat.h>
  1371. X
  1372. X#ifdef I_TIME
  1373. X#   include <time.h>
  1374. X#endif
  1375. X
  1376. X#ifdef I_SYS_TIME
  1377. X#   ifdef SYSTIMEKERNEL
  1378. X#    define KERNEL
  1379. X#   endif
  1380. X#   include <sys/time.h>
  1381. X#   ifdef SYSTIMEKERNEL
  1382. X#    undef KERNEL
  1383. X#   endif
  1384. X#endif
  1385. X
  1386. X#ifndef MSDOS
  1387. X#include <sys/times.h>
  1388. X#endif
  1389. X
  1390. X#if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
  1391. X#undef HAS_STRERROR
  1392. X#endif
  1393. X
  1394. X#include <errno.h>
  1395. X#ifndef MSDOS
  1396. X#ifndef errno
  1397. Xextern int errno;     /* ANSI allows errno to be an lvalue expr */
  1398. X#endif
  1399. X#endif
  1400. X
  1401. X#ifndef strerror
  1402. X#ifdef HAS_STRERROR
  1403. Xchar *strerror();
  1404. X#else
  1405. Xextern int sys_nerr;
  1406. Xextern char *sys_errlist[];
  1407. X#define strerror(e) ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
  1408. X#endif
  1409. X#endif
  1410. X
  1411. X#ifdef I_SYSIOCTL
  1412. X#ifndef _IOCTL_
  1413. X#include <sys/ioctl.h>
  1414. X#endif
  1415. X#endif
  1416. X
  1417. X#if defined(mc300) || defined(mc500) || defined(mc700)    /* MASSCOMP */
  1418. X#ifdef HAS_SOCKETPAIR
  1419. X#undef HAS_SOCKETPAIR
  1420. X#endif
  1421. X#ifdef HAS_NDBM
  1422. X#undef HAS_NDBM
  1423. X#endif
  1424. X#endif
  1425. X
  1426. X#ifdef HAS_GDBM
  1427. X#ifdef I_GDBM
  1428. X#include <gdbm.h>
  1429. X#endif
  1430. X#define SOME_DBM
  1431. X#ifdef HAS_NDBM
  1432. X#undef HAS_NDBM
  1433. X#endif
  1434. X#ifdef HAS_ODBM
  1435. X#undef HAS_ODBM
  1436. X#endif
  1437. X#else
  1438. X#ifdef HAS_NDBM
  1439. X#include <ndbm.h>
  1440. X#define SOME_DBM
  1441. X#ifdef HAS_ODBM
  1442. X#undef HAS_ODBM
  1443. X#endif
  1444. X#else
  1445. X#ifdef HAS_ODBM
  1446. X#ifdef NULL
  1447. X#undef NULL        /* suppress redefinition message */
  1448. X#endif
  1449. X#include <dbm.h>
  1450. X#ifdef NULL
  1451. X#undef NULL
  1452. X#endif
  1453. X#define NULL 0        /* silly thing is, we don't even use this */
  1454. X#define SOME_DBM
  1455. X#define dbm_fetch(db,dkey) fetch(dkey)
  1456. X#define dbm_delete(db,dkey) delete(dkey)
  1457. X#define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent)
  1458. X#define dbm_close(db) dbmclose()
  1459. X#define dbm_firstkey(db) firstkey()
  1460. X#endif /* HAS_ODBM */
  1461. X#endif /* HAS_NDBM */
  1462. X#endif /* HAS_GDBM */
  1463. X#ifdef SOME_DBM
  1464. XEXT char *dbmkey;
  1465. XEXT int dbmlen;
  1466. X#endif
  1467. X
  1468. X#if INTSIZE == 2
  1469. X#define htoni htons
  1470. X#define ntohi ntohs
  1471. X#else
  1472. X#define htoni htonl
  1473. X#define ntohi ntohl
  1474. X#endif
  1475. X
  1476. X#if defined(I_DIRENT)
  1477. X#   include <dirent.h>
  1478. X#   define DIRENT dirent
  1479. X#else
  1480. X#   ifdef I_SYS_NDIR
  1481. X#    include <sys/ndir.h>
  1482. X#    define DIRENT direct
  1483. X#   else
  1484. X#    ifdef I_SYS_DIR
  1485. X#        ifdef hp9000s500
  1486. X#        include <ndir.h>    /* may be wrong in the future */
  1487. X#        else
  1488. X#        include <sys/dir.h>
  1489. X#        endif
  1490. X#        define DIRENT direct
  1491. X#    endif
  1492. X#   endif
  1493. X#endif
  1494. X
  1495. X/*
  1496. X * The following gobbledygook brought to you on behalf of __STDC__.
  1497. X * (I could just use #ifndef __STDC__, but this is more bulletproof
  1498. X * in the face of half-implementations.)
  1499. X */
  1500. X
  1501. X#ifndef S_IFMT
  1502. X#   ifdef _S_IFMT
  1503. X#    define S_IFMT _S_IFMT
  1504. X#   else
  1505. X#    define S_IFMT 0170000
  1506. X#   endif
  1507. X#endif
  1508. X
  1509. X#ifndef S_ISDIR
  1510. X#   define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
  1511. X#endif
  1512. X
  1513. X#ifndef S_ISCHR
  1514. X#   define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
  1515. X#endif
  1516. X
  1517. X#ifndef S_ISBLK
  1518. X#   ifdef S_IFBLK
  1519. X#    define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
  1520. X#   else
  1521. X#    define S_ISBLK(m) (0)
  1522. X#   endif
  1523. X#endif
  1524. X
  1525. X#ifndef S_ISREG
  1526. X#   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
  1527. X#endif
  1528. X
  1529. X#ifndef S_ISFIFO
  1530. X#   ifdef S_IFIFO
  1531. X#    define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
  1532. X#   else
  1533. X#    define S_ISFIFO(m) (0)
  1534. X#   endif
  1535. X#endif
  1536. X
  1537. X#ifndef S_ISLNK
  1538. X#   ifdef _S_ISLNK
  1539. X#    define S_ISLNK(m) _S_ISLNK(m)
  1540. X#   else
  1541. X#    ifdef _S_IFLNK
  1542. X#        define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
  1543. X#    else
  1544. X#        ifdef S_IFLNK
  1545. X#        define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
  1546. X#        else
  1547. X#        define S_ISLNK(m) (0)
  1548. X#        endif
  1549. X#    endif
  1550. X#   endif
  1551. X#endif
  1552. X
  1553. X#ifndef S_ISSOCK
  1554. X#   ifdef _S_ISSOCK
  1555. X#    define S_ISSOCK(m) _S_ISSOCK(m)
  1556. X#   else
  1557. X#    ifdef _S_IFSOCK
  1558. X#        define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
  1559. X#    else
  1560. X#        ifdef S_IFSOCK
  1561. X#        define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
  1562. X#        else
  1563. X#        define S_ISSOCK(m) (0)
  1564. X#        endif
  1565. X#    endif
  1566. X#   endif
  1567. X#endif
  1568. X
  1569. X#ifndef S_IRUSR
  1570. X#   ifdef S_IREAD
  1571. X#    define S_IRUSR S_IREAD
  1572. X#    define S_IWUSR S_IWRITE
  1573. X#    define S_IXUSR S_IEXEC
  1574. X#   else
  1575. X#    define S_IRUSR 0400
  1576. X#    define S_IWUSR 0200
  1577. X#    define S_IXUSR 0100
  1578. X#   endif
  1579. X#   define S_IRGRP (S_IRUSR>>3)
  1580. X#   define S_IWGRP (S_IWUSR>>3)
  1581. X#   define S_IXGRP (S_IXUSR>>3)
  1582. X#   define S_IROTH (S_IRUSR>>6)
  1583. X#   define S_IWOTH (S_IWUSR>>6)
  1584. X#   define S_IXOTH (S_IXUSR>>6)
  1585. X#endif
  1586. X
  1587. X#ifndef S_ISUID
  1588. X#   define S_ISUID 04000
  1589. X#endif
  1590. X
  1591. X#ifndef S_ISGID
  1592. X#   define S_ISGID 02000
  1593. X#endif
  1594. X
  1595. Xtypedef unsigned int STRLEN;
  1596. X
  1597. Xtypedef struct arg ARG;
  1598. Xtypedef struct cmd CMD;
  1599. Xtypedef struct formcmd FCMD;
  1600. Xtypedef struct scanpat SPAT;
  1601. Xtypedef struct stio STIO;
  1602. Xtypedef struct sub SUBR;
  1603. Xtypedef struct string STR;
  1604. Xtypedef struct atbl ARRAY;
  1605. Xtypedef struct htbl HASH;
  1606. Xtypedef struct regexp REGEXP;
  1607. Xtypedef struct stabptrs STBP;
  1608. Xtypedef struct stab STAB;
  1609. Xtypedef struct callsave CSV;
  1610. X
  1611. X#include "handy.h"
  1612. X#include "regexp.h"
  1613. X#include "str.h"
  1614. X#include "util.h"
  1615. X#include "form.h"
  1616. X#include "stab.h"
  1617. X#include "spat.h"
  1618. X#include "arg.h"
  1619. X#include "cmd.h"
  1620. X#include "array.h"
  1621. X#include "hash.h"
  1622. X
  1623. X#if defined(iAPX286) || defined(M_I286) || defined(I80286)
  1624. X#   define I286
  1625. X#endif
  1626. X
  1627. X#ifndef    __STDC__
  1628. X#ifdef CHARSPRINTF
  1629. X    char *sprintf();
  1630. X#else
  1631. X    int sprintf();
  1632. X#endif
  1633. X#endif
  1634. X
  1635. XEXT char *Yes INIT("1");
  1636. XEXT char *No INIT("");
  1637. X
  1638. X/* "gimme" values */
  1639. X
  1640. X/* Note: cmd.c assumes that it can use && to produce one of these values! */
  1641. X#define G_SCALAR 0
  1642. X#define G_ARRAY 1
  1643. X
  1644. X#ifdef CRIPPLED_CC
  1645. Xint str_true();
  1646. X#else /* !CRIPPLED_CC */
  1647. X#define str_true(str) (Str = (str), \
  1648. X    (Str->str_pok ? \
  1649. X        ((*Str->str_ptr > '0' || \
  1650. X          Str->str_cur > 1 || \
  1651. X          (Str->str_cur && *Str->str_ptr != '0')) ? 1 : 0) \
  1652. X    : \
  1653. X        (Str->str_nok ? (Str->str_u.str_nval != 0.0) : 0 ) ))
  1654. X#endif /* CRIPPLED_CC */
  1655. X
  1656. X#ifdef DEBUGGING
  1657. X#define str_peek(str) (Str = (str), \
  1658. X    (Str->str_pok ? \
  1659. X        Str->str_ptr : \
  1660. X        (Str->str_nok ? \
  1661. X        (sprintf(tokenbuf,"num(%g)",Str->str_u.str_nval), \
  1662. X            (char*)tokenbuf) : \
  1663. X        "" )))
  1664. X#endif
  1665. X
  1666. X#ifdef CRIPPLED_CC
  1667. Xchar *str_get();
  1668. X#else
  1669. X#ifdef TAINT
  1670. X#define str_get(str) (Str = (str), tainted |= Str->str_tainted, \
  1671. X    (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
  1672. X#else
  1673. X#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
  1674. X#endif /* TAINT */
  1675. X#endif /* CRIPPLED_CC */
  1676. X
  1677. X#ifdef CRIPPLED_CC
  1678. Xdouble str_gnum();
  1679. X#else /* !CRIPPLED_CC */
  1680. X#ifdef TAINT
  1681. X#define str_gnum(str) (Str = (str), tainted |= Str->str_tainted, \
  1682. X    (Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
  1683. X#else /* !TAINT */
  1684. X#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
  1685. X#endif /* TAINT*/
  1686. X#endif /* CRIPPLED_CC */
  1687. XEXT STR *Str;
  1688. X
  1689. X#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
  1690. X
  1691. X#ifndef MSDOS
  1692. X#define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len)
  1693. X#define Str_Grow str_grow
  1694. X#else
  1695. X/* extra parentheses intentionally NOT placed around "len"! */
  1696. X#define STR_GROW(str,len) if ((str)->str_len < (unsigned long)len) \
  1697. X        str_grow(str,(unsigned long)len)
  1698. X#define Str_Grow(str,len) str_grow(str,(unsigned long)(len))
  1699. X#endif /* MSDOS */
  1700. X
  1701. X#ifndef BYTEORDER
  1702. X#define BYTEORDER 0x1234
  1703. X#endif
  1704. X
  1705. X#if defined(htonl) && !defined(HAS_HTONL)
  1706. X#define HAS_HTONL
  1707. X#endif
  1708. X#if defined(htons) && !defined(HAS_HTONS)
  1709. X#define HAS_HTONS
  1710. X#endif
  1711. X#if defined(ntohl) && !defined(HAS_NTOHL)
  1712. X#define HAS_NTOHL
  1713. X#endif
  1714. X#if defined(ntohs) && !defined(HAS_NTOHS)
  1715. X#define HAS_NTOHS
  1716. X#endif
  1717. X#ifndef HAS_HTONL
  1718. X#if (BYTEORDER & 0xffff) != 0x4321
  1719. X#define HAS_HTONS
  1720. X#define HAS_HTONL
  1721. X#define HAS_NTOHS
  1722. X#define HAS_NTOHL
  1723. X#define MYSWAP
  1724. X#define htons my_swap
  1725. X#define htonl my_htonl
  1726. X#define ntohs my_swap
  1727. X#define ntohl my_ntohl
  1728. X#endif
  1729. X#else
  1730. X#if (BYTEORDER & 0xffff) == 0x4321
  1731. X#undef HAS_HTONS
  1732. X#undef HAS_HTONL
  1733. X#undef HAS_NTOHS
  1734. X#undef HAS_NTOHL
  1735. X#endif
  1736. X#endif
  1737. X
  1738. X#ifdef CASTNEGFLOAT
  1739. X#define U_S(what) ((unsigned short)(what))
  1740. X#define U_I(what) ((unsigned int)(what))
  1741. X#define U_L(what) ((unsigned long)(what))
  1742. X#else
  1743. Xunsigned long castulong();
  1744. X#define U_S(what) ((unsigned int)castulong(what))
  1745. X#define U_I(what) ((unsigned int)castulong(what))
  1746. X#define U_L(what) (castulong(what))
  1747. X#endif
  1748. X
  1749. XCMD *add_label();
  1750. XCMD *block_head();
  1751. XCMD *append_line();
  1752. XCMD *make_acmd();
  1753. XCMD *make_ccmd();
  1754. XCMD *make_icmd();
  1755. XCMD *invert();
  1756. XCMD *addcond();
  1757. XCMD *addloop();
  1758. XCMD *wopt();
  1759. XCMD *over();
  1760. X
  1761. XSTAB *stabent();
  1762. XSTAB *genstab();
  1763. X
  1764. XARG *stab2arg();
  1765. XARG *op_new();
  1766. XARG *make_op();
  1767. XARG *make_match();
  1768. XARG *make_split();
  1769. XARG *rcatmaybe();
  1770. XARG *listish();
  1771. XARG *maybelistish();
  1772. XARG *localize();
  1773. XARG *fixeval();
  1774. XARG *jmaybe();
  1775. XARG *l();
  1776. XARG *fixl();
  1777. XARG *mod_match();
  1778. XARG *make_list();
  1779. XARG *cmd_to_arg();
  1780. XARG *addflags();
  1781. XARG *hide_ary();
  1782. XARG *cval_to_arg();
  1783. X
  1784. XSTR *str_new();
  1785. XSTR *stab_str();
  1786. X
  1787. Xint do_each();
  1788. Xint do_subr();
  1789. Xint do_match();
  1790. Xint do_unpack();
  1791. Xint eval();        /* this evaluates expressions */
  1792. Xint do_eval();        /* this evaluates eval operator */
  1793. Xint do_assign();
  1794. X
  1795. XSUBR *make_sub();
  1796. X
  1797. XFCMD *load_format();
  1798. X
  1799. Xchar *scanpat();
  1800. Xchar *scansubst();
  1801. Xchar *scantrans();
  1802. Xchar *scanstr();
  1803. Xchar *scanident();
  1804. Xchar *str_append_till();
  1805. Xchar *str_gets();
  1806. Xchar *str_grow();
  1807. X
  1808. Xbool do_open();
  1809. Xbool do_close();
  1810. Xbool do_print();
  1811. Xbool do_aprint();
  1812. Xbool do_exec();
  1813. Xbool do_aexec();
  1814. X
  1815. Xint do_subst();
  1816. Xint cando();
  1817. Xint ingroup();
  1818. X
  1819. Xvoid str_replace();
  1820. Xvoid str_inc();
  1821. Xvoid str_dec();
  1822. Xvoid str_free();
  1823. Xvoid stab_clear();
  1824. Xvoid do_join();
  1825. Xvoid do_sprintf();
  1826. Xvoid do_accept();
  1827. Xvoid do_pipe();
  1828. Xvoid do_vecset();
  1829. Xvoid do_unshift();
  1830. Xvoid do_execfree();
  1831. Xvoid magicalize();
  1832. Xvoid magicname();
  1833. Xvoid savelist();
  1834. Xvoid saveitem();
  1835. Xvoid saveint();
  1836. Xvoid savelong();
  1837. Xvoid savesptr();
  1838. Xvoid savehptr();
  1839. Xvoid restorelist();
  1840. Xvoid repeatcpy();
  1841. XHASH *savehash();
  1842. XARRAY *saveary();
  1843. X
  1844. XEXT char **origargv;
  1845. XEXT int origargc;
  1846. XEXT char **origenviron;
  1847. Xextern char **environ;
  1848. X
  1849. XEXT line_t subline INIT(0);
  1850. XEXT STR *subname INIT(Nullstr);
  1851. XEXT int arybase INIT(0);
  1852. X
  1853. Xstruct outrec {
  1854. X    long    o_lines;
  1855. X    char    *o_str;
  1856. X    int        o_len;
  1857. X};
  1858. X
  1859. XEXT struct outrec outrec;
  1860. XEXT struct outrec toprec;
  1861. X
  1862. XEXT STAB *stdinstab INIT(Nullstab);
  1863. XEXT STAB *last_in_stab INIT(Nullstab);
  1864. XEXT STAB *defstab INIT(Nullstab);
  1865. XEXT STAB *argvstab INIT(Nullstab);
  1866. XEXT STAB *envstab INIT(Nullstab);
  1867. XEXT STAB *sigstab INIT(Nullstab);
  1868. XEXT STAB *defoutstab INIT(Nullstab);
  1869. XEXT STAB *curoutstab INIT(Nullstab);
  1870. XEXT STAB *argvoutstab INIT(Nullstab);
  1871. XEXT STAB *incstab INIT(Nullstab);
  1872. XEXT STAB *leftstab INIT(Nullstab);
  1873. XEXT STAB *amperstab INIT(Nullstab);
  1874. XEXT STAB *rightstab INIT(Nullstab);
  1875. XEXT STAB *DBstab INIT(Nullstab);
  1876. XEXT STAB *DBline INIT(Nullstab);
  1877. XEXT STAB *DBsub INIT(Nullstab);
  1878. X
  1879. XEXT HASH *defstash;        /* main symbol table */
  1880. XEXT HASH *curstash;        /* symbol table for current package */
  1881. XEXT HASH *debstash;        /* symbol table for perldb package */
  1882. X
  1883. XEXT STR *curstname;        /* name of current package */
  1884. X
  1885. XEXT STR *freestrroot INIT(Nullstr);
  1886. XEXT STR *lastretstr INIT(Nullstr);
  1887. XEXT STR *DBsingle INIT(Nullstr);
  1888. XEXT STR *DBtrace INIT(Nullstr);
  1889. XEXT STR *DBsignal INIT(Nullstr);
  1890. X
  1891. XEXT int lastspbase;
  1892. XEXT int lastsize;
  1893. X
  1894. XEXT char *hexdigit INIT("0123456789abcdef0123456789ABCDEF");
  1895. XEXT char *origfilename;
  1896. XEXT FILE * VOLATILE rsfp;
  1897. XEXT char buf[1024];
  1898. XEXT char *bufptr;
  1899. XEXT char *oldbufptr;
  1900. XEXT char *oldoldbufptr;
  1901. XEXT char *bufend;
  1902. X
  1903. XEXT STR *linestr INIT(Nullstr);
  1904. X
  1905. XEXT char *rs INIT("\n");
  1906. XEXT int rschar INIT('\n');    /* final char of rs, or 0777 if none */
  1907. XEXT int rslen INIT(1);
  1908. XEXT char *ofs INIT(Nullch);
  1909. XEXT int ofslen INIT(0);
  1910. XEXT char *ors INIT(Nullch);
  1911. XEXT int orslen INIT(0);
  1912. XEXT char *ofmt INIT(Nullch);
  1913. XEXT char *inplace INIT(Nullch);
  1914. XEXT char *nointrp INIT("");
  1915. X
  1916. XEXT bool preprocess INIT(FALSE);
  1917. XEXT bool minus_n INIT(FALSE);
  1918. XEXT bool minus_p INIT(FALSE);
  1919. XEXT bool minus_l INIT(FALSE);
  1920. XEXT bool minus_a INIT(FALSE);
  1921. XEXT bool doswitches INIT(FALSE);
  1922. XEXT bool dowarn INIT(FALSE);
  1923. XEXT bool doextract INIT(FALSE);
  1924. XEXT bool allstabs INIT(FALSE);    /* init all customary symbols in symbol table?*/
  1925. XEXT bool sawampersand INIT(FALSE);    /* must save all match strings */
  1926. XEXT bool sawstudy INIT(FALSE);        /* do fbminstr on all strings */
  1927. XEXT bool sawi INIT(FALSE);        /* study must assume case insensitive */
  1928. XEXT bool sawvec INIT(FALSE);
  1929. XEXT bool localizing INIT(FALSE);    /* are we processing a local() list? */
  1930. X
  1931. X#ifdef CSH
  1932. Xchar *cshname INIT(CSH);
  1933. Xint cshlen INIT(0);
  1934. X#endif /* CSH */
  1935. X
  1936. X#ifdef TAINT
  1937. XEXT bool tainted INIT(FALSE);        /* using variables controlled by $< */
  1938. X#endif
  1939. X
  1940. X#ifndef MSDOS
  1941. X#define TMPPATH "/tmp/perl-eXXXXXX"
  1942. X#else
  1943. X#define TMPPATH "plXXXXXX"
  1944. X#endif /* MSDOS */
  1945. XEXT char *e_tmpname;
  1946. XEXT FILE *e_fp INIT(Nullfp);
  1947. X
  1948. XEXT char tokenbuf[256];
  1949. XEXT int expectterm INIT(TRUE);        /* how to interpret ambiguous tokens */
  1950. XEXT VOLATILE int in_eval INIT(FALSE);    /* trap fatal errors? */
  1951. XEXT int multiline INIT(0);        /* $*--do strings hold >1 line? */
  1952. XEXT int forkprocess;            /* so do_open |- can return proc# */
  1953. XEXT int do_undump INIT(0);        /* -u or dump seen? */
  1954. XEXT int error_count INIT(0);        /* how many errors so far, max 10 */
  1955. XEXT int multi_start INIT(0);        /* 1st line of multi-line string */
  1956. XEXT int multi_end INIT(0);        /* last line of multi-line string */
  1957. XEXT int multi_open INIT(0);        /* delimiter of said string */
  1958. XEXT int multi_close INIT(0);        /* delimiter of said string */
  1959. X
  1960. XFILE *popen();
  1961. X/* char *str_get(); */
  1962. XSTR *interp();
  1963. Xvoid free_arg();
  1964. XSTIO *stio_new();
  1965. X
  1966. XEXT struct stat statbuf;
  1967. XEXT struct stat statcache;
  1968. XSTAB *statstab INIT(Nullstab);
  1969. XSTR *statname;
  1970. X#ifndef MSDOS
  1971. XEXT struct tms timesbuf;
  1972. X#endif
  1973. XEXT int uid;
  1974. XEXT int euid;
  1975. XEXT int gid;
  1976. XEXT int egid;
  1977. XUIDTYPE getuid();
  1978. XUIDTYPE geteuid();
  1979. XGIDTYPE getgid();
  1980. XGIDTYPE getegid();
  1981. XEXT int unsafe;
  1982. X
  1983. X#ifdef DEBUGGING
  1984. XEXT VOLATILE int debug INIT(0);
  1985. XEXT int dlevel INIT(0);
  1986. XEXT int dlmax INIT(128);
  1987. XEXT char *debname;
  1988. XEXT char *debdelim;
  1989. X#define YYDEBUG 1
  1990. X#endif
  1991. XEXT int perldb INIT(0);
  1992. X#define YYMAXDEPTH 300
  1993. X
  1994. XEXT line_t cmdline INIT(NOLINE);
  1995. X
  1996. XEXT STR str_undef;
  1997. XEXT STR str_no;
  1998. XEXT STR str_yes;
  1999. X
  2000. X/* runtime control stuff */
  2001. X
  2002. XEXT struct loop {
  2003. X    char *loop_label;        /* what the loop was called, if anything */
  2004. X    int loop_sp;        /* stack pointer to copy stuff down to */
  2005. X    jmp_buf loop_env;
  2006. X} *loop_stack;
  2007. X
  2008. XEXT int loop_ptr INIT(-1);
  2009. XEXT int loop_max INIT(128);
  2010. X
  2011. XEXT jmp_buf top_env;
  2012. X
  2013. XEXT char * VOLATILE goto_targ INIT(Nullch); /* cmd_exec gets strange when set */
  2014. X
  2015. Xstruct ufuncs {
  2016. X    int (*uf_val)();
  2017. X    int (*uf_set)();
  2018. X    int uf_index;
  2019. X};
  2020. X
  2021. XEXT ARRAY *stack;        /* THE STACK */
  2022. X
  2023. XEXT ARRAY * VOLATILE savestack;        /* to save non-local values on */
  2024. X
  2025. XEXT ARRAY *tosave;        /* strings to save on recursive subroutine */
  2026. X
  2027. XEXT ARRAY *lineary;        /* lines of script for debugger */
  2028. XEXT ARRAY *dbargs;        /* args to call listed by caller function */
  2029. X
  2030. XEXT ARRAY *fdpid;        /* keep fd-to-pid mappings for mypopen */
  2031. XEXT HASH *pidstatus;        /* keep pid-to-status mappings for waitpid */
  2032. X
  2033. XEXT int *di;            /* for tmp use in debuggers */
  2034. XEXT char *dc;
  2035. XEXT short *ds;
  2036. X
  2037. X/* Fix these up for __STDC__ */
  2038. XEXT long basetime INIT(0);
  2039. Xchar *mktemp();
  2040. X#ifndef __STDC__
  2041. X/* All of these are in stdlib.h or time.h for ANSI C */
  2042. Xdouble atof();
  2043. Xlong time();
  2044. Xstruct tm *gmtime(), *localtime();
  2045. Xchar *index(), *rindex();
  2046. Xchar *strcpy(), *strcat();
  2047. X#endif /* ! __STDC__ */
  2048. X
  2049. X#ifdef EUNICE
  2050. X#define UNLINK unlnk
  2051. Xint unlnk();
  2052. X#else
  2053. X#define UNLINK unlink
  2054. X#endif
  2055. X
  2056. X#ifndef HAS_SETREUID
  2057. X#ifdef HAS_SETRESUID
  2058. X#define setreuid(r,e) setresuid(r,e,-1)
  2059. X#define HAS_SETREUID
  2060. X#endif
  2061. X#endif
  2062. X#ifndef HAS_SETREGID
  2063. X#ifdef HAS_SETRESGID
  2064. X#define setregid(r,e) setresgid(r,e,-1)
  2065. X#define HAS_SETREGID
  2066. X#endif
  2067. X#endif
  2068. !STUFFY!FUNK!
  2069. echo Extracting patchlevel.h
  2070. sed >patchlevel.h <<'!STUFFY!FUNK!' -e 's/X//'
  2071. X#define PATCHLEVEL 3
  2072. !STUFFY!FUNK!
  2073. echo " "
  2074. echo "End of kit 19 (of 36)"
  2075. cat /dev/null >kit19isdone
  2076. run=''
  2077. config=''
  2078. for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36; do
  2079.     if test -f kit${iskit}isdone; then
  2080.     run="$run $iskit"
  2081.     else
  2082.     todo="$todo $iskit"
  2083.     fi
  2084. done
  2085. case $todo in
  2086.     '')
  2087.     echo "You have run all your kits.  Please read README and then type Configure."
  2088.     for combo in *:AA; do
  2089.         if test -f "$combo"; then
  2090.         realfile=`basename $combo :AA`
  2091.         cat $realfile:[A-Z][A-Z] >$realfile
  2092.         rm -rf $realfile:[A-Z][A-Z]
  2093.         fi
  2094.     done
  2095.     rm -rf kit*isdone
  2096.     chmod 755 Configure
  2097.     ;;
  2098.     *)  echo "You have run$run."
  2099.     echo "You still need to run$todo."
  2100.     ;;
  2101. esac
  2102. : Someone might mail this, so...
  2103. exit
  2104.  
  2105. exit 0 # Just in case...
  2106. -- 
  2107. Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
  2108. Sterling Software, IMD           UUCP:     uunet!sparky!kent
  2109. Phone:    (402) 291-8300         FAX:      (402) 291-4362
  2110. Please send comp.sources.misc-related mail to kent@uunet.uu.net.
  2111.