home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume13 / perl / part03 < prev    next >
Encoding:
Internet Message Format  |  1988-01-30  |  50.0 KB
  1. Subject:  v13i003:  Perl, a "replacement" for awk and sed, Part03/10
  2. Newsgroups: comp.sources.unix
  3. Sender: sources
  4. Approved: rsalz@uunet.UU.NET
  5.  
  6. Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
  7. Posting-number: Volume 13, Issue 3
  8. Archive-name: perl/part03
  9.  
  10.  
  11.  
  12. #! /bin/sh
  13.  
  14. # Make a new directory for the perl sources, cd to it, and run kits 1
  15. # thru 10 through sh.  When all 10 kits have been run, read README.
  16.  
  17. echo "This is perl 1.0 kit 3 (of 10).  If kit 3 is complete, the line"
  18. echo '"'"End of kit 3 (of 10)"'" will echo at the end.'
  19. echo ""
  20. export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
  21. echo Extracting arg.c
  22. sed >arg.c <<'!STUFFY!FUNK!' -e 's/X//'
  23. X/* $Header: arg.c,v 1.0 87/12/18 13:04:33 root Exp $
  24. X *
  25. X * $Log:    arg.c,v $
  26. X * Revision 1.0  87/12/18  13:04:33  root
  27. X * Initial revision
  28. X * 
  29. X */
  30. X
  31. X#include <signal.h>
  32. X#include "handy.h"
  33. X#include "EXTERN.h"
  34. X#include "search.h"
  35. X#include "util.h"
  36. X#include "perl.h"
  37. X
  38. XARG *debarg;
  39. X
  40. Xbool
  41. Xdo_match(s,arg)
  42. Xregister char *s;
  43. Xregister ARG *arg;
  44. X{
  45. X    register SPAT *spat = arg[2].arg_ptr.arg_spat;
  46. X    register char *d;
  47. X    register char *t;
  48. X
  49. X    if (!spat || !s)
  50. X    fatal("panic: do_match\n");
  51. X    if (spat->spat_flags & SPAT_USED) {
  52. X#ifdef DEBUGGING
  53. X    if (debug & 8)
  54. X        deb("2.SPAT USED\n");
  55. X#endif
  56. X    return FALSE;
  57. X    }
  58. X    if (spat->spat_runtime) {
  59. X    t = str_get(eval(spat->spat_runtime,Null(STR***)));
  60. X#ifdef DEBUGGING
  61. X    if (debug & 8)
  62. X        deb("2.SPAT /%s/\n",t);
  63. X#endif
  64. X    if (d = compile(&spat->spat_compex,t,TRUE,FALSE)) {
  65. X#ifdef DEBUGGING
  66. X        deb("/%s/: %s\n", t, d);
  67. X#endif
  68. X        return FALSE;
  69. X    }
  70. X    if (spat->spat_compex.complen <= 1 && curspat)
  71. X        spat = curspat;
  72. X    if (execute(&spat->spat_compex, s, TRUE, 0)) {
  73. X        if (spat->spat_compex.numsubs)
  74. X        curspat = spat;
  75. X        return TRUE;
  76. X    }
  77. X    else
  78. X        return FALSE;
  79. X    }
  80. X    else {
  81. X#ifdef DEBUGGING
  82. X    if (debug & 8) {
  83. X        char ch;
  84. X
  85. X        if (spat->spat_flags & SPAT_USE_ONCE)
  86. X        ch = '?';
  87. X        else
  88. X        ch = '/';
  89. X        deb("2.SPAT %c%s%c\n",ch,spat->spat_compex.precomp,ch);
  90. X    }
  91. X#endif
  92. X    if (spat->spat_compex.complen <= 1 && curspat)
  93. X        spat = curspat;
  94. X    if (spat->spat_first) {
  95. X        if (spat->spat_flags & SPAT_SCANFIRST) {
  96. X        str_free(spat->spat_first);
  97. X        spat->spat_first = Nullstr;    /* disable optimization */
  98. X        }
  99. X        else if (*spat->spat_first->str_ptr != *s ||
  100. X          strnNE(spat->spat_first->str_ptr, s, spat->spat_flen) )
  101. X        return FALSE;
  102. X    }
  103. X    if (execute(&spat->spat_compex, s, TRUE, 0)) {
  104. X        if (spat->spat_compex.numsubs)
  105. X        curspat = spat;
  106. X        if (spat->spat_flags & SPAT_USE_ONCE)
  107. X        spat->spat_flags |= SPAT_USED;
  108. X        return TRUE;
  109. X    }
  110. X    else
  111. X        return FALSE;
  112. X    }
  113. X    /*NOTREACHED*/
  114. X}
  115. X
  116. Xint
  117. Xdo_subst(str,arg)
  118. XSTR *str;
  119. Xregister ARG *arg;
  120. X{
  121. X    register SPAT *spat;
  122. X    register STR *dstr;
  123. X    register char *s;
  124. X    register char *m;
  125. X
  126. X    spat = arg[2].arg_ptr.arg_spat;
  127. X    s = str_get(str);
  128. X    if (!spat || !s)
  129. X    fatal("panic: do_subst\n");
  130. X    else if (spat->spat_runtime) {
  131. X    char *d;
  132. X
  133. X    m = str_get(eval(spat->spat_runtime,Null(STR***)));
  134. X    if (d = compile(&spat->spat_compex,m,TRUE,FALSE)) {
  135. X#ifdef DEBUGGING
  136. X        deb("/%s/: %s\n", m, d);
  137. X#endif
  138. X        return 0;
  139. X    }
  140. X    }
  141. X#ifdef DEBUGGING
  142. X    if (debug & 8) {
  143. X    deb("2.SPAT /%s/\n",spat->spat_compex.precomp);
  144. X    }
  145. X#endif
  146. X    if (spat->spat_compex.complen <= 1 && curspat)
  147. X    spat = curspat;
  148. X    if (spat->spat_first) {
  149. X    if (spat->spat_flags & SPAT_SCANFIRST) {
  150. X        str_free(spat->spat_first);
  151. X        spat->spat_first = Nullstr;    /* disable optimization */
  152. X    }
  153. X    else if (*spat->spat_first->str_ptr != *s ||
  154. X      strnNE(spat->spat_first->str_ptr, s, spat->spat_flen) )
  155. X        return 0;
  156. X    }
  157. X    if (m = execute(&spat->spat_compex, s, TRUE, 1)) {
  158. X    int iters = 0;
  159. X
  160. X    dstr = str_new(str_len(str));
  161. X    if (spat->spat_compex.numsubs)
  162. X        curspat = spat;
  163. X    do {
  164. X        if (iters++ > 10000)
  165. X        fatal("Substitution loop?\n");
  166. X        if (spat->spat_compex.numsubs)
  167. X        s = spat->spat_compex.subbase;
  168. X        str_ncat(dstr,s,m-s);
  169. X        s = spat->spat_compex.subend[0];
  170. X        str_scat(dstr,eval(spat->spat_repl,Null(STR***)));
  171. X        if (spat->spat_flags & SPAT_USE_ONCE)
  172. X        break;
  173. X    } while (m = execute(&spat->spat_compex, s, FALSE, 1));
  174. X    str_cat(dstr,s);
  175. X    str_replace(str,dstr);
  176. X    STABSET(str);
  177. X    return iters;
  178. X    }
  179. X    return 0;
  180. X}
  181. X
  182. Xint
  183. Xdo_trans(str,arg)
  184. XSTR *str;
  185. Xregister ARG *arg;
  186. X{
  187. X    register char *tbl;
  188. X    register char *s;
  189. X    register int matches = 0;
  190. X    register int ch;
  191. X
  192. X    tbl = arg[2].arg_ptr.arg_cval;
  193. X    s = str_get(str);
  194. X    if (!tbl || !s)
  195. X    fatal("panic: do_trans\n");
  196. X#ifdef DEBUGGING
  197. X    if (debug & 8) {
  198. X    deb("2.TBL\n");
  199. X    }
  200. X#endif
  201. X    while (*s) {
  202. X    if (ch = tbl[*s & 0377]) {
  203. X        matches++;
  204. X        *s = ch;
  205. X    }
  206. X    s++;
  207. X    }
  208. X    STABSET(str);
  209. X    return matches;
  210. X}
  211. X
  212. Xint
  213. Xdo_split(s,spat,retary)
  214. Xregister char *s;
  215. Xregister SPAT *spat;
  216. XSTR ***retary;
  217. X{
  218. X    register STR *dstr;
  219. X    register char *m;
  220. X    register ARRAY *ary;
  221. X    static ARRAY *myarray = Null(ARRAY*);
  222. X    int iters = 0;
  223. X    STR **sarg;
  224. X    register char *e;
  225. X    int i;
  226. X
  227. X    if (!spat || !s)
  228. X    fatal("panic: do_split\n");
  229. X    else if (spat->spat_runtime) {
  230. X    char *d;
  231. X
  232. X    m = str_get(eval(spat->spat_runtime,Null(STR***)));
  233. X    if (d = compile(&spat->spat_compex,m,TRUE,FALSE)) {
  234. X#ifdef DEBUGGING
  235. X        deb("/%s/: %s\n", m, d);
  236. X#endif
  237. X        return FALSE;
  238. X    }
  239. X    }
  240. X#ifdef DEBUGGING
  241. X    if (debug & 8) {
  242. X    deb("2.SPAT /%s/\n",spat->spat_compex.precomp);
  243. X    }
  244. X#endif
  245. X    if (retary)
  246. X    ary = myarray;
  247. X    else
  248. X    ary = spat->spat_repl[1].arg_ptr.arg_stab->stab_array;
  249. X    if (!ary)
  250. X    myarray = ary = anew();
  251. X    ary->ary_fill = -1;
  252. X    while (*s && (m = execute(&spat->spat_compex, s, (iters == 0), 1))) {
  253. X    if (spat->spat_compex.numsubs)
  254. X        s = spat->spat_compex.subbase;
  255. X    dstr = str_new(m-s);
  256. X    str_nset(dstr,s,m-s);
  257. X    astore(ary, iters++, dstr);
  258. X    if (iters > 10000)
  259. X        fatal("Substitution loop?\n");
  260. X    s = spat->spat_compex.subend[0];
  261. X    }
  262. X    if (*s) {            /* ignore field after final "whitespace" */
  263. X    dstr = str_new(0);    /*   if they interpolate, it's null anyway */
  264. X    str_set(dstr,s);
  265. X    astore(ary, iters++, dstr);
  266. X    }
  267. X    else {
  268. X    while (iters > 0 && !*str_get(afetch(ary,iters-1)))
  269. X        iters--;
  270. X    }
  271. X    if (retary) {
  272. X    sarg = (STR**)safemalloc((iters+2)*sizeof(STR*));
  273. X
  274. X    sarg[0] = Nullstr;
  275. X    sarg[iters+1] = Nullstr;
  276. X    for (i = 1; i <= iters; i++)
  277. X        sarg[i] = afetch(ary,i-1);
  278. X    *retary = sarg;
  279. X    }
  280. X    return iters;
  281. X}
  282. X
  283. Xvoid
  284. Xdo_join(arg,delim,str)
  285. Xregister ARG *arg;
  286. Xregister char *delim;
  287. Xregister STR *str;
  288. X{
  289. X    STR **tmpary;    /* must not be register */
  290. X    register STR **elem;
  291. X
  292. X    (void)eval(arg[2].arg_ptr.arg_arg,&tmpary);
  293. X    elem = tmpary+1;
  294. X    if (*elem)
  295. X    str_sset(str,*elem++);
  296. X    for (; *elem; elem++) {
  297. X    str_cat(str,delim);
  298. X    str_scat(str,*elem);
  299. X    }
  300. X    STABSET(str);
  301. X    safefree((char*)tmpary);
  302. X}
  303. X
  304. Xbool
  305. Xdo_open(stab,name)
  306. XSTAB *stab;
  307. Xregister char *name;
  308. X{
  309. X    FILE *fp;
  310. X    int len = strlen(name);
  311. X    register STIO *stio = stab->stab_io;
  312. X
  313. X    while (len && isspace(name[len-1]))
  314. X    name[--len] = '\0';
  315. X    if (!stio)
  316. X    stio = stab->stab_io = stio_new();
  317. X    if (stio->fp) {
  318. X    if (stio->type == '|')
  319. X        pclose(stio->fp);
  320. X    else if (stio->type != '-')
  321. X        fclose(stio->fp);
  322. X    stio->fp = Nullfp;
  323. X    }
  324. X    stio->type = *name;
  325. X    if (*name == '|') {
  326. X    for (name++; isspace(*name); name++) ;
  327. X    fp = popen(name,"w");
  328. X    }
  329. X    else if (*name == '>' && name[1] == '>') {
  330. X    for (name += 2; isspace(*name); name++) ;
  331. X    fp = fopen(name,"a");
  332. X    }
  333. X    else if (*name == '>') {
  334. X    for (name++; isspace(*name); name++) ;
  335. X    if (strEQ(name,"-")) {
  336. X        fp = stdout;
  337. X        stio->type = '-';
  338. X    }
  339. X    else
  340. X        fp = fopen(name,"w");
  341. X    }
  342. X    else {
  343. X    if (*name == '<') {
  344. X        for (name++; isspace(*name); name++) ;
  345. X        if (strEQ(name,"-")) {
  346. X        fp = stdin;
  347. X        stio->type = '-';
  348. X        }
  349. X        else
  350. X        fp = fopen(name,"r");
  351. X    }
  352. X    else if (name[len-1] == '|') {
  353. X        name[--len] = '\0';
  354. X        while (len && isspace(name[len-1]))
  355. X        name[--len] = '\0';
  356. X        for (; isspace(*name); name++) ;
  357. X        fp = popen(name,"r");
  358. X        stio->type = '|';
  359. X    }
  360. X    else {
  361. X        stio->type = '<';
  362. X        for (; isspace(*name); name++) ;
  363. X        if (strEQ(name,"-")) {
  364. X        fp = stdin;
  365. X        stio->type = '-';
  366. X        }
  367. X        else
  368. X        fp = fopen(name,"r");
  369. X    }
  370. X    }
  371. X    if (!fp)
  372. X    return FALSE;
  373. X    if (stio->type != '|' && stio->type != '-') {
  374. X    if (fstat(fileno(fp),&statbuf) < 0) {
  375. X        fclose(fp);
  376. X        return FALSE;
  377. X    }
  378. X    if ((statbuf.st_mode & S_IFMT) != S_IFREG &&
  379. X        (statbuf.st_mode & S_IFMT) != S_IFCHR) {
  380. X        fclose(fp);
  381. X        return FALSE;
  382. X    }
  383. X    }
  384. X    stio->fp = fp;
  385. X    return TRUE;
  386. X}
  387. X
  388. XFILE *
  389. Xnextargv(stab)
  390. Xregister STAB *stab;
  391. X{
  392. X    register STR *str;
  393. X    char *oldname;
  394. X
  395. X    while (alen(stab->stab_array) >= 0L) {
  396. X    str = ashift(stab->stab_array);
  397. X    str_sset(stab->stab_val,str);
  398. X    STABSET(stab->stab_val);
  399. X    oldname = str_get(stab->stab_val);
  400. X    if (do_open(stab,oldname)) {
  401. X        if (inplace) {
  402. X        if (*inplace) {
  403. X            str_cat(str,inplace);
  404. X#ifdef RENAME
  405. X            rename(oldname,str->str_ptr);
  406. X#else
  407. X            UNLINK(str->str_ptr);
  408. X            link(oldname,str->str_ptr);
  409. X            UNLINK(oldname);
  410. X#endif
  411. X        }
  412. X        sprintf(tokenbuf,">%s",oldname);
  413. X        do_open(argvoutstab,tokenbuf);
  414. X        defoutstab = argvoutstab;
  415. X        }
  416. X        str_free(str);
  417. X        return stab->stab_io->fp;
  418. X    }
  419. X    else
  420. X        fprintf(stderr,"Can't open %s\n",str_get(str));
  421. X    str_free(str);
  422. X    }
  423. X    if (inplace) {
  424. X    do_close(argvoutstab,FALSE);
  425. X    defoutstab = stabent("stdout",TRUE);
  426. X    }
  427. X    return Nullfp;
  428. X}
  429. X
  430. Xbool
  431. Xdo_close(stab,explicit)
  432. XSTAB *stab;
  433. Xbool explicit;
  434. X{
  435. X    bool retval = FALSE;
  436. X    register STIO *stio = stab->stab_io;
  437. X
  438. X    if (!stio)        /* never opened */
  439. X    return FALSE;
  440. X    if (stio->fp) {
  441. X    if (stio->type == '|')
  442. X        retval = (pclose(stio->fp) >= 0);
  443. X    else if (stio->type == '-')
  444. X        retval = TRUE;
  445. X    else
  446. X        retval = (fclose(stio->fp) != EOF);
  447. X    stio->fp = Nullfp;
  448. X    }
  449. X    if (explicit)
  450. X    stio->lines = 0;
  451. X    stio->type = ' ';
  452. X    return retval;
  453. X}
  454. X
  455. Xbool
  456. Xdo_eof(stab)
  457. XSTAB *stab;
  458. X{
  459. X    register STIO *stio;
  460. X    int ch;
  461. X
  462. X    if (!stab)
  463. X    return TRUE;
  464. X
  465. X    stio = stab->stab_io;
  466. X    if (!stio)
  467. X    return TRUE;
  468. X
  469. X    while (stio->fp) {
  470. X
  471. X#ifdef STDSTDIO            /* (the code works without this) */
  472. X    if (stio->fp->_cnt)        /* cheat a little, since */
  473. X        return FALSE;        /* this is the most usual case */
  474. X#endif
  475. X
  476. X    ch = getc(stio->fp);
  477. X    if (ch != EOF) {
  478. X        ungetc(ch, stio->fp);
  479. X        return FALSE;
  480. X    }
  481. X    if (stio->flags & IOF_ARGV) {    /* not necessarily a real EOF yet? */
  482. X        if (!nextargv(stab))    /* get another fp handy */
  483. X        return TRUE;
  484. X    }
  485. X    else
  486. X        return TRUE;        /* normal fp, definitely end of file */
  487. X    }
  488. X    return TRUE;
  489. X}
  490. X
  491. Xlong
  492. Xdo_tell(stab)
  493. XSTAB *stab;
  494. X{
  495. X    register STIO *stio;
  496. X    int ch;
  497. X
  498. X    if (!stab)
  499. X    return -1L;
  500. X
  501. X    stio = stab->stab_io;
  502. X    if (!stio || !stio->fp)
  503. X    return -1L;
  504. X
  505. X    return ftell(stio->fp);
  506. X}
  507. X
  508. Xbool
  509. Xdo_seek(stab, pos, whence)
  510. XSTAB *stab;
  511. Xlong pos;
  512. Xint whence;
  513. X{
  514. X    register STIO *stio;
  515. X
  516. X    if (!stab)
  517. X    return FALSE;
  518. X
  519. X    stio = stab->stab_io;
  520. X    if (!stio || !stio->fp)
  521. X    return FALSE;
  522. X
  523. X    return fseek(stio->fp, pos, whence) >= 0;
  524. X}
  525. X
  526. Xdo_stat(arg,sarg,retary)
  527. Xregister ARG *arg;
  528. Xregister STR **sarg;
  529. XSTR ***retary;
  530. X{
  531. X    register ARRAY *ary;
  532. X    static ARRAY *myarray = Null(ARRAY*);
  533. X    int max = 13;
  534. X    register int i;
  535. X
  536. X    ary = myarray;
  537. X    if (!ary)
  538. X    myarray = ary = anew();
  539. X    ary->ary_fill = -1;
  540. X    if (arg[1].arg_type == A_LVAL) {
  541. X    tmpstab = arg[1].arg_ptr.arg_stab;
  542. X    if (!tmpstab->stab_io ||
  543. X      fstat(fileno(tmpstab->stab_io->fp),&statbuf) < 0) {
  544. X        max = 0;
  545. X    }
  546. X    }
  547. X    else
  548. X    if (stat(str_get(sarg[1]),&statbuf) < 0)
  549. X        max = 0;
  550. X
  551. X    if (retary) {
  552. X    if (max) {
  553. X        apush(ary,str_nmake((double)statbuf.st_dev));
  554. X        apush(ary,str_nmake((double)statbuf.st_ino));
  555. X        apush(ary,str_nmake((double)statbuf.st_mode));
  556. X        apush(ary,str_nmake((double)statbuf.st_nlink));
  557. X        apush(ary,str_nmake((double)statbuf.st_uid));
  558. X        apush(ary,str_nmake((double)statbuf.st_gid));
  559. X        apush(ary,str_nmake((double)statbuf.st_rdev));
  560. X        apush(ary,str_nmake((double)statbuf.st_size));
  561. X        apush(ary,str_nmake((double)statbuf.st_atime));
  562. X        apush(ary,str_nmake((double)statbuf.st_mtime));
  563. X        apush(ary,str_nmake((double)statbuf.st_ctime));
  564. X        apush(ary,str_nmake((double)statbuf.st_blksize));
  565. X        apush(ary,str_nmake((double)statbuf.st_blocks));
  566. X    }
  567. X    sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
  568. X    sarg[0] = Nullstr;
  569. X    sarg[max+1] = Nullstr;
  570. X    for (i = 1; i <= max; i++)
  571. X        sarg[i] = afetch(ary,i-1);
  572. X    *retary = sarg;
  573. X    }
  574. X    return max;
  575. X}
  576. X
  577. Xdo_tms(retary)
  578. XSTR ***retary;
  579. X{
  580. X    register ARRAY *ary;
  581. X    static ARRAY *myarray = Null(ARRAY*);
  582. X    register STR **sarg;
  583. X    int max = 4;
  584. X    register int i;
  585. X
  586. X    ary = myarray;
  587. X    if (!ary)
  588. X    myarray = ary = anew();
  589. X    ary->ary_fill = -1;
  590. X    if (times(×buf) < 0)
  591. X    max = 0;
  592. X
  593. X    if (retary) {
  594. X    if (max) {
  595. X        apush(ary,str_nmake(((double)timesbuf.tms_utime)/60.0));
  596. X        apush(ary,str_nmake(((double)timesbuf.tms_stime)/60.0));
  597. X        apush(ary,str_nmake(((double)timesbuf.tms_cutime)/60.0));
  598. X        apush(ary,str_nmake(((double)timesbuf.tms_cstime)/60.0));
  599. X    }
  600. X    sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
  601. X    sarg[0] = Nullstr;
  602. X    sarg[max+1] = Nullstr;
  603. X    for (i = 1; i <= max; i++)
  604. X        sarg[i] = afetch(ary,i-1);
  605. X    *retary = sarg;
  606. X    }
  607. X    return max;
  608. X}
  609. X
  610. Xdo_time(tmbuf,retary)
  611. Xstruct tm *tmbuf;
  612. XSTR ***retary;
  613. X{
  614. X    register ARRAY *ary;
  615. X    static ARRAY *myarray = Null(ARRAY*);
  616. X    register STR **sarg;
  617. X    int max = 9;
  618. X    register int i;
  619. X    STR *str;
  620. X
  621. X    ary = myarray;
  622. X    if (!ary)
  623. X    myarray = ary = anew();
  624. X    ary->ary_fill = -1;
  625. X    if (!tmbuf)
  626. X    max = 0;
  627. X
  628. X    if (retary) {
  629. X    if (max) {
  630. X        apush(ary,str_nmake((double)tmbuf->tm_sec));
  631. X        apush(ary,str_nmake((double)tmbuf->tm_min));
  632. X        apush(ary,str_nmake((double)tmbuf->tm_hour));
  633. X        apush(ary,str_nmake((double)tmbuf->tm_mday));
  634. X        apush(ary,str_nmake((double)tmbuf->tm_mon));
  635. X        apush(ary,str_nmake((double)tmbuf->tm_year));
  636. X        apush(ary,str_nmake((double)tmbuf->tm_wday));
  637. X        apush(ary,str_nmake((double)tmbuf->tm_yday));
  638. X        apush(ary,str_nmake((double)tmbuf->tm_isdst));
  639. X    }
  640. X    sarg = (STR**)safemalloc((max+2)*sizeof(STR*));
  641. X    sarg[0] = Nullstr;
  642. X    sarg[max+1] = Nullstr;
  643. X    for (i = 1; i <= max; i++)
  644. X        sarg[i] = afetch(ary,i-1);
  645. X    *retary = sarg;
  646. X    }
  647. X    return max;
  648. X}
  649. X
  650. Xvoid
  651. Xdo_sprintf(str,len,sarg)
  652. Xregister STR *str;
  653. Xregister int len;
  654. Xregister STR **sarg;
  655. X{
  656. X    register char *s;
  657. X    register char *t;
  658. X    bool dolong;
  659. X    char ch;
  660. X
  661. X    str_set(str,"");
  662. X    len--;            /* don't count pattern string */
  663. X    sarg++;
  664. X    for (s = str_get(*(sarg++)); *sarg && *s && len; len--) {
  665. X    dolong = FALSE;
  666. X    for (t = s; *t && *t != '%'; t++) ;
  667. X    if (!*t)
  668. X        break;        /* not enough % patterns, oh well */
  669. X    for (t++; *sarg && *t && t != s; t++) {
  670. X        switch (*t) {
  671. X        case '\0':
  672. X        break;
  673. X        case '%':
  674. X        ch = *(++t);
  675. X        *t = '\0';
  676. X        sprintf(buf,s);
  677. X        s = t;
  678. X        *(t--) = ch;
  679. X        break;
  680. X        case 'l':
  681. X        dolong = TRUE;
  682. X        break;
  683. X        case 'D': case 'X': case 'O':
  684. X        dolong = TRUE;
  685. X        /* FALL THROUGH */
  686. X        case 'd': case 'x': case 'o': case 'c':
  687. X        ch = *(++t);
  688. X        *t = '\0';
  689. X        if (dolong)
  690. X            sprintf(buf,s,(long)str_gnum(*(sarg++)));
  691. X        else
  692. X            sprintf(buf,s,(int)str_gnum(*(sarg++)));
  693. X        s = t;
  694. X        *(t--) = ch;
  695. X        break;
  696. X        case 'E': case 'e': case 'f': case 'G': case 'g':
  697. X        ch = *(++t);
  698. X        *t = '\0';
  699. X        sprintf(buf,s,str_gnum(*(sarg++)));
  700. X        s = t;
  701. X        *(t--) = ch;
  702. X        break;
  703. X        case 's':
  704. X        ch = *(++t);
  705. X        *t = '\0';
  706. X        sprintf(buf,s,str_get(*(sarg++)));
  707. X        s = t;
  708. X        *(t--) = ch;
  709. X        break;
  710. X        }
  711. X    }
  712. X    str_cat(str,buf);
  713. X    }
  714. X    if (*s)
  715. X    str_cat(str,s);
  716. X    STABSET(str);
  717. X}
  718. X
  719. Xbool
  720. Xdo_print(s,fp)
  721. Xchar *s;
  722. XFILE *fp;
  723. X{
  724. X    if (!fp || !s)
  725. X    return FALSE;
  726. X    fputs(s,fp);
  727. X    return TRUE;
  728. X}
  729. X
  730. Xbool
  731. Xdo_aprint(arg,fp)
  732. Xregister ARG *arg;
  733. Xregister FILE *fp;
  734. X{
  735. X    STR **tmpary;    /* must not be register */
  736. X    register STR **elem;
  737. X    register bool retval;
  738. X    double value;
  739. X
  740. X    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
  741. X    if (arg->arg_type == O_PRTF) {
  742. X    do_sprintf(arg->arg_ptr.arg_str,32767,tmpary);
  743. X    retval = do_print(str_get(arg->arg_ptr.arg_str),fp);
  744. X    }
  745. X    else {
  746. X    retval = FALSE;
  747. X    for (elem = tmpary+1; *elem; elem++) {
  748. X        if (retval && ofs)
  749. X        do_print(ofs, fp);
  750. X        if (ofmt && fp) {
  751. X        if ((*elem)->str_nok || str_gnum(*elem) != 0.0)
  752. X            fprintf(fp, ofmt, str_gnum(*elem));
  753. X        retval = TRUE;
  754. X        }
  755. X        else
  756. X        retval = do_print(str_get(*elem), fp);
  757. X        if (!retval)
  758. X        break;
  759. X    }
  760. X    if (ors)
  761. X        retval = do_print(ors, fp);
  762. X    }
  763. X    safefree((char*)tmpary);
  764. X    return retval;
  765. X}
  766. X
  767. Xbool
  768. Xdo_aexec(arg)
  769. Xregister ARG *arg;
  770. X{
  771. X    STR **tmpary;    /* must not be register */
  772. X    register STR **elem;
  773. X    register char **a;
  774. X    register int i;
  775. X    char **argv;
  776. X
  777. X    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
  778. X    i = 0;
  779. X    for (elem = tmpary+1; *elem; elem++)
  780. X    i++;
  781. X    if (i) {
  782. X    argv = (char**)safemalloc((i+1)*sizeof(char*));
  783. X    a = argv;
  784. X    for (elem = tmpary+1; *elem; elem++) {
  785. X        *a++ = str_get(*elem);
  786. X    }
  787. X    *a = Nullch;
  788. X    execvp(argv[0],argv);
  789. X    safefree((char*)argv);
  790. X    }
  791. X    safefree((char*)tmpary);
  792. X    return FALSE;
  793. X}
  794. X
  795. Xbool
  796. Xdo_exec(cmd)
  797. Xchar *cmd;
  798. X{
  799. X    STR **tmpary;    /* must not be register */
  800. X    register char **a;
  801. X    register char *s;
  802. X    char **argv;
  803. X
  804. X    /* see if there are shell metacharacters in it */
  805. X
  806. X    for (s = cmd; *s; s++) {
  807. X    if (*s != ' ' && !isalpha(*s) && index("$&*(){}[]'\";\\|?<>~`",*s)) {
  808. X        execl("/bin/sh","sh","-c",cmd,0);
  809. X        return FALSE;
  810. X    }
  811. X    }
  812. X    argv = (char**)safemalloc(((s - cmd) / 2 + 2)*sizeof(char*));
  813. X
  814. X    a = argv;
  815. X    for (s = cmd; *s;) {
  816. X    while (isspace(*s)) s++;
  817. X    if (*s)
  818. X        *(a++) = s;
  819. X    while (*s && !isspace(*s)) s++;
  820. X    if (*s)
  821. X        *s++ = '\0';
  822. X    }
  823. X    *a = Nullch;
  824. X    if (argv[0])
  825. X    execvp(argv[0],argv);
  826. X    safefree((char*)argv);
  827. X    return FALSE;
  828. X}
  829. X
  830. XSTR *
  831. Xdo_push(arg,ary)
  832. Xregister ARG *arg;
  833. Xregister ARRAY *ary;
  834. X{
  835. X    STR **tmpary;    /* must not be register */
  836. X    register STR **elem;
  837. X    register STR *str = &str_no;
  838. X
  839. X    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
  840. X    for (elem = tmpary+1; *elem; elem++) {
  841. X    str = str_new(0);
  842. X    str_sset(str,*elem);
  843. X    apush(ary,str);
  844. X    }
  845. X    safefree((char*)tmpary);
  846. X    return str;
  847. X}
  848. X
  849. Xdo_unshift(arg,ary)
  850. Xregister ARG *arg;
  851. Xregister ARRAY *ary;
  852. X{
  853. X    STR **tmpary;    /* must not be register */
  854. X    register STR **elem;
  855. X    register STR *str = &str_no;
  856. X    register int i;
  857. X
  858. X    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
  859. X    i = 0;
  860. X    for (elem = tmpary+1; *elem; elem++)
  861. X    i++;
  862. X    aunshift(ary,i);
  863. X    i = 0;
  864. X    for (elem = tmpary+1; *elem; elem++) {
  865. X    str = str_new(0);
  866. X    str_sset(str,*elem);
  867. X    astore(ary,i++,str);
  868. X    }
  869. X    safefree((char*)tmpary);
  870. X}
  871. X
  872. Xapply(type,arg,sarg)
  873. Xint type;
  874. Xregister ARG *arg;
  875. XSTR **sarg;
  876. X{
  877. X    STR **tmpary;    /* must not be register */
  878. X    register STR **elem;
  879. X    register int i;
  880. X    register int val;
  881. X    register int val2;
  882. X
  883. X    if (sarg)
  884. X    tmpary = sarg;
  885. X    else
  886. X    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary);
  887. X    i = 0;
  888. X    for (elem = tmpary+1; *elem; elem++)
  889. X    i++;
  890. X    switch (type) {
  891. X    case O_CHMOD:
  892. X    if (--i > 0) {
  893. X        val = (int)str_gnum(tmpary[1]);
  894. X        for (elem = tmpary+2; *elem; elem++)
  895. X        if (chmod(str_get(*elem),val))
  896. X            i--;
  897. X    }
  898. X    break;
  899. X    case O_CHOWN:
  900. X    if (i > 2) {
  901. X        i -= 2;
  902. X        val = (int)str_gnum(tmpary[1]);
  903. X        val2 = (int)str_gnum(tmpary[2]);
  904. X        for (elem = tmpary+3; *elem; elem++)
  905. X        if (chown(str_get(*elem),val,val2))
  906. X            i--;
  907. X    }
  908. X    else
  909. X        i = 0;
  910. X    break;
  911. X    case O_KILL:
  912. X    if (--i > 0) {
  913. X        val = (int)str_gnum(tmpary[1]);
  914. X        if (val < 0)
  915. X        val = -val;
  916. X        for (elem = tmpary+2; *elem; elem++)
  917. X        if (kill(atoi(str_get(*elem)),val))
  918. X            i--;
  919. X    }
  920. X    break;
  921. X    case O_UNLINK:
  922. X    for (elem = tmpary+1; *elem; elem++)
  923. X        if (UNLINK(str_get(*elem)))
  924. X        i--;
  925. X    break;
  926. X    }
  927. X    if (!sarg)
  928. X    safefree((char*)tmpary);
  929. X    return i;
  930. X}
  931. X
  932. XSTR *
  933. Xdo_subr(arg,sarg)
  934. Xregister ARG *arg;
  935. Xregister char **sarg;
  936. X{
  937. X    ARRAY *savearray;
  938. X    STR *str;
  939. X
  940. X    savearray = defstab->stab_array;
  941. X    defstab->stab_array = anew();
  942. X    if (arg[1].arg_flags & AF_SPECIAL)
  943. X    (void)do_push(arg,defstab->stab_array);
  944. X    else if (arg[1].arg_type != A_NULL) {
  945. X    str = str_new(0);
  946. X    str_sset(str,sarg[1]);
  947. X    apush(defstab->stab_array,str);
  948. X    }
  949. X    str = cmd_exec(arg[2].arg_ptr.arg_stab->stab_sub);
  950. X    afree(defstab->stab_array);  /* put back old $_[] */
  951. X    defstab->stab_array = savearray;
  952. X    return str;
  953. X}
  954. X
  955. Xvoid
  956. Xdo_assign(retstr,arg)
  957. XSTR *retstr;
  958. Xregister ARG *arg;
  959. X{
  960. X    STR **tmpary;    /* must not be register */
  961. X    register ARG *larg = arg[1].arg_ptr.arg_arg;
  962. X    register STR **elem;
  963. X    register STR *str;
  964. X    register ARRAY *ary;
  965. X    register int i;
  966. X    register int lasti;
  967. X    char *s;
  968. X
  969. X    (void)eval(arg[2].arg_ptr.arg_arg,&tmpary);
  970. X
  971. X    if (arg->arg_flags & AF_COMMON) {
  972. X    if (*(tmpary+1)) {
  973. X        for (elem=tmpary+2; *elem; elem++) {
  974. X        *elem = str_static(*elem);
  975. X        }
  976. X    }
  977. X    }
  978. X    if (larg->arg_type == O_LIST) {
  979. X    lasti = larg->arg_len;
  980. X    for (i=1,elem=tmpary+1; i <= lasti; i++) {
  981. X        if (*elem)
  982. X        s = str_get(*(elem++));
  983. X        else
  984. X        s = "";
  985. X        switch (larg[i].arg_type) {
  986. X        case A_STAB:
  987. X        case A_LVAL:
  988. X        str = STAB_STR(larg[i].arg_ptr.arg_stab);
  989. X        break;
  990. X        case A_LEXPR:
  991. X        str = eval(larg[i].arg_ptr.arg_arg,Null(STR***));
  992. X        break;
  993. X        }
  994. X        str_set(str,s);
  995. X        STABSET(str);
  996. X    }
  997. X    i = elem - tmpary - 1;
  998. X    }
  999. X    else {            /* should be an array name */
  1000. X    ary = larg[1].arg_ptr.arg_stab->stab_array;
  1001. X    for (i=0,elem=tmpary+1; *elem; i++) {
  1002. X        str = str_new(0);
  1003. X        if (*elem)
  1004. X        str_sset(str,*(elem++));
  1005. X        astore(ary,i,str);
  1006. X    }
  1007. X    ary->ary_fill = i - 1;    /* they can get the extra ones back by */
  1008. X    }                /*   setting an element larger than old fill */
  1009. X    str_numset(retstr,(double)i);
  1010. X    STABSET(retstr);
  1011. X    safefree((char*)tmpary);
  1012. X}
  1013. X
  1014. Xint
  1015. Xdo_kv(hash,kv,sarg,retary)
  1016. XHASH *hash;
  1017. Xint kv;
  1018. Xregister STR **sarg;
  1019. XSTR ***retary;
  1020. X{
  1021. X    register ARRAY *ary;
  1022. X    int max = 0;
  1023. X    int i;
  1024. X    static ARRAY *myarray = Null(ARRAY*);
  1025. X    register HENT *entry;
  1026. X
  1027. X    ary = myarray;
  1028. X    if (!ary)
  1029. X    myarray = ary = anew();
  1030. X    ary->ary_fill = -1;
  1031. X
  1032. X    hiterinit(hash);
  1033. X    while (entry = hiternext(hash)) {
  1034. X    max++;
  1035. X    if (kv == O_KEYS)
  1036. X        apush(ary,str_make(hiterkey(entry)));
  1037. X    else
  1038. X        apush(ary,str_make(str_get(hiterval(entry))));
  1039. X    }
  1040. X    if (retary) { /* array wanted */
  1041. X    sarg = (STR**)saferealloc((char*)sarg,(max+2)*sizeof(STR*));
  1042. X    sarg[0] = Nullstr;
  1043. X    sarg[max+1] = Nullstr;
  1044. X    for (i = 1; i <= max; i++)
  1045. X        sarg[i] = afetch(ary,i-1);
  1046. X    *retary = sarg;
  1047. X    }
  1048. X    return max;
  1049. X}
  1050. X
  1051. XSTR *
  1052. Xdo_each(hash,sarg,retary)
  1053. XHASH *hash;
  1054. Xregister STR **sarg;
  1055. XSTR ***retary;
  1056. X{
  1057. X    static STR *mystr = Nullstr;
  1058. X    STR *retstr;
  1059. X    HENT *entry = hiternext(hash);
  1060. X
  1061. X    if (mystr) {
  1062. X    str_free(mystr);
  1063. X    mystr = Nullstr;
  1064. X    }
  1065. X
  1066. X    if (retary) { /* array wanted */
  1067. X    if (entry) {
  1068. X        sarg = (STR**)saferealloc((char*)sarg,4*sizeof(STR*));
  1069. X        sarg[0] = Nullstr;
  1070. X        sarg[3] = Nullstr;
  1071. X        sarg[1] = mystr = str_make(hiterkey(entry));
  1072. X        retstr = sarg[2] = hiterval(entry);
  1073. X        *retary = sarg;
  1074. X    }
  1075. X    else {
  1076. X        sarg = (STR**)saferealloc((char*)sarg,2*sizeof(STR*));
  1077. X        sarg[0] = Nullstr;
  1078. X        sarg[1] = retstr = Nullstr;
  1079. X        *retary = sarg;
  1080. X    }
  1081. X    }
  1082. X    else
  1083. X    retstr = hiterval(entry);
  1084. X    
  1085. X    return retstr;
  1086. X}
  1087. X
  1088. Xinit_eval()
  1089. X{
  1090. X    register int i;
  1091. X
  1092. X#define A(e1,e2,e3) (e1+(e2<<1)+(e3<<2))
  1093. X    opargs[O_ITEM] =        A(1,0,0);
  1094. X    opargs[O_ITEM2] =        A(0,0,0);
  1095. X    opargs[O_ITEM3] =        A(0,0,0);
  1096. X    opargs[O_CONCAT] =        A(1,1,0);
  1097. X    opargs[O_MATCH] =        A(1,0,0);
  1098. X    opargs[O_NMATCH] =        A(1,0,0);
  1099. X    opargs[O_SUBST] =        A(1,0,0);
  1100. X    opargs[O_NSUBST] =        A(1,0,0);
  1101. X    opargs[O_ASSIGN] =        A(1,1,0);
  1102. X    opargs[O_MULTIPLY] =    A(1,1,0);
  1103. X    opargs[O_DIVIDE] =        A(1,1,0);
  1104. X    opargs[O_MODULO] =        A(1,1,0);
  1105. X    opargs[O_ADD] =        A(1,1,0);
  1106. X    opargs[O_SUBTRACT] =    A(1,1,0);
  1107. X    opargs[O_LEFT_SHIFT] =    A(1,1,0);
  1108. X    opargs[O_RIGHT_SHIFT] =    A(1,1,0);
  1109. X    opargs[O_LT] =        A(1,1,0);
  1110. X    opargs[O_GT] =        A(1,1,0);
  1111. X    opargs[O_LE] =        A(1,1,0);
  1112. X    opargs[O_GE] =        A(1,1,0);
  1113. X    opargs[O_EQ] =        A(1,1,0);
  1114. X    opargs[O_NE] =        A(1,1,0);
  1115. X    opargs[O_BIT_AND] =        A(1,1,0);
  1116. X    opargs[O_XOR] =        A(1,1,0);
  1117. X    opargs[O_BIT_OR] =        A(1,1,0);
  1118. X    opargs[O_AND] =        A(1,0,0);    /* don't eval arg 2 (yet) */
  1119. X    opargs[O_OR] =        A(1,0,0);    /* don't eval arg 2 (yet) */
  1120. X    opargs[O_COND_EXPR] =    A(1,0,0);    /* don't eval args 2 or 3 */
  1121. X    opargs[O_COMMA] =        A(1,1,0);
  1122. X    opargs[O_NEGATE] =        A(1,0,0);
  1123. X    opargs[O_NOT] =        A(1,0,0);
  1124. X    opargs[O_COMPLEMENT] =    A(1,0,0);
  1125. X    opargs[O_WRITE] =        A(1,0,0);
  1126. X    opargs[O_OPEN] =        A(1,1,0);
  1127. X    opargs[O_TRANS] =        A(1,0,0);
  1128. X    opargs[O_NTRANS] =        A(1,0,0);
  1129. X    opargs[O_CLOSE] =        A(0,0,0);
  1130. X    opargs[O_ARRAY] =        A(1,0,0);
  1131. X    opargs[O_HASH] =        A(1,0,0);
  1132. X    opargs[O_LARRAY] =        A(1,0,0);
  1133. X    opargs[O_LHASH] =        A(1,0,0);
  1134. X    opargs[O_PUSH] =        A(1,0,0);
  1135. X    opargs[O_POP] =        A(0,0,0);
  1136. X    opargs[O_SHIFT] =        A(0,0,0);
  1137. X    opargs[O_SPLIT] =        A(1,0,0);
  1138. X    opargs[O_LENGTH] =        A(1,0,0);
  1139. X    opargs[O_SPRINTF] =        A(1,0,0);
  1140. X    opargs[O_SUBSTR] =        A(1,1,1);
  1141. X    opargs[O_JOIN] =        A(1,0,0);
  1142. X    opargs[O_SLT] =        A(1,1,0);
  1143. X    opargs[O_SGT] =        A(1,1,0);
  1144. X    opargs[O_SLE] =        A(1,1,0);
  1145. X    opargs[O_SGE] =        A(1,1,0);
  1146. X    opargs[O_SEQ] =        A(1,1,0);
  1147. X    opargs[O_SNE] =        A(1,1,0);
  1148. X    opargs[O_SUBR] =        A(1,0,0);
  1149. X    opargs[O_PRINT] =        A(1,0,0);
  1150. X    opargs[O_CHDIR] =        A(1,0,0);
  1151. X    opargs[O_DIE] =        A(1,0,0);
  1152. X    opargs[O_EXIT] =        A(1,0,0);
  1153. X    opargs[O_RESET] =        A(1,0,0);
  1154. X    opargs[O_LIST] =        A(0,0,0);
  1155. X    opargs[O_EOF] =        A(0,0,0);
  1156. X    opargs[O_TELL] =        A(0,0,0);
  1157. X    opargs[O_SEEK] =        A(0,1,1);
  1158. X    opargs[O_LAST] =        A(1,0,0);
  1159. X    opargs[O_NEXT] =        A(1,0,0);
  1160. X    opargs[O_REDO] =        A(1,0,0);
  1161. X    opargs[O_GOTO] =        A(1,0,0);
  1162. X    opargs[O_INDEX] =        A(1,1,0);
  1163. X    opargs[O_TIME] =         A(0,0,0);
  1164. X    opargs[O_TMS] =         A(0,0,0);
  1165. X    opargs[O_LOCALTIME] =    A(1,0,0);
  1166. X    opargs[O_GMTIME] =        A(1,0,0);
  1167. X    opargs[O_STAT] =        A(1,0,0);
  1168. X    opargs[O_CRYPT] =        A(1,1,0);
  1169. X    opargs[O_EXP] =        A(1,0,0);
  1170. X    opargs[O_LOG] =        A(1,0,0);
  1171. X    opargs[O_SQRT] =        A(1,0,0);
  1172. X    opargs[O_INT] =        A(1,0,0);
  1173. X    opargs[O_PRTF] =        A(1,0,0);
  1174. X    opargs[O_ORD] =         A(1,0,0);
  1175. X    opargs[O_SLEEP] =        A(1,0,0);
  1176. X    opargs[O_FLIP] =        A(1,0,0);
  1177. X    opargs[O_FLOP] =        A(0,1,0);
  1178. X    opargs[O_KEYS] =        A(0,0,0);
  1179. X    opargs[O_VALUES] =        A(0,0,0);
  1180. X    opargs[O_EACH] =        A(0,0,0);
  1181. X    opargs[O_CHOP] =        A(1,0,0);
  1182. X    opargs[O_FORK] =        A(1,0,0);
  1183. X    opargs[O_EXEC] =        A(1,0,0);
  1184. X    opargs[O_SYSTEM] =        A(1,0,0);
  1185. X    opargs[O_OCT] =        A(1,0,0);
  1186. X    opargs[O_HEX] =        A(1,0,0);
  1187. X    opargs[O_CHMOD] =        A(1,0,0);
  1188. X    opargs[O_CHOWN] =        A(1,0,0);
  1189. X    opargs[O_KILL] =        A(1,0,0);
  1190. X    opargs[O_RENAME] =        A(1,1,0);
  1191. X    opargs[O_UNLINK] =        A(1,0,0);
  1192. X    opargs[O_UMASK] =        A(1,0,0);
  1193. X    opargs[O_UNSHIFT] =        A(1,0,0);
  1194. X    opargs[O_LINK] =        A(1,1,0);
  1195. X    opargs[O_REPEAT] =        A(1,1,0);
  1196. X}
  1197. X
  1198. Xstatic int (*ihand)();
  1199. Xstatic int (*qhand)();
  1200. X
  1201. XSTR *
  1202. Xeval(arg,retary)
  1203. Xregister ARG *arg;
  1204. XSTR ***retary;        /* where to return an array to, null if nowhere */
  1205. X{
  1206. X    register STR *str;
  1207. X    register int anum;
  1208. X    register int optype;
  1209. X    register int maxarg;
  1210. X    double value;
  1211. X    STR *quicksarg[5];
  1212. X    register STR **sarg = quicksarg;
  1213. X    register char *tmps;
  1214. X    char *tmps2;
  1215. X    int argflags;
  1216. X    long tmplong;
  1217. X    FILE *fp;
  1218. X    STR *tmpstr;
  1219. X    FCMD *form;
  1220. X    STAB *stab;
  1221. X    ARRAY *ary;
  1222. X    bool assigning = FALSE;
  1223. X    double exp(), log(), sqrt(), modf();
  1224. X    char *crypt(), *getenv();
  1225. X
  1226. X    if (!arg)
  1227. X    return &str_no;
  1228. X    str = arg->arg_ptr.arg_str;
  1229. X    optype = arg->arg_type;
  1230. X    maxarg = arg->arg_len;
  1231. X    if (maxarg > 3 || retary) {
  1232. X    sarg = (STR **)safemalloc((maxarg+2) * sizeof(STR*));
  1233. X    }
  1234. X#ifdef DEBUGGING
  1235. X    if (debug & 8) {
  1236. X    deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
  1237. X    }
  1238. X    debname[dlevel] = opname[optype][0];
  1239. X    debdelim[dlevel++] = ':';
  1240. X#endif
  1241. X    for (anum = 1; anum <= maxarg; anum++) {
  1242. X    argflags = arg[anum].arg_flags;
  1243. X    if (argflags & AF_SPECIAL)
  1244. X        continue;
  1245. X      re_eval:
  1246. X    switch (arg[anum].arg_type) {
  1247. X    default:
  1248. X        sarg[anum] = &str_no;
  1249. X#ifdef DEBUGGING
  1250. X        tmps = "NULL";
  1251. X#endif
  1252. X        break;
  1253. X    case A_EXPR:
  1254. X#ifdef DEBUGGING
  1255. X        if (debug & 8) {
  1256. X        tmps = "EXPR";
  1257. X        deb("%d.EXPR =>\n",anum);
  1258. X        }
  1259. X#endif
  1260. X        sarg[anum] = eval(arg[anum].arg_ptr.arg_arg, Null(STR***));
  1261. X        break;
  1262. X    case A_CMD:
  1263. X#ifdef DEBUGGING
  1264. X        if (debug & 8) {
  1265. X        tmps = "CMD";
  1266. X        deb("%d.CMD (%lx) =>\n",anum,arg[anum].arg_ptr.arg_cmd);
  1267. X        }
  1268. X#endif
  1269. X        sarg[anum] = cmd_exec(arg[anum].arg_ptr.arg_cmd);
  1270. X        break;
  1271. X    case A_STAB:
  1272. X        sarg[anum] = STAB_STR(arg[anum].arg_ptr.arg_stab);
  1273. X#ifdef DEBUGGING
  1274. X        if (debug & 8) {
  1275. X        sprintf(buf,"STAB $%s ==",arg[anum].arg_ptr.arg_stab->stab_name);
  1276. X        tmps = buf;
  1277. X        }
  1278. X#endif
  1279. X        break;
  1280. X    case A_LEXPR:
  1281. X#ifdef DEBUGGING
  1282. X        if (debug & 8) {
  1283. X        tmps = "LEXPR";
  1284. X        deb("%d.LEXPR =>\n",anum);
  1285. X        }
  1286. X#endif
  1287. X        str = eval(arg[anum].arg_ptr.arg_arg,Null(STR***));
  1288. X        if (!str)
  1289. X        fatal("panic: A_LEXPR\n");
  1290. X        goto do_crement;
  1291. X    case A_LVAL:
  1292. X#ifdef DEBUGGING
  1293. X        if (debug & 8) {
  1294. X        sprintf(buf,"LVAL $%s ==",arg[anum].arg_ptr.arg_stab->stab_name);
  1295. X        tmps = buf;
  1296. X        }
  1297. X#endif
  1298. X        str = STAB_STR(arg[anum].arg_ptr.arg_stab);
  1299. X        if (!str)
  1300. X        fatal("panic: A_LVAL\n");
  1301. X      do_crement:
  1302. X        assigning = TRUE;
  1303. X        if (argflags & AF_PRE) {
  1304. X        if (argflags & AF_UP)
  1305. X            str_inc(str);
  1306. X        else
  1307. X            str_dec(str);
  1308. X        STABSET(str);
  1309. X        sarg[anum] = str;
  1310. X        str = arg->arg_ptr.arg_str;
  1311. X        }
  1312. X        else if (argflags & AF_POST) {
  1313. X        sarg[anum] = str_static(str);
  1314. X        if (argflags & AF_UP)
  1315. X            str_inc(str);
  1316. X        else
  1317. X            str_dec(str);
  1318. X        STABSET(str);
  1319. X        str = arg->arg_ptr.arg_str;
  1320. X        }
  1321. X        else {
  1322. X        sarg[anum] = str;
  1323. X        }
  1324. X        break;
  1325. X    case A_ARYLEN:
  1326. X        sarg[anum] = str_static(&str_no);
  1327. X        str_numset(sarg[anum],
  1328. X        (double)alen(arg[anum].arg_ptr.arg_stab->stab_array));
  1329. X#ifdef DEBUGGING
  1330. X        tmps = "ARYLEN";
  1331. X#endif
  1332. X        break;
  1333. X    case A_SINGLE:
  1334. X        sarg[anum] = arg[anum].arg_ptr.arg_str;
  1335. X#ifdef DEBUGGING
  1336. X        tmps = "SINGLE";
  1337. X#endif
  1338. X        break;
  1339. X    case A_DOUBLE:
  1340. X        (void) interp(str,str_get(arg[anum].arg_ptr.arg_str));
  1341. X        sarg[anum] = str;
  1342. X#ifdef DEBUGGING
  1343. X        tmps = "DOUBLE";
  1344. X#endif
  1345. X        break;
  1346. X    case A_BACKTICK:
  1347. X        tmps = str_get(arg[anum].arg_ptr.arg_str);
  1348. X        fp = popen(str_get(interp(str,tmps)),"r");
  1349. X        tmpstr = str_new(80);
  1350. X        str_set(str,"");
  1351. X        if (fp) {
  1352. X        while (str_gets(tmpstr,fp) != Nullch) {
  1353. X            str_scat(str,tmpstr);
  1354. X        }
  1355. X        statusvalue = pclose(fp);
  1356. X        }
  1357. X        else
  1358. X        statusvalue = -1;
  1359. X        str_free(tmpstr);
  1360. X
  1361. X        sarg[anum] = str;
  1362. X#ifdef DEBUGGING
  1363. X        tmps = "BACK";
  1364. X#endif
  1365. X        break;
  1366. X    case A_READ:
  1367. X        fp = Nullfp;
  1368. X        last_in_stab = arg[anum].arg_ptr.arg_stab;
  1369. X        if (last_in_stab->stab_io) {
  1370. X        fp = last_in_stab->stab_io->fp;
  1371. X        if (!fp && (last_in_stab->stab_io->flags & IOF_ARGV)) {
  1372. X            if (last_in_stab->stab_io->flags & IOF_START) {
  1373. X            last_in_stab->stab_io->flags &= ~IOF_START;
  1374. X            last_in_stab->stab_io->lines = 0;
  1375. X            if (alen(last_in_stab->stab_array) < 0L) {
  1376. X                tmpstr = str_make("-");    /* assume stdin */
  1377. X                apush(last_in_stab->stab_array, tmpstr);
  1378. X            }
  1379. X            }
  1380. X            fp = nextargv(last_in_stab);
  1381. X            if (!fp)    /* Note: fp != last_in_stab->stab_io->fp */
  1382. X            do_close(last_in_stab,FALSE);    /* now it does */
  1383. X        }
  1384. X        }
  1385. X      keepgoing:
  1386. X        if (!fp)
  1387. X        sarg[anum] = &str_no;
  1388. X        else if (!str_gets(str,fp)) {
  1389. X        if (last_in_stab->stab_io->flags & IOF_ARGV) {
  1390. X            fp = nextargv(last_in_stab);
  1391. X            if (fp)
  1392. X            goto keepgoing;
  1393. X            do_close(last_in_stab,FALSE);
  1394. X            last_in_stab->stab_io->flags |= IOF_START;
  1395. X        }
  1396. X        if (fp == stdin) {
  1397. X            clearerr(fp);
  1398. X        }
  1399. X        sarg[anum] = &str_no;
  1400. X        break;
  1401. X        }
  1402. X        else {
  1403. X        last_in_stab->stab_io->lines++;
  1404. X        sarg[anum] = str;
  1405. X        }
  1406. X#ifdef DEBUGGING
  1407. X        tmps = "READ";
  1408. X#endif
  1409. X        break;
  1410. X    }
  1411. X#ifdef DEBUGGING
  1412. X    if (debug & 8)
  1413. X        deb("%d.%s = '%s'\n",anum,tmps,str_peek(sarg[anum]));
  1414. X#endif
  1415. X    }
  1416. X    switch (optype) {
  1417. X    case O_ITEM:
  1418. X    if (str != sarg[1])
  1419. X        str_sset(str,sarg[1]);
  1420. X    STABSET(str);
  1421. X    break;
  1422. X    case O_ITEM2:
  1423. X    if (str != sarg[2])
  1424. X        str_sset(str,sarg[2]);
  1425. X    STABSET(str);
  1426. X    break;
  1427. X    case O_ITEM3:
  1428. X    if (str != sarg[3])
  1429. X        str_sset(str,sarg[3]);
  1430. X    STABSET(str);
  1431. X    break;
  1432. X    case O_CONCAT:
  1433. X    if (str != sarg[1])
  1434. X        str_sset(str,sarg[1]);
  1435. X    str_scat(str,sarg[2]);
  1436. X    STABSET(str);
  1437. X    break;
  1438. X    case O_REPEAT:
  1439. X    if (str != sarg[1])
  1440. X        str_sset(str,sarg[1]);
  1441. X    anum = (long)str_gnum(sarg[2]);
  1442. X    if (anum >= 1) {
  1443. X        tmpstr = str_new(0);
  1444. X        str_sset(tmpstr,str);
  1445. X        for (anum--; anum; anum--)
  1446. X        str_scat(str,tmpstr);
  1447. X    }
  1448. X    else
  1449. X        str_sset(str,&str_no);
  1450. X    STABSET(str);
  1451. X    break;
  1452. X    case O_MATCH:
  1453. X    str_set(str, do_match(str_get(sarg[1]),arg) ? Yes : No);
  1454. X    STABSET(str);
  1455. X    break;
  1456. X    case O_NMATCH:
  1457. X    str_set(str, do_match(str_get(sarg[1]),arg) ? No : Yes);
  1458. X    STABSET(str);
  1459. X    break;
  1460. X    case O_SUBST:
  1461. X    value = (double) do_subst(str, arg);
  1462. X    str = arg->arg_ptr.arg_str;
  1463. X    goto donumset;
  1464. X    case O_NSUBST:
  1465. X    str_set(arg->arg_ptr.arg_str, do_subst(str, arg) ? No : Yes);
  1466. X    str = arg->arg_ptr.arg_str;
  1467. X    break;
  1468. X    case O_ASSIGN:
  1469. X    if (arg[2].arg_flags & AF_SPECIAL)
  1470. X        do_assign(str,arg);
  1471. X    else {
  1472. X        if (str != sarg[2])
  1473. X        str_sset(str, sarg[2]);
  1474. X        STABSET(str);
  1475. X    }
  1476. X    break;
  1477. X    case O_CHOP:
  1478. X    tmps = str_get(str);
  1479. X    tmps += str->str_cur - (str->str_cur != 0);
  1480. X    str_set(arg->arg_ptr.arg_str,tmps);    /* remember last char */
  1481. X    *tmps = '\0';                /* wipe it out */
  1482. X    str->str_cur = tmps - str->str_ptr;
  1483. X    str->str_nok = 0;
  1484. X    str = arg->arg_ptr.arg_str;
  1485. X    break;
  1486. X    case O_MULTIPLY:
  1487. X    value = str_gnum(sarg[1]);
  1488. X    value *= str_gnum(sarg[2]);
  1489. X    goto donumset;
  1490. X    case O_DIVIDE:
  1491. X    value = str_gnum(sarg[1]);
  1492. X    value /= str_gnum(sarg[2]);
  1493. X    goto donumset;
  1494. X    case O_MODULO:
  1495. X    value = str_gnum(sarg[1]);
  1496. X    value = (double)(((long)value) % (long)str_gnum(sarg[2]));
  1497. X    goto donumset;
  1498. X    case O_ADD:
  1499. X    value = str_gnum(sarg[1]);
  1500. X    value += str_gnum(sarg[2]);
  1501. X    goto donumset;
  1502. X    case O_SUBTRACT:
  1503. X    value = str_gnum(sarg[1]);
  1504. X    value -= str_gnum(sarg[2]);
  1505. X    goto donumset;
  1506. X    case O_LEFT_SHIFT:
  1507. X    value = str_gnum(sarg[1]);
  1508. X    value = (double)(((long)value) << (long)str_gnum(sarg[2]));
  1509. X    goto donumset;
  1510. X    case O_RIGHT_SHIFT:
  1511. X    value = str_gnum(sarg[1]);
  1512. X    value = (double)(((long)value) >> (long)str_gnum(sarg[2]));
  1513. X    goto donumset;
  1514. X    case O_LT:
  1515. X    value = str_gnum(sarg[1]);
  1516. X    value = (double)(value < str_gnum(sarg[2]));
  1517. X    goto donumset;
  1518. X    case O_GT:
  1519. X    value = str_gnum(sarg[1]);
  1520. X    value = (double)(value > str_gnum(sarg[2]));
  1521. X    goto donumset;
  1522. X    case O_LE:
  1523. X    value = str_gnum(sarg[1]);
  1524. X    value = (double)(value <= str_gnum(sarg[2]));
  1525. X    goto donumset;
  1526. X    case O_GE:
  1527. X    value = str_gnum(sarg[1]);
  1528. X    value = (double)(value >= str_gnum(sarg[2]));
  1529. X    goto donumset;
  1530. X    case O_EQ:
  1531. X    value = str_gnum(sarg[1]);
  1532. X    value = (double)(value == str_gnum(sarg[2]));
  1533. X    goto donumset;
  1534. X    case O_NE:
  1535. X    value = str_gnum(sarg[1]);
  1536. X    value = (double)(value != str_gnum(sarg[2]));
  1537. X    goto donumset;
  1538. X    case O_BIT_AND:
  1539. X    value = str_gnum(sarg[1]);
  1540. X    value = (double)(((long)value) & (long)str_gnum(sarg[2]));
  1541. X    goto donumset;
  1542. X    case O_XOR:
  1543. X    value = str_gnum(sarg[1]);
  1544. X    value = (double)(((long)value) ^ (long)str_gnum(sarg[2]));
  1545. X    goto donumset;
  1546. X    case O_BIT_OR:
  1547. X    value = str_gnum(sarg[1]);
  1548. X    value = (double)(((long)value) | (long)str_gnum(sarg[2]));
  1549. X    goto donumset;
  1550. X    case O_AND:
  1551. X    if (str_true(sarg[1])) {
  1552. X        anum = 2;
  1553. X        optype = O_ITEM2;
  1554. X        maxarg = 0;
  1555. X        argflags = arg[anum].arg_flags;
  1556. X        goto re_eval;
  1557. X    }
  1558. X    else {
  1559. X        if (assigning) {
  1560. X        str_sset(str, sarg[1]);
  1561. X        STABSET(str);
  1562. X        }
  1563. X        else
  1564. X        str = sarg[1];
  1565. X        break;
  1566. X    }
  1567. X    case O_OR:
  1568. X    if (str_true(sarg[1])) {
  1569. X        if (assigning) {
  1570. X        str_set(str, sarg[1]);
  1571. X        STABSET(str);
  1572. X        }
  1573. X        else
  1574. X        str = sarg[1];
  1575. X        break;
  1576. X    }
  1577. X    else {
  1578. X        anum = 2;
  1579. X        optype = O_ITEM2;
  1580. X        maxarg = 0;
  1581. X        argflags = arg[anum].arg_flags;
  1582. X        goto re_eval;
  1583. X    }
  1584. X    case O_COND_EXPR:
  1585. X    anum = (str_true(sarg[1]) ? 2 : 3);
  1586. X    optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
  1587. X    maxarg = 0;
  1588. X    argflags = arg[anum].arg_flags;
  1589. X    goto re_eval;
  1590. X    case O_COMMA:
  1591. X    str = sarg[2];
  1592. X    break;
  1593. X    case O_NEGATE:
  1594. X    value = -str_gnum(sarg[1]);
  1595. X    goto donumset;
  1596. X    case O_NOT:
  1597. X    value = (double) !str_true(sarg[1]);
  1598. X    goto donumset;
  1599. X    case O_COMPLEMENT:
  1600. X    value = (double) ~(long)str_gnum(sarg[1]);
  1601. X    goto donumset;
  1602. X    case O_SELECT:
  1603. X    if (arg[1].arg_type == A_LVAL)
  1604. X        defoutstab = arg[1].arg_ptr.arg_stab;
  1605. X    else
  1606. X        defoutstab = stabent(str_get(sarg[1]),TRUE);
  1607. X    if (!defoutstab->stab_io)
  1608. X        defoutstab->stab_io = stio_new();
  1609. X    curoutstab = defoutstab;
  1610. X    str_set(str,curoutstab->stab_io->fp ? Yes : No);
  1611. X    STABSET(str);
  1612. X    break;
  1613. X    case O_WRITE:
  1614. X    if (maxarg == 0)
  1615. X        stab = defoutstab;
  1616. X    else if (arg[1].arg_type == A_LVAL)
  1617. X        stab = arg[1].arg_ptr.arg_stab;
  1618. X    else
  1619. X        stab = stabent(str_get(sarg[1]),TRUE);
  1620. X    if (!stab->stab_io) {
  1621. X        str_set(str, No);
  1622. X        STABSET(str);
  1623. X        break;
  1624. X    }
  1625. X    curoutstab = stab;
  1626. X    fp = stab->stab_io->fp;
  1627. X    debarg = arg;
  1628. X    if (stab->stab_io->fmt_stab)
  1629. X        form = stab->stab_io->fmt_stab->stab_form;
  1630. X    else
  1631. X        form = stab->stab_form;
  1632. X    if (!form || !fp) {
  1633. X        str_set(str, No);
  1634. X        STABSET(str);
  1635. X        break;
  1636. X    }
  1637. X    format(&outrec,form);
  1638. X    do_write(&outrec,stab->stab_io);
  1639. X    if (stab->stab_io->flags & IOF_FLUSH)
  1640. X        fflush(fp);
  1641. X    str_set(str, Yes);
  1642. X    STABSET(str);
  1643. X    break;
  1644. X    case O_OPEN:
  1645. X    if (do_open(arg[1].arg_ptr.arg_stab,str_get(sarg[2]))) {
  1646. X        str_set(str, Yes);
  1647. X        arg[1].arg_ptr.arg_stab->stab_io->lines = 0;
  1648. X    }
  1649. X    else
  1650. X        str_set(str, No);
  1651. X    STABSET(str);
  1652. X    break;
  1653. X    case O_TRANS:
  1654. X    value = (double) do_trans(str,arg);
  1655. X    str = arg->arg_ptr.arg_str;
  1656. X    goto donumset;
  1657. X    case O_NTRANS:
  1658. X    str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
  1659. X    str = arg->arg_ptr.arg_str;
  1660. X    break;
  1661. X    case O_CLOSE:
  1662. X    str_set(str,
  1663. X        do_close(arg[1].arg_ptr.arg_stab,TRUE) ? Yes : No );
  1664. X    STABSET(str);
  1665. X    break;
  1666. X    case O_EACH:
  1667. X    str_sset(str,do_each(arg[1].arg_ptr.arg_stab->stab_hash,sarg,retary));
  1668. X    retary = Null(STR***);        /* do_each already did retary */
  1669. X    STABSET(str);
  1670. X    break;
  1671. X    case O_VALUES:
  1672. X    case O_KEYS:
  1673. X    value = (double) do_kv(arg[1].arg_ptr.arg_stab->stab_hash,
  1674. X      optype,sarg,retary);
  1675. X    retary = Null(STR***);        /* do_keys already did retary */
  1676. X    goto donumset;
  1677. X    case O_ARRAY:
  1678. X    if (maxarg == 1) {
  1679. X        ary = arg[1].arg_ptr.arg_stab->stab_array;
  1680. X        maxarg = ary->ary_fill;
  1681. X        if (retary) { /* array wanted */
  1682. X        sarg =
  1683. X          (STR **)saferealloc((char*)sarg,(maxarg+3)*sizeof(STR*));
  1684. X        for (anum = 0; anum <= maxarg; anum++) {
  1685. X            sarg[anum+1] = str = afetch(ary,anum);
  1686. X        }
  1687. X        maxarg++;
  1688. X        }
  1689. X        else
  1690. X        str = afetch(ary,maxarg);
  1691. X    }
  1692. X    else
  1693. X        str = afetch(arg[2].arg_ptr.arg_stab->stab_array,
  1694. X        ((int)str_gnum(sarg[1])) - arybase);
  1695. X    if (!str)
  1696. X        return &str_no;
  1697. X    break;
  1698. X    case O_HASH:
  1699. X    tmpstab = arg[2].arg_ptr.arg_stab;        /* XXX */
  1700. X    str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
  1701. X    if (!str)
  1702. X        return &str_no;
  1703. X    break;
  1704. X    case O_LARRAY:
  1705. X    anum = ((int)str_gnum(sarg[1])) - arybase;
  1706. X    str = afetch(arg[2].arg_ptr.arg_stab->stab_array,anum);
  1707. X    if (!str || str == &str_no) {
  1708. X        str = str_new(0);
  1709. X        astore(arg[2].arg_ptr.arg_stab->stab_array,anum,str);
  1710. X    }
  1711. X    break;
  1712. X    case O_LHASH:
  1713. X    tmpstab = arg[2].arg_ptr.arg_stab;
  1714. X    str = hfetch(tmpstab->stab_hash,str_get(sarg[1]));
  1715. X    if (!str) {
  1716. X        str = str_new(0);
  1717. X        hstore(tmpstab->stab_hash,str_get(sarg[1]),str);
  1718. X    }
  1719. X    if (tmpstab == envstab) {    /* heavy wizardry going on here */
  1720. X        str->str_link.str_magic = tmpstab;/* str is now magic */
  1721. X        envname = savestr(str_get(sarg[1]));
  1722. X                    /* he threw the brick up into the air */
  1723. X    }
  1724. X    else if (tmpstab == sigstab) {    /* same thing, only different */
  1725. X        str->str_link.str_magic = tmpstab;
  1726. X        signame = savestr(str_get(sarg[1]));
  1727. X    }
  1728. X    break;
  1729. X    case O_PUSH:
  1730. X    if (arg[1].arg_flags & AF_SPECIAL)
  1731. X        str = do_push(arg,arg[2].arg_ptr.arg_stab->stab_array);
  1732. X    else {
  1733. X        str = str_new(0);        /* must copy the STR */
  1734. X        str_sset(str,sarg[1]);
  1735. X        apush(arg[2].arg_ptr.arg_stab->stab_array,str);
  1736. X    }
  1737. X    break;
  1738. X    case O_POP:
  1739. X    str = apop(arg[1].arg_ptr.arg_stab->stab_array);
  1740. X    if (!str)
  1741. X        return &str_no;
  1742. X#ifdef STRUCTCOPY
  1743. X    *(arg->arg_ptr.arg_str) = *str;
  1744. X#else
  1745. X    bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
  1746. X#endif
  1747. X    safefree((char*)str);
  1748. X    str = arg->arg_ptr.arg_str;
  1749. X    break;
  1750. X    case O_SHIFT:
  1751. X    str = ashift(arg[1].arg_ptr.arg_stab->stab_array);
  1752. X    if (!str)
  1753. X        return &str_no;
  1754. X#ifdef STRUCTCOPY
  1755. X    *(arg->arg_ptr.arg_str) = *str;
  1756. X#else
  1757. X    bcopy((char*)str, (char*)arg->arg_ptr.arg_str, sizeof *str);
  1758. X#endif
  1759. X    safefree((char*)str);
  1760. X    str = arg->arg_ptr.arg_str;
  1761. X    break;
  1762. X    case O_SPLIT:
  1763. X    value = (double) do_split(str_get(sarg[1]),arg[2].arg_ptr.arg_spat,retary);
  1764. X    retary = Null(STR***);        /* do_split already did retary */
  1765. X    goto donumset;
  1766. X    case O_LENGTH:
  1767. X    value = (double) str_len(sarg[1]);
  1768. X    goto donumset;
  1769. X    case O_SPRINTF:
  1770. X    sarg[maxarg+1] = Nullstr;
  1771. X    do_sprintf(str,arg->arg_len,sarg);
  1772. X    break;
  1773. X    case O_SUBSTR:
  1774. X    anum = ((int)str_gnum(sarg[2])) - arybase;
  1775. X    for (tmps = str_get(sarg[1]); *tmps && anum > 0; tmps++,anum--) ;
  1776. X    anum = (int)str_gnum(sarg[3]);
  1777. X    if (anum >= 0 && strlen(tmps) > anum)
  1778. X        str_nset(str, tmps, anum);
  1779. X    else
  1780. X        str_set(str, tmps);
  1781. X    break;
  1782. X    case O_JOIN:
  1783. X    if (arg[2].arg_flags & AF_SPECIAL && arg[2].arg_type == A_EXPR)
  1784. X        do_join(arg,str_get(sarg[1]),str);
  1785. X    else
  1786. X        ajoin(arg[2].arg_ptr.arg_stab->stab_array,str_get(sarg[1]),str);
  1787. X    break;
  1788. X    case O_SLT:
  1789. X    tmps = str_get(sarg[1]);
  1790. X    value = (double) strLT(tmps,str_get(sarg[2]));
  1791. X    goto donumset;
  1792. X    case O_SGT:
  1793. X    tmps = str_get(sarg[1]);
  1794. X    value = (double) strGT(tmps,str_get(sarg[2]));
  1795. X    goto donumset;
  1796. X    case O_SLE:
  1797. X    tmps = str_get(sarg[1]);
  1798. X    value = (double) strLE(tmps,str_get(sarg[2]));
  1799. X    goto donumset;
  1800. X    case O_SGE:
  1801. X    tmps = str_get(sarg[1]);
  1802. X    value = (double) strGE(tmps,str_get(sarg[2]));
  1803. X    goto donumset;
  1804. X    case O_SEQ:
  1805. X    tmps = str_get(sarg[1]);
  1806. X    value = (double) strEQ(tmps,str_get(sarg[2]));
  1807. X    goto donumset;
  1808. X    case O_SNE:
  1809. X    tmps = str_get(sarg[1]);
  1810. X    value = (double) strNE(tmps,str_get(sarg[2]));
  1811. X    goto donumset;
  1812. X    case O_SUBR:
  1813. X    str_sset(str,do_subr(arg,sarg));
  1814. X    STABSET(str);
  1815. X    break;
  1816. X    case O_PRTF:
  1817. X    case O_PRINT:
  1818. X    if (maxarg <= 1)
  1819. X        stab = defoutstab;
  1820. X    else {
  1821. X        stab = arg[2].arg_ptr.arg_stab;
  1822. X        if (!stab)
  1823. X        stab = defoutstab;
  1824. X    }
  1825. X    if (!stab->stab_io)
  1826. X        value = 0.0;
  1827. X    else if (arg[1].arg_flags & AF_SPECIAL)
  1828. X        value = (double)do_aprint(arg,stab->stab_io->fp);
  1829. X    else {
  1830. X        value = (double)do_print(str_get(sarg[1]),stab->stab_io->fp);
  1831. X        if (ors && optype == O_PRINT)
  1832. X        do_print(ors, stab->stab_io->fp);
  1833. X    }
  1834. X    if (stab->stab_io->flags & IOF_FLUSH)
  1835. X        fflush(stab->stab_io->fp);
  1836. X    goto donumset;
  1837. X    case O_CHDIR:
  1838. X    tmps = str_get(sarg[1]);
  1839. X    if (!tmps || !*tmps)
  1840. X        tmps = getenv("HOME");
  1841. X    if (!tmps || !*tmps)
  1842. X        tmps = getenv("LOGDIR");
  1843. X    value = (double)(chdir(tmps) >= 0);
  1844. X    goto donumset;
  1845. X    case O_DIE:
  1846. X    tmps = str_get(sarg[1]);
  1847. X    if (!tmps || !*tmps)
  1848. X        exit(1);
  1849. X    fatal("%s\n",str_get(sarg[1]));
  1850. X    value = 0.0;
  1851. X    goto donumset;
  1852. X    case O_EXIT:
  1853. X    exit((int)str_gnum(sarg[1]));
  1854. X    value = 0.0;
  1855. X    goto donumset;
  1856. X    case O_RESET:
  1857. X    str_reset(str_get(sarg[1]));
  1858. X    value = 1.0;
  1859. X    goto donumset;
  1860. X    case O_LIST:
  1861. X    if (maxarg > 0)
  1862. X        str = sarg[maxarg];    /* unwanted list, return last item */
  1863. X    else
  1864. X        str = &str_no;
  1865. X    break;
  1866. X    case O_EOF:
  1867. X    str_set(str, do_eof(maxarg > 0 ? arg[1].arg_ptr.arg_stab : last_in_stab) ? Yes : No);
  1868. X    STABSET(str);
  1869. X    break;
  1870. X    case O_TELL:
  1871. X    value =    (double)do_tell(maxarg > 0 ? arg[1].arg_ptr.arg_stab : last_in_stab);
  1872. X    goto donumset;
  1873. X    break;
  1874. X    case O_SEEK:
  1875. X    value = str_gnum(sarg[2]);
  1876. X    str_set(str, do_seek(arg[1].arg_ptr.arg_stab,
  1877. X      (long)value, (int)str_gnum(sarg[3]) ) ? Yes : No);
  1878. X    STABSET(str);
  1879. X    break;
  1880. X    case O_REDO:
  1881. X    case O_NEXT:
  1882. X    case O_LAST:
  1883. X    if (maxarg > 0) {
  1884. X        tmps = str_get(sarg[1]);
  1885. X        while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
  1886. X          strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
  1887. X#ifdef DEBUGGING
  1888. X        if (debug & 4) {
  1889. X            deb("(Skipping label #%d %s)\n",loop_ptr,
  1890. X            loop_stack[loop_ptr].loop_label);
  1891. X        }
  1892. X#endif
  1893. X        loop_ptr--;
  1894. X        }
  1895. X#ifdef DEBUGGING
  1896. X        if (debug & 4) {
  1897. X        deb("(Found label #%d %s)\n",loop_ptr,
  1898. X            loop_stack[loop_ptr].loop_label);
  1899. X        }
  1900. X#endif
  1901. X    }
  1902. X    if (loop_ptr < 0)
  1903. X        fatal("Bad label: %s\n", maxarg > 0 ? tmps : "<null>");
  1904. X    longjmp(loop_stack[loop_ptr].loop_env, optype);
  1905. X    case O_GOTO:/* shudder */
  1906. X    goto_targ = str_get(sarg[1]);
  1907. X    longjmp(top_env, 1);
  1908. X    case O_INDEX:
  1909. X    tmps = str_get(sarg[1]);
  1910. X    if (!(tmps2 = instr(tmps,str_get(sarg[2]))))
  1911. X        value = (double)(-1 + arybase);
  1912. X    else
  1913. X        value = (double)(tmps2 - tmps + arybase);
  1914. X    goto donumset;
  1915. X    case O_TIME:
  1916. X    value = (double) time(0);
  1917. X    goto donumset;
  1918. X    case O_TMS:
  1919. X    value = (double) do_tms(retary);
  1920. X    retary = Null(STR***);        /* do_tms already did retary */
  1921. X    goto donumset;
  1922. X    case O_LOCALTIME:
  1923. X    tmplong = (long) str_gnum(sarg[1]);
  1924. X    value = (double) do_time(localtime(&tmplong),retary);
  1925. X    retary = Null(STR***);        /* do_localtime already did retary */
  1926. X    goto donumset;
  1927. X    case O_GMTIME:
  1928. X    tmplong = (long) str_gnum(sarg[1]);
  1929. X    value = (double) do_time(gmtime(&tmplong),retary);
  1930. X    retary = Null(STR***);        /* do_gmtime already did retary */
  1931. X    goto donumset;
  1932. X    case O_STAT:
  1933. X    value = (double) do_stat(arg,sarg,retary);
  1934. X    retary = Null(STR***);        /* do_stat already did retary */
  1935. X    goto donumset;
  1936. X    case O_CRYPT:
  1937. X    tmps = str_get(sarg[1]);
  1938. X    str_set(str,crypt(tmps,str_get(sarg[2])));
  1939. X    break;
  1940. X    case O_EXP:
  1941. X    value = exp(str_gnum(sarg[1]));
  1942. X    goto donumset;
  1943. X    case O_LOG:
  1944. X    value = log(str_gnum(sarg[1]));
  1945. X    goto donumset;
  1946. X    case O_SQRT:
  1947. X    value = sqrt(str_gnum(sarg[1]));
  1948. X    goto donumset;
  1949. X    case O_INT:
  1950. X    modf(str_gnum(sarg[1]),&value);
  1951. X    goto donumset;
  1952. X    case O_ORD:
  1953. X    value = (double) *str_get(sarg[1]);
  1954. X    goto donumset;
  1955. X    case O_SLEEP:
  1956. X    tmps = str_get(sarg[1]);
  1957. X    time(&tmplong);
  1958. X    if (!tmps || !*tmps)
  1959. X        sleep((32767<<16)+32767);
  1960. X    else
  1961. X        sleep(atoi(tmps));
  1962. X    value = (double)tmplong;
  1963. X    time(&tmplong);
  1964. X    value = ((double)tmplong) - value;
  1965. X    goto donumset;
  1966. X    case O_FLIP:
  1967. X    if (str_true(sarg[1])) {
  1968. X        str_numset(str,0.0);
  1969. X        anum = 2;
  1970. X        arg->arg_type = optype = O_FLOP;
  1971. X        maxarg = 0;
  1972. X        arg[2].arg_flags &= ~AF_SPECIAL;
  1973. X        arg[1].arg_flags |= AF_SPECIAL;
  1974. X        argflags = arg[anum].arg_flags;
  1975. X        goto re_eval;
  1976. X    }
  1977. X    str_set(str,"");
  1978. X    break;
  1979. X    case O_FLOP:
  1980. X    str_inc(str);
  1981. X    if (str_true(sarg[2])) {
  1982. X        arg->arg_type = O_FLIP;
  1983. X        arg[1].arg_flags &= ~AF_SPECIAL;
  1984. X        arg[2].arg_flags |= AF_SPECIAL;
  1985. X        str_cat(str,"E0");
  1986. X    }
  1987. X    break;
  1988. X    case O_FORK:
  1989. X    value = (double)fork();
  1990. X    goto donumset;
  1991. X    case O_SYSTEM:
  1992. X    if (anum = vfork()) {
  1993. X        ihand = signal(SIGINT, SIG_IGN);
  1994. X        qhand = signal(SIGQUIT, SIG_IGN);
  1995. X        while ((maxarg = wait(&argflags)) != anum && maxarg != -1)
  1996. X        ;
  1997. X        if (maxarg == -1)
  1998. X        argflags = -1;
  1999. X        signal(SIGINT, ihand);
  2000. X        signal(SIGQUIT, qhand);
  2001. X        value = (double)argflags;
  2002. X        goto donumset;
  2003. X    }
  2004. X    /* FALL THROUGH */
  2005. X    case O_EXEC:
  2006. X    if (arg[1].arg_flags & AF_SPECIAL)
  2007. X        value = (double)do_aexec(arg);
  2008. X    else {
  2009. X        value = (double)do_exec(str_get(sarg[1]));
  2010. X    }
  2011. X    goto donumset;
  2012. X    case O_HEX:
  2013. X    maxarg = 4;
  2014. X    goto snarfnum;
  2015. X
  2016. X    case O_OCT:
  2017. X    maxarg = 3;
  2018. X
  2019. X      snarfnum:
  2020. X    anum = 0;
  2021. X    tmps = str_get(sarg[1]);
  2022. X    for (;;) {
  2023. X        switch (*tmps) {
  2024. X        default:
  2025. X        goto out;
  2026. X        case '8': case '9':
  2027. X        if (maxarg != 4)
  2028. X            goto out;
  2029. X        /* FALL THROUGH */
  2030. X        case '0': case '1': case '2': case '3': case '4':
  2031. X        case '5': case '6': case '7':
  2032. X        anum <<= maxarg;
  2033. X        anum += *tmps++ & 15;
  2034. X        break;
  2035. X        case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
  2036. X        case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
  2037. X        if (maxarg != 4)
  2038. X            goto out;
  2039. X        anum <<= 4;
  2040. X        anum += (*tmps++ & 7) + 9;
  2041. X        break;
  2042. X        case 'x':
  2043. X        maxarg = 4;
  2044. X        tmps++;
  2045. X        break;
  2046. X        }
  2047. X    }
  2048. X      out:
  2049. X    value = (double)anum;
  2050. X    goto donumset;
  2051. X    case O_CHMOD:
  2052. X    case O_CHOWN:
  2053. X    case O_KILL:
  2054. X    case O_UNLINK:
  2055. X    if (arg[1].arg_flags & AF_SPECIAL)
  2056. X        value = (double)apply(optype,arg,Null(STR**));
  2057. X    else {
  2058. X        sarg[2] = Nullstr;
  2059. X        value = (double)apply(optype,arg,sarg);
  2060. X    }
  2061. X    goto donumset;
  2062. X    case O_UMASK:
  2063. X    value = (double)umask((int)str_gnum(sarg[1]));
  2064. X    goto donumset;
  2065. X    case O_RENAME:
  2066. X    tmps = str_get(sarg[1]);
  2067. X#ifdef RENAME
  2068. X    value = (double)(rename(tmps,str_get(sarg[2])) >= 0);
  2069. X#else
  2070. X    tmps2 = str_get(sarg[2]);
  2071. X    UNLINK(tmps2);
  2072. X    if (!(anum = link(tmps,tmps2)))
  2073. X        anum = UNLINK(tmps);
  2074. X    value = (double)(anum >= 0);
  2075. X#endif
  2076. X    goto donumset;
  2077. X    case O_LINK:
  2078. X    tmps = str_get(sarg[1]);
  2079. X    value = (double)(link(tmps,str_get(sarg[2])) >= 0);
  2080. X    goto donumset;
  2081. X    case O_UNSHIFT:
  2082. X    ary = arg[2].arg_ptr.arg_stab->stab_array;
  2083. X    if (arg[1].arg_flags & AF_SPECIAL)
  2084. X        do_unshift(arg,ary);
  2085. X    else {
  2086. X        str = str_new(0);        /* must copy the STR */
  2087. X        str_sset(str,sarg[1]);
  2088. X        aunshift(ary,1);
  2089. X        astore(ary,0,str);
  2090. X    }
  2091. X    value = (double)(ary->ary_fill + 1);
  2092. X    break;
  2093. X    }
  2094. X#ifdef DEBUGGING
  2095. X    dlevel--;
  2096. X    if (debug & 8)
  2097. X    deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
  2098. X#endif
  2099. X    goto freeargs;
  2100. X
  2101. Xdonumset:
  2102. X    str_numset(str,value);
  2103. X    STABSET(str);
  2104. X#ifdef DEBUGGING
  2105. X    dlevel--;
  2106. X    if (debug & 8)
  2107. X    deb("%s RETURNS \"%f\"\n",opname[optype],value);
  2108. X#endif
  2109. X
  2110. Xfreeargs:
  2111. X    if (sarg != quicksarg) {
  2112. X    if (retary) {
  2113. X        if (optype == O_LIST)
  2114. X        sarg[0] = &str_no;
  2115. X        else
  2116. X        sarg[0] = Nullstr;
  2117. X        sarg[maxarg+1] = Nullstr;
  2118. X        *retary = sarg;    /* up to them to free it */
  2119. X    }
  2120. X    else
  2121. X        safefree(sarg);
  2122. X    }
  2123. X    return str;
  2124. X
  2125. Xnullarray:
  2126. X    maxarg = 0;
  2127. X#ifdef DEBUGGING
  2128. X    dlevel--;
  2129. X    if (debug & 8)
  2130. X    deb("%s RETURNS ()\n",opname[optype],value);
  2131. X#endif
  2132. X    goto freeargs;
  2133. X}
  2134. !STUFFY!FUNK!
  2135. echo ""
  2136. echo "End of kit 3 (of 10)"
  2137. cat /dev/null >kit3isdone
  2138. config=true
  2139. for iskit in 1 2 3 4 5 6 7 8 9 10; do
  2140.     if test -f kit${iskit}isdone; then
  2141.     echo "You have run kit ${iskit}."
  2142.     else
  2143.     echo "You still need to run kit ${iskit}."
  2144.     config=false
  2145.     fi
  2146. done
  2147. case $config in
  2148.     true)
  2149.     echo "You have run all your kits.  Please read README and then type Configure."
  2150.     chmod 755 Configure
  2151.     ;;
  2152. esac
  2153. : Someone might mail this, so...
  2154. exit
  2155.