home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / awk / awk320sr.zip / AWKPROC.C < prev    next >
C/C++ Source or Header  |  1991-04-25  |  35KB  |  1,384 lines
  1. /*
  2.  * Awk pseudo code execution
  3.  *
  4.  * Copyright (C) 1988, 1989, 1990, 1991 by Rob Duff
  5.  * All rights reserved
  6.  */
  7.  
  8. #define XDEBUG 1
  9.  
  10. #include <stdio.h>
  11. #include <conio.h>
  12. #include <string.h>
  13. #include <stdlib.h>
  14. #include <mem.h>
  15. #include <math.h>
  16. #include <time.h>
  17. #include <alloc.h>
  18. #include <setjmp.h>
  19.  
  20. #include "awkfstr.h"
  21. #include "awk.h"
  22.  
  23. #define getarg(type) (*((type*)pcode)++)
  24.  
  25. extern jmp_buf nextjmp, exitjmp;
  26.  
  27. #define pop(x) xpop(x)
  28. #define push(x) xpush(x)
  29. #define get(x, y) xmove(x, y)
  30.  
  31. extern void xpop(void far *dst);
  32. extern void xpush(void far *src);
  33. extern void xmove(void far *dst, void far *src);
  34.  
  35. extern int rexp;
  36.  
  37. extern long randl(void);
  38. extern void srandl(long);
  39.  
  40. int test(int, ITEM*);
  41. int isin(ITEM*, ITEM*);
  42. int ijump(ITEM*, ITEM*);
  43. int split(FSTR, ITEM*, FSTR);
  44.  
  45. char *xprintf(FSTR, ITEM*, int);
  46.  
  47. void load(ITEM*, ITEM*);
  48. void store(ITEM*, ITEM*);
  49. void index(ITEM*, ITEM*, ITEM*);
  50. void select(ITEM*, ITEM*, ITEM*);
  51. void copyitem(ITEM*, ITEM*);
  52.  
  53. static void call(int, int, ITEM*);
  54. static void enter(IDENT*, int);
  55. static void leave(void);
  56.  
  57. void make_array(ITEM*);
  58. void clear_array(ITEM*);
  59. ELEMENT *add_element(ELEMENT*, ITEM*);
  60.  
  61. void free_item(ITEM*);
  62. void free_string(FSTR);
  63. void free_array(ELEMENT*);
  64.  
  65. FSTR allstr(unsigned long);
  66. void *allawk(unsigned);
  67.  
  68. extern int trace;
  69.  
  70. static int break_check = 100;
  71.  
  72. static  ITEM    a[1] = { { ACTUAL, SHORT } };
  73. static  ITEM    c[1] = { { ACTUAL, SHORT } };
  74. static  ITEM  one[1] = { { ACTUAL, SHORT, "\0377", 1 } };
  75.  
  76. static  int     opcode;
  77. static  int     i, j;
  78. static  void    *v;
  79.  
  80. struct {
  81.     int     cyline;
  82.     void    *cpcode;
  83.     void    *cdebug;
  84.     ITEM    *cframe;
  85.     ITEM    *cstack;
  86. } stack[MAXLEVEL];
  87.  
  88. static int  level;
  89. static char *pcode;
  90. static char *debug;
  91.  
  92. /*
  93.  * execute pseudo code and return expression value
  94.  */
  95. int awkexec(char *cp)
  96. {
  97.     level = 0;
  98.     yyline = 0;
  99.     pcode = cp;
  100.     debug = cp;
  101.     for (;;) {
  102. #if XDEBUG
  103.         if (trace)
  104.             print_op(debug, pcode);
  105. #endif
  106.         opcode = *pcode++;
  107.         switch (opcode) {
  108.         case END:
  109.             if (stackptr < stacktop) {
  110.                 i = test(IS, stackptr);
  111.                 while (stackptr < stacktop)
  112.                     free_item(stackptr++);
  113.             }
  114.             else
  115.                 i = 0;
  116.             return i;
  117.         case EQ:
  118.         case NE:
  119.         case LT:
  120.         case GT:
  121.         case LE:
  122.         case GE:
  123.             compare(opcode, stackptr+1, stackptr, c);
  124.             free_item(stackptr++);
  125.             free_item(stackptr++);
  126.             push(c);
  127.             break;
  128.         case MUL:
  129.         case DIV:
  130.         case MOD:
  131.         case ADD:
  132.         case SUB:
  133.             arithmetic(opcode, stackptr+1, stackptr, c);
  134.             free_item(stackptr++);
  135.             free_item(stackptr++);
  136.             push(c);
  137.             break;
  138.         case PRE:
  139.         case POST:
  140.             load(stackptr, a);
  141.             arithmetic(getarg(char), a, one, c);
  142.             store(c, stackptr);
  143.             free_item(stackptr++);
  144.             if (opcode == POST)
  145.                 push(a);
  146.             else {
  147.                 free_item(a);
  148.                 push(c);
  149.             }
  150.             break;
  151.         case IS:
  152.         case NOT:
  153.             c->svalue.ival = test(opcode, stackptr);
  154.             c->stype = SHORT;
  155.             c->sclass = ACTUAL;
  156.             c->sstr = nullstr;
  157.             free_item(stackptr++);
  158.             push(c);
  159.             break;
  160.         case RAND:
  161.             c->svalue.dval = ldexp(randl(), rexp);
  162.             c->stype = DOUBLE;
  163.             c->sclass = ACTUAL;
  164.             c->sstr = nullstr;
  165.             push(c);
  166.             break;
  167.         case SYS:
  168.             fstrncpy(buffer, tostring(stackptr), MAXCODE-1);
  169.             c->svalue.ival = system(buffer+1);
  170.             c->stype = SHORT;
  171.             c->sclass = ACTUAL;
  172.             free_item(stackptr++);
  173.             push(c);
  174.             break;
  175.         case LEN:
  176.             c->svalue.lval = fstrlen(tostring(stackptr)+1);
  177.             c->stype = LONG;
  178.             c->sclass = ACTUAL;
  179.             c->sstr = nullstr;
  180.             free_item(stackptr++);
  181.             push(c);
  182.             break;
  183.         case INT:
  184.             modf(todouble(stackptr), &c->svalue.dval);
  185.             c->stype = DOUBLE;
  186.             c->sclass = ACTUAL;
  187.             c->sstr = nullstr;
  188.             free_item(stackptr++);
  189.             push(c);
  190.             break;
  191.         case NEG:
  192.         case NUM:
  193.         case COS:
  194.         case EXP:
  195.         case LOG:
  196.         case SIN:
  197.         case SQRT:
  198.             dfunc1(opcode, stackptr, c);
  199.             free_item(stackptr++);
  200.             push(c);
  201.             break;
  202.         case ATAN2:
  203.         case POW:
  204.             dfunc2(opcode, stackptr+1, stackptr, c);
  205.             free_item(stackptr++);
  206.             free_item(stackptr++);
  207.             push(c);
  208.             break;
  209.         case IN:
  210.             c->svalue.ival = isin(stackptr+1, stackptr);
  211.             c->stype = SHORT;
  212.             c->sclass = ACTUAL;
  213.             free_item(stackptr++);
  214.             free_item(stackptr++);
  215.             push(c);
  216.             break;
  217.         case MAT:
  218.             match(tostring(stackptr+1), toregexp(stackptr));
  219.             c->svalue.ival = rstart?1:0;
  220.             c->stype = SHORT;
  221.             c->sclass = ACTUAL;
  222.             free_item(stackptr++);
  223.             free_item(stackptr++);
  224.             push(c);
  225.             break;
  226.         case CAT:
  227.             c->sstr = catstr(onestring(stackptr+1), tostring(stackptr));
  228.             c->stype = STRING;
  229.             c->sclass = ACTUAL;
  230.             free_item(stackptr++);
  231.             free_item(stackptr++);
  232.             push(c);
  233.             break;
  234.         case UPR:
  235.             c->sstr = uprstr(onestring(stackptr));
  236.             c->stype = STRING;
  237.             c->sclass = ACTUAL;
  238.             free_item(stackptr++);
  239.             push(c);
  240.             break;
  241.         case LWR:
  242.             c->sstr = lwrstr(onestring(stackptr));
  243.             c->stype = STRING;
  244.             c->sclass = ACTUAL;
  245.             free_item(stackptr++);
  246.             push(c);
  247.             break;
  248.         case LOAD:
  249.             load(stackptr, c);
  250.             free_item(stackptr++);
  251.             push(c);
  252.             break;
  253.         case SELECT:
  254.             select(stackptr+1, stackptr, c);
  255.             free_item(stackptr++);
  256.             free_item(stackptr++);
  257.             push(c);
  258.             break;
  259.         case STORE:
  260.             i = getarg(char);
  261.             if (i == 0) {
  262.                 store(stackptr, stackptr+1);
  263.                 load(stackptr+1, c);
  264.             }
  265.             else {
  266.                 load(stackptr+1, a);
  267.                 arithmetic(i, a, stackptr, c);
  268.                 store(c, stackptr+1);
  269.                 free_item(a);
  270.             }
  271.             free_item(stackptr++);
  272.             free_item(stackptr++);
  273.             push(c);
  274.             break;
  275.         case DUP:
  276.             stackptr--;
  277.             copyitem(stackptr+1, stackptr);
  278.             break;
  279.         case UNDER:
  280.             stackptr--;
  281.             copyitem(stackptr+2, stackptr);
  282.             break;
  283.         case SWAP:
  284.             get(c, stackptr);
  285.             get(stackptr, stackptr+1);
  286.             get(stackptr+1, c);
  287.             break;
  288.         case DROP:
  289.             free_item(stackptr++);
  290.             break;
  291.         case CALL:
  292.             i = getarg(char);   /* procnum */
  293.             j = getarg(char);   /* params */
  294.             call(i, j, c);
  295.             break;
  296.         case USER:
  297.             i = getarg(char);   /* params */
  298.             v = getarg(void*);  /* function */
  299.             enter(v, i);
  300.             break;
  301.         case RETURN:
  302.             pop(c);
  303.             leave();
  304.             push(c);
  305.             break;
  306.         case JUMP:
  307.             i = getarg(short);
  308.             pcode += i;
  309.             if (break_check-- < 0) {
  310.                 kbhit();
  311.                 break_check = 100;
  312.             }
  313.             break;
  314.         case FJMP:
  315.         case TJMP:
  316.             i = getarg(short);
  317.             if (test((opcode == FJMP) ? NOT: IS, stackptr)) {
  318.                 pcode += i;
  319.                 if (break_check-- < 0) {
  320.                     kbhit();
  321.                     break_check = 100;
  322.                 }
  323.             }
  324.             free_item(stackptr++);
  325.             break;
  326.         case OJMP:
  327.         case AJMP:
  328.             i = getarg(short);
  329.             if (test((opcode == AJMP) ? NOT: IS, stackptr)) {
  330.                 pcode += i;
  331.                 c->svalue.ival = (opcode == AJMP) ? 0 : 1;
  332.                 c->stype = SHORT;
  333.                 c->sclass = ACTUAL;
  334.                 push(c);
  335.             }
  336.             free_item(stackptr++);
  337.             break;
  338.         case IJMP:
  339.             i = getarg(short);
  340.             v = tovariable(stackptr + 1, LOAD);
  341.             if (ijump(stackptr, v) == 0) {
  342.                 pcode += i;
  343.                 if (break_check-- < 0) {
  344.                     kbhit();
  345.                     break_check = 100;
  346.                 }
  347.                 free_item(stackptr++);
  348.                 free_item(stackptr++);
  349.             }
  350.             break;
  351.         case DOLAR:
  352.             i = tointeger(stackptr);
  353.             if (i < 0 || i >= MAXFIELD)
  354.                 error("Field out of range");
  355.             c->svalue.sptr = fieldtab + i;
  356.             c->stype = FIELD;
  357.             c->sclass = FORMAL;
  358.             free_item(stackptr++);
  359.             push(c);
  360.             break;
  361.         case FEEL:
  362.             c->svalue.sptr = getarg(void*);
  363.             c->stype = FIELD;
  364.             c->sclass = FORMAL;
  365.             push(c);
  366.             break;
  367.         case BUILD:
  368.             c->svalue.sptr = getarg(void*);
  369.             c->stype = BUILTIN;
  370.             c->sclass = FORMAL;
  371.             push(c);
  372.             break;
  373.         case ADDR:
  374.             c->svalue.sptr = getarg(void*);
  375.             c->stype = SIMPLE;
  376.             c->sclass = FORMAL;
  377.             push(c);
  378.             break;
  379.         case AUTO:
  380.             c->svalue.sptr = stacktop + getarg(short);
  381.             c->stype = STACK;
  382.             c->sclass = FORMAL;
  383.             push(c);
  384.             break;
  385.         case CCON:
  386.             c->svalue.dval = getarg(char);
  387.             c->stype = DOUBLE;
  388.             c->sclass = ACTUAL;
  389.             push(c);
  390.             break;
  391.         case ICON:
  392.             c->svalue.dval = getarg(short);
  393.             c->stype = DOUBLE;
  394.             c->sclass = ACTUAL;
  395.             push(c);
  396.             break;
  397.         case LCON:
  398.             c->svalue.lval = getarg(long);
  399.             c->stype = DOUBLE;
  400.             c->sclass = ACTUAL;
  401.             push(c);
  402.             break;
  403.         case DCON:
  404.             c->svalue.dval = getarg(double);
  405.             c->stype = DOUBLE;
  406.             c->sclass = ACTUAL;
  407.             push(c);
  408.             break;
  409.         case SCON:
  410.             c->sstr = getarg(char*);
  411.             c->stype = STRING;
  412.             c->sclass = ACTUAL;
  413.             push(c);
  414.             break;
  415.         case RCON:
  416.             c->svalue.cptr = getarg(void*);
  417.             c->stype = REGEXP;
  418.             c->sclass = ACTUAL;
  419.             push(c);
  420.             break;
  421.         case FCON:
  422.             c->svalue.fptr = getarg(void*);
  423.             c->stype = FILES;
  424.             c->sclass = ACTUAL;
  425.             push(c);
  426.             break;
  427.         case LINE:
  428.             yyname = getarg(char*);
  429.             yyline = getarg(short);
  430.             break;
  431.         default:
  432.             error("Invalid opcode %03o", opcode);
  433.         }
  434.     }
  435. }
  436.  
  437. /*
  438.  * test array b to see if an element with index a exists
  439.  */
  440. int isin(ITEM *a, ITEM *b)
  441. {
  442.     FSTR    si;
  443.     ITEM    *vp;
  444.     ELEMENT *ep;
  445.  
  446.     vp = tovariable(b, LOAD);
  447.     if (vp->stype == ARRAY) {
  448.         si = tostring(a);
  449.         ep = vp->svalue.aptr;
  450.         while (ep != NULL) {
  451.             if (fstrcmp(si+1, ep->aindex+1) == 0)
  452.                 if (ep->atype == NUMBER && ep->astr == nullstr)
  453.                     return 0;
  454.                 else
  455.                     return 1;
  456.             ep = ep->anext;
  457.         }
  458.     }
  459.     return 0;
  460. }
  461.  
  462. /*
  463.  * logical (true/false) test
  464.  */
  465. int test(int op, ITEM *ip)
  466. {
  467.     if (op == NOT) {
  468.         if (ip->stype == STRING)
  469.             return ip->sstr[0] == '\0';
  470.         else if (ip->stype == SHORT)
  471.             return ip->svalue.ival == 0;
  472.         else if (ip->stype == LONG)
  473.             return ip->svalue.lval == 0;
  474.         else
  475.             return todouble(ip) == 0;
  476.     }
  477.     else {
  478.         if (ip->stype == STRING)
  479.             return ip->sstr[0] != '\0';
  480.         else if (ip->stype == SHORT)
  481.             return ip->svalue.ival != 0;
  482.         else if (ip->stype == LONG)
  483.             return ip->svalue.lval != 0;
  484.         else
  485.             return todouble(ip) != 0;
  486.     }
  487. }
  488.  
  489. /*
  490.  * call the standard procedures
  491.  */
  492. static void call(int p, int n, ITEM *c)
  493. {
  494.     int     pc, i, j, k;
  495.     long    ltime;
  496.     double  d;
  497.     FSTR    s, t;
  498.     char    *r;
  499.     FYLE    *fp;
  500.     ITEM    *vp;
  501.     ELEMENT *ep;
  502.     ELEMENT *bp;
  503.  
  504.     pc = 0;
  505.     switch(p) {
  506.     case NEXT:
  507.         stacktop = stackbot + MAXSTACK;
  508.         while (stackptr < stacktop) {
  509.             free_item(stackptr);
  510.             stackptr++;
  511.         }
  512.         longjmp(nextjmp, 1);
  513.         break;
  514.     case EXIT:
  515.         if (n == 1)
  516.             status = tointeger(stackptr);
  517.         stacktop = stackbot + MAXSTACK;
  518.         while (stackptr < stacktop)
  519.             free_item(stackptr++);
  520.         longjmp(exitjmp, 1);
  521.         break;
  522.     case SRAND:
  523.         if (n == 0) {
  524.             time(<ime);
  525.         }
  526.         else {
  527.             ltime = ldexp(modf(todouble(stacktop), &d), -rexp);
  528.         }
  529.         srandl(ltime);
  530.         break;
  531.     case PRINT:
  532.         t = onestring((ITEM*)ofs);
  533.         fp = tofyle(stackptr);
  534.         for (i = n - 1; i >= 1; i--) {
  535.             s = tostring(stackptr+i);
  536.             fprintf(fp->ffyle, "%Fs", s+1);
  537.             if (i > 1)
  538.                 fprintf(fp->ffyle, "%Fs", t+1);
  539.         }
  540.         s = onestring((ITEM*)ors);
  541.         fprintf(fp->ffyle, "%Fs", s+1);
  542.         break;
  543.     case PRINTF:
  544.         s = onestring(stackptr + n - 1);
  545.         r = xprintf(s, stackptr + n - 2, n - 2);
  546.         fp = tofyle(stackptr);
  547.         fputs(r+1, fp->ffyle);
  548.         break;
  549.     case SPRINTF:
  550.         pc = 1;
  551.         s = onestring(stackptr + n - 1);
  552.         r = xprintf(s, stackptr + n - 2, n - 1);
  553.         c->sstr = getstr(r);
  554.         c->stype = STRING;
  555.         c->sclass = ACTUAL;
  556.         break;
  557.     case GETLINE:
  558.         pc = 1;
  559.         fp = tofyle(stackptr);
  560.         vp = tovariable(stackptr+1, STORE);
  561.         c->svalue.ival = getline(fp, (ITEM*)vp);
  562.         c->stype = SHORT;
  563.         c->sclass = ACTUAL;
  564.         break;
  565.     case GSUB:
  566.     case LSUB:
  567.         pc = 1;
  568.         i = p == GSUB;
  569.         r = toregexp(stackptr + 3);
  570.         s = onestring(stackptr);
  571.         t = tostring(stackptr + 2);
  572.         c->sstr = subst(i, t, s, r);
  573.         c->stype = STRING;
  574.         c->sclass = ACTUAL;
  575.         store(c, stackptr + 1);
  576.         c->svalue.ival = rcount;
  577.         c->stype = SHORT;
  578.         c->sclass = ACTUAL;
  579.         break;
  580.     case UPR:
  581.     case LWR:
  582.         pc = 1;
  583.         break;
  584.     case JOIN:
  585.         pc = 1;
  586.         code[0] = ZSTR;
  587.         code[1] = '\0';
  588.         t = onestring((ITEM*)subsep);
  589.         for (i = n - 1; i >= 0; i--) {
  590.             s = tostring(stackptr+i);
  591.             fstrcat(code + 1, s + 1);
  592.             if (i > 0)
  593.                 fstrcat(code + 1, t + 1);
  594.         }
  595.         c->sstr = getstr(code);
  596.         c->stype = STRING;
  597.         c->sclass = ACTUAL;
  598.         break;
  599.     case SPLIT:
  600.         pc = 1;
  601.         vp = tovariable(stackptr + 1, STORE);
  602.         s = onestring(stackptr + 2);
  603.         t = tostring(stackptr);
  604.         c->svalue.ival = split(s+1, vp, t+1);
  605.         c->stype = SHORT;
  606.         c->sclass = ACTUAL;
  607.         break;
  608.     case INDEX:
  609.         pc = 1;
  610.         s = onestring(stackptr+1)+1;
  611.         t = tostring(stackptr)+1;
  612.         if (*t == '\0')
  613.             t = s;
  614.         else
  615.             t = fstrstr(s, t);
  616.         if (t != NULL)
  617.             i = (int)(t - s) + 1;
  618.         else
  619.             i = 0;
  620.         c->svalue.ival = i;
  621.         c->stype = SHORT;
  622.         c->sclass = ACTUAL;
  623.         break;
  624.     case MATCH:
  625.         pc = 1;
  626.         s = onestring(stackptr+1);
  627.         r = toregexp(stackptr);
  628.         match(s, r);
  629.         free_item(rl);
  630.         rl->stype = DOUBLE;
  631.         rl->svalue.dval = rlength;
  632.         free_item(rst);
  633.         rst->stype = DOUBLE;
  634.         rst->svalue.dval = rstart;
  635.         c->svalue.dval = rstart;
  636.         c->stype = DOUBLE;
  637.         c->sclass = ACTUAL;
  638.         break;
  639.     case SUBSTR:
  640.         pc = 1;
  641.         if (n == 3) {
  642.             s = tostring(stackptr+2);
  643.             i = tointeger(stackptr+1);
  644.             j = tointeger(stackptr);
  645.         }
  646.         else {
  647.             i = tointeger(stackptr);
  648.             s = tostring(stackptr+1);
  649.             j = fstrlen(s+1);
  650.         }
  651.         k = fstrlen(s+1);
  652.         if (j < 1 || i < 1 || i > k)
  653.             t = nullstr;
  654.         else {
  655.             if (j > k - i + 1)
  656.                 j = k - i + 1;
  657.             if (j > MAXCODE-2)
  658.                 j = MAXCODE-2;
  659.             code[0] = ZSTR;
  660.             fstrncpy(code+1, s + i, j);
  661.             code[j+1] = '\0';
  662.             t = getstr(code);
  663.         }
  664.         c->sstr = t;
  665.         c->stype = STRING;
  666.         c->sclass = ACTUAL;
  667.         break;
  668.     case CREATE:
  669.     case APPEND:
  670.     case CLOSE:
  671.     case OPEN:
  672.         pc = 1;
  673.         c->svalue.fptr = getfile(stackptr, p);
  674.         c->stype = FILES;
  675.         c->sclass = FORMAL;
  676.         break;
  677.     case DELETE:
  678.         vp = tovariable(stackptr + 1, STORE);
  679.         if (vp->stype == ARRAY) {
  680.             bp = NULL;
  681.             ep = vp->svalue.aptr;
  682.             s = tostring(stackptr);
  683.             while (ep != NULL) {
  684.                 if (fstrcmp(s+1, ep->aindex+1) == 0) {
  685.                     if (bp == NULL)
  686.                         if (ep->anext == NULL) {
  687.                             free_item((ITEM*)ep);
  688.                             free_string(ep->aindex);
  689.                             get(ep, nul);
  690.                             ep->aindex = nullstr;
  691.                             break;
  692.                         }
  693.                         else
  694.                             vp->svalue.aptr = ep->anext;
  695.                     else
  696.                         bp->anext = ep->anext;
  697.                     ep->anext = NULL;
  698.                     c->svalue.aptr = ep;
  699.                     c->stype = ARRAY;
  700.                     c->sclass = ACTUAL;
  701.                     free_item(c);
  702.                     break;
  703.                 }
  704.                 bp = ep;
  705.                 ep = ep->anext;
  706.             }
  707.         }
  708.         break;
  709.     }
  710.     while (n > 0 && stackptr < stacktop) {
  711.         free_item(stackptr);
  712.         stackptr++;
  713.         n--;
  714.     }
  715.     if (pc)
  716.         push(c);
  717. }
  718.  
  719. /*
  720.  * enter the user procedure
  721.  */
  722. static void enter(IDENT *p, int n)
  723. {
  724.     int     k;
  725.     FUNC    *fp;
  726.  
  727.     if ((fp = p->vfunc) == NULL)
  728.         error("function not defined %s", p->vname);
  729.     if (level >= MAXLEVEL)
  730.         error("function call depth too great");
  731.  
  732.     stack[level].cyline = yyline;
  733.     stack[level].cpcode = pcode;
  734.     stack[level].cdebug = debug;
  735.     stack[level].cstack = stacktop;
  736.     stack[level].cframe = stackptr + n;
  737.     level++;
  738.  
  739.     k = fp->psize;
  740.     while (n > k) {
  741.         free_item(stackptr++);
  742.         n--;
  743.     }
  744.     while (n < k) {
  745.         push(nul);
  746.         n++;
  747.     }
  748.     stacktop = stackptr;
  749.     if (stacktop - stackbot < 20)
  750.         error("Stack overflow");
  751.     debug = pcode = fp->pcode;
  752. }
  753.  
  754. /*
  755.  * leave the user procedure;
  756.  */
  757. static void leave()
  758. {
  759.     ITEM    *frame;
  760.  
  761.     if (level < 1)
  762.         error("return without gosub");
  763.     level--;
  764.     yyline = stack[level].cyline;
  765.     pcode = stack[level].cpcode;
  766.     debug = stack[level].cdebug;
  767.     stacktop = stack[level].cstack;
  768.     frame = stack[level].cframe;
  769.     while (stackptr < frame) {
  770.         free_item(stackptr++);
  771.     }
  772. }
  773.  
  774. /*
  775.  * fetch the contents of a variable field or array
  776.  */
  777. void load(ITEM *sp, ITEM *dp)
  778. {
  779.     ITEM    *vp;
  780.  
  781.     vp = tovariable(sp, LOAD);
  782.     get(dp, vp);
  783.     if (vp->stype == STRING || vp->stype == NUMBER)
  784.         dp->sstr = getstr(vp->sstr);
  785.     else if (vp->stype == ARRAY)
  786.         dp->sclass = FORMAL;
  787. }
  788.  
  789. /*
  790.  * Set the regular expression associated with the field separator
  791.  */
  792. void setfs()
  793. {
  794.     FSTR    fsp;
  795.  
  796.     fsp = tostring(fs);
  797.     if (fsp[1] == ' ' && fsp[2] == '\0') {
  798.         if (awkfs != blankfs) {
  799.             free_string(awkfs);
  800.             if (awkfre[1] != '\0')
  801.                 free(awkfre);
  802.         }
  803.         awkfs = blankfs;
  804.         awkfre = blankre;
  805.     }
  806.     else if (fstrcmp(fsp+1, awkfs+1) != 0) {
  807.         if (awkfs != blankfs) {
  808.             free_string(awkfs);
  809.             if (awkfs[1] == '\0' || awkfs[2] != '\0')
  810.                 free(awkfre);
  811.         }
  812.         awkfs = newstr(fsp);
  813.         if (awkfs[1] != '\0' && awkfs[2] == '\0') {
  814.             awkfre = "  ";
  815.             if (awkfs[1] < ' ') {
  816.                 awkfre[0] = CHAR;
  817.                 awkfre[1] = awkfs[1];
  818.                 awkfre[2] = END;
  819.             }
  820.             else {
  821.                 awkfre[0] = awkfs[1];
  822.                 awkfre[1] = END;
  823.             }
  824.         }
  825.         else {
  826.             lineptr = awkfs+1;
  827.             yyinit();
  828.             awkfre = regexp(2);
  829.         }
  830.     }
  831. }
  832.  
  833. /*
  834.  * store an item (sp) in a variable, field or array
  835.  */
  836. void store(ITEM *sp, ITEM *dp)
  837. {
  838.     ITEM    *vp;
  839.     ELEMENT *ep;
  840.  
  841.     if (sp->stype == ARRAY) {
  842.         ep = sp->svalue.aptr;
  843.         if (ep->atype == NUMBER && ep->astr == nullstr) {
  844.             vp = tovariable(dp, STORE);
  845.             if (vp == nul) return;
  846.             ep = malloc(sizeof(ELEMENT));
  847.             ep->aclass = ACTUAL;
  848.             ep->atype = NUMBER;
  849.             ep->astr = nullstr;
  850.             ep->avalue.dval = 0;
  851.             ep->aindex = nullstr;
  852.             ep->anext = NULL;
  853.             free_item(vp);
  854.             vp->sclass = ACTUAL;
  855.             vp->stype = ARRAY;
  856.             vp->sstr = nullstr;
  857.             vp->svalue.aptr = ep;
  858.             return;
  859.         }
  860.         else
  861.             error("array assignment");
  862.     }
  863.     vp = tovariable(dp, STORE);
  864.     if (vp == nul)
  865.         return;
  866.     free_item(vp);
  867.     get(vp, sp);
  868.     vp->sclass = ACTUAL;
  869.     if (sp->stype == STRING || sp->stype == NUMBER)
  870.         vp->sstr = newstr(sp->sstr);
  871.     if (vp <= ofmt) {
  872.         if (vp == ofmt)
  873.             fstrncpy(ofmtstr, tostring(ofmt), 65);
  874.         if (vp == fs)
  875.             setfs();
  876.     }
  877. }
  878.  
  879. /*
  880.  * free the dynamic storage occupied by an item
  881.  */
  882. void free_item(ITEM *ip)
  883. {
  884.     if (ip->stype == STRING || ip->stype == NUMBER)
  885.         free_string(ip->sstr);
  886.     else if (ip->sclass == ACTUAL && ip->stype == ARRAY)
  887.         free_array(ip->svalue.aptr);
  888.     get(ip, nul);
  889. }
  890.  
  891. /*
  892.  * free the values, indexes and elements of an array
  893.  */
  894. void free_array(ELEMENT *ep)
  895. {
  896.     ELEMENT *next;
  897.  
  898.     while (ep != NULL) {
  899.         next = ep->anext;
  900.         if (ep->atype == STRING || ep->atype == NUMBER)
  901.             free_string(ep->astr);
  902.         free_string(ep->aindex);
  903.         free(ep);
  904.         ep = next;
  905.     }
  906. }
  907.  
  908. /*
  909.  * free the dynamic storage occupied by a string
  910.  * strings have a reference count to avoid multiple
  911.  * allocation and freeing
  912.  */
  913. void free_string(FSTR sp)
  914. {
  915.     if (sp == nullstr)
  916.         return;
  917.     if (*sp == ZSTR || *sp == LSTR || *sp == TSTR)
  918.         return;
  919.     if (*sp == ZSTR + 1)
  920.         farfree(sp);
  921.     else
  922.         *sp -= 1;
  923. }
  924.  
  925. /*
  926.  * allocate dynamic storage for a string
  927.  * strings have a reference count to avoid multiple
  928.  * allocation and freeing
  929.  */
  930. FSTR getstr(FSTR sp)
  931. {
  932.     long    len;
  933.     FSTR    dp;
  934.  
  935.     if (sp[1] == '\0')
  936.         return (nullstr);
  937.     if (*sp == LSTR) {
  938.         return sp;
  939.     }
  940.     if (*sp == TSTR) {
  941.         return sp;
  942.     }
  943.     if (*sp >= 0) {
  944.         fprintf (stderr, "Use count error %Fp '%Fs'\n", sp, sp);
  945.     }
  946.     if (*sp != ZSTR && *sp != ESTR) {
  947.         *sp += 1;
  948.         return sp;
  949.     }
  950.     len = fstrlen(sp+1) + 2;
  951.     dp = allstr(len);
  952.     fstrcpy(dp+1, sp+1);
  953.     *dp = ZSTR + 1;
  954.     return (dp);
  955. }
  956.  
  957. /*
  958.  * allocate dynamic storage for a string
  959.  * strings have a reference count to avoid multiple
  960.  * allocation and freeing
  961.  * this is different from getstr in that temporary
  962.  * strings are allocated and copied when a temp string
  963.  * is stored in a variable or array index.
  964.  */
  965. FSTR newstr(FSTR sp)
  966. {
  967.     long    len;
  968.     FSTR    dp;
  969.  
  970.     if (sp[1] == '\0')
  971.         return (nullstr);
  972.     if (*sp == LSTR) {
  973.         return sp;
  974.     }
  975.     if (*sp >= 0) {
  976.         fprintf (stderr, "Use count error %Fp '%Fs'\n", sp, sp);
  977.     }
  978.     if (*sp != ZSTR && *sp != TSTR && *sp != ESTR) {
  979.         *sp += 1;
  980.         return sp;
  981.     }
  982.     len = fstrlen(sp+1) + 2;
  983.     dp = allstr(len);
  984.     fstrcpy(dp+1, sp+1);
  985.     *dp = ZSTR + 1;
  986.     return (dp);
  987. }
  988.  
  989. FSTR catstr(FSTR a, FSTR b)
  990. {
  991.     long    len;
  992.     FSTR    dp;
  993.  
  994.     len = fstrlen(a+1)  + fstrlen(b+1) + 2;
  995.     if (len > 60000L)
  996.         error("string length exceeded");
  997.     dp = allstr(len);
  998.     *dp = ZSTR + 1;
  999.     fstrcpy(dp+1, a+1);
  1000.     fstrcat(dp+1, b+1);
  1001.     return (dp);
  1002. }
  1003.  
  1004. FSTR uprstr(FSTR sp)
  1005. {
  1006.     long    len;
  1007.     FSTR    dp;
  1008.  
  1009.     len = fstrlen(sp+1) + 2;
  1010.     dp = allstr(len);
  1011.     *dp = ZSTR + 1;
  1012.     fstrupr(dp+1, sp+1);
  1013.     return (dp);
  1014. }
  1015.  
  1016. FSTR lwrstr(FSTR sp)
  1017. {
  1018.     long    len;
  1019.     FSTR    dp;
  1020.  
  1021.     len = fstrlen(sp+1) + 2;
  1022.     dp = allstr(len);
  1023.     *dp = ZSTR + 1;
  1024.     fstrlwr(dp+1, sp+1);
  1025.     return (dp);
  1026. }
  1027.  
  1028. /*
  1029.  * copy an item.  Strings are copied.
  1030.  */
  1031. void copyitem(ITEM *sp, ITEM *dp)
  1032. {
  1033.     get(dp, sp);
  1034.     if (sp->stype == STRING || sp->stype == NUMBER)
  1035.         dp->sstr = getstr(sp->sstr);
  1036. }
  1037.  
  1038. /*
  1039.  * index an array element from a with b store in c
  1040.  */
  1041. void index(ITEM *a, ITEM *b, ITEM *c)
  1042. {
  1043.     FSTR    sp;
  1044.     ITEM    *vp;
  1045.     ELEMENT *ep;
  1046.  
  1047.     sp = tostring(b);
  1048.     vp = tovariable(a, LOAD);
  1049.     if (vp->stype == ARRAY) {
  1050.         ep = vp->svalue.aptr;
  1051.         while (ep != NULL) {
  1052.             if (fstrcmp(sp+1, ep->aindex+1) == 0) {
  1053.                 if (ep->atype == NUMBER && ep->astr == nullstr)
  1054.                     ep = NULL;
  1055.                 break;
  1056.             }
  1057.             ep = ep->anext;
  1058.         }
  1059.     }
  1060.     else
  1061.         ep = NULL;
  1062.     if (ep == NULL)
  1063.         get(c, nul);
  1064.     else
  1065.         get(c, ep);
  1066. }
  1067.  
  1068. /*
  1069.  * select an array element from a with index b
  1070.  * store in c, create a new element if not found
  1071.  */
  1072. void select(ITEM *a, ITEM *b, ITEM *c)
  1073. {
  1074.     FSTR    sp;
  1075.     ITEM    *vp;
  1076.     ELEMENT *ep;
  1077.  
  1078.     sp = tostring(b);
  1079.     vp = tovariable(a, LOAD);
  1080.     make_array(vp);
  1081.     ep = vp->svalue.aptr;
  1082.     if (ep->atype == NUMBER && ep->astr == nullstr)
  1083.         ep->aindex = newstr(sp);
  1084.     while (ep != NULL) {
  1085.         if (fstrcmp(sp+1, ep->aindex+1) == 0)
  1086.             break;
  1087.         ep = ep->anext;
  1088.     }
  1089.     if (ep == NULL) {
  1090.         ep = allawk(sizeof(ELEMENT));
  1091.         get(ep, nul);
  1092.         ep->aindex = newstr(sp);
  1093.         ep->anext = NULL;
  1094.         ep = add_element(ep, vp);
  1095.     }
  1096.     c->stype = ARRAY;
  1097.     c->sclass = FORMAL;
  1098.     c->svalue.aptr = ep;
  1099. }
  1100.  
  1101. /*
  1102.  * add element ep into the array pointed to by the
  1103.  * variable pointer vp in lexical order.
  1104.  */
  1105. ELEMENT *add_element(register ELEMENT *ep, ITEM *vp)
  1106. {
  1107.     register ELEMENT *fp, *bp, te[1];
  1108.  
  1109.     bp = NULL;
  1110.     fp = vp->svalue.aptr;
  1111.     while (fp != NULL && fstrcmp(fp->aindex+1, ep->aindex+1) < 0) {
  1112.         bp = fp; fp = fp->anext;
  1113.     }
  1114.     if (bp == NULL) {
  1115.         if (fp == NULL) {
  1116.             ep->anext = NULL;
  1117.             vp->svalue.aptr = ep;
  1118.         }
  1119.         else {
  1120.             bp = fp->anext;
  1121.             *te = *fp;
  1122.             *fp = *ep;
  1123.             *ep = *te;
  1124.             fp->anext = ep;
  1125.             ep->anext = bp;
  1126.             ep = fp;
  1127.         }
  1128.     }
  1129.     else {
  1130.         ep->anext = fp;
  1131.         bp->anext = ep;
  1132.     }
  1133.     return ep;
  1134. }
  1135.  
  1136. /*
  1137.  * make sure that a variable is of type array
  1138.  * if not then initialize it to an empty array
  1139.  */
  1140. void make_array(ITEM *vp)
  1141. {
  1142.     ELEMENT *ep;
  1143.  
  1144.     if (vp->stype != ARRAY) {
  1145.         ep = allawk(sizeof(ELEMENT));
  1146.         get(ep, nul);
  1147.         ep->aindex = nullstr;
  1148.         ep->anext = NULL;
  1149.         free_item((ITEM*)vp);
  1150.         vp->sclass = ACTUAL;
  1151.         vp->stype = ARRAY;
  1152.         vp->svalue.aptr = ep;
  1153.     }
  1154. }
  1155.  
  1156. /*
  1157.  * erase an array or create a new one
  1158.  */
  1159. void clear_array(ITEM *vp)
  1160. {
  1161.     ELEMENT *ep;
  1162.  
  1163.     if (vp->stype == ARRAY) {
  1164.         ep = vp->svalue.aptr;
  1165.         if (ep->atype != NUMBER || ep->astr != nullstr) {
  1166.             free_array(ep->anext);
  1167.             free_item((ITEM*)ep);
  1168.             free_string(ep->aindex);
  1169.             ep->aindex = nullstr;
  1170.             ep->anext = NULL;
  1171.         }
  1172.     }
  1173.     else
  1174.         make_array(vp);
  1175. }
  1176.  
  1177. /*
  1178.  * split a string into fields according to
  1179.  * the regular expression lfs
  1180.  */
  1181. int split(FSTR src, ITEM *vp, FSTR lfs)
  1182. {
  1183.     char    *dst;
  1184.     char    *reg;
  1185.     FSTR    beg;
  1186.     FSTR    mat;
  1187.     FSTR    tp;
  1188.     ELEMENT *ep;
  1189.  
  1190.     c->stype = SHORT;
  1191.     c->sclass = ACTUAL;
  1192.     c->svalue.ival = 0;
  1193.     clear_array(vp);
  1194.     ep = vp->svalue.aptr;
  1195.     if (lfs[0] == ' ' && lfs[1] == '\0') {
  1196.         reg = blankre;
  1197.         while (*src == ' ' || *src == '\t' || *src == '\n')
  1198.             src++;
  1199.     }
  1200.     else if (lfs[0] != '\0' && lfs[1] == '\0') {
  1201.         reg = buffer;
  1202.         if (lfs[0] < ' ')
  1203.             *reg++ = CHAR;
  1204.         *reg++ = lfs[0];
  1205.         *reg++ = END;
  1206.         reg = buffer;
  1207.     }
  1208.     else {
  1209.         lineptr = lfs;
  1210.         yyinit();
  1211.         reg = regexp(0);
  1212.     }
  1213.     beg = src;
  1214.     while (*src != '\0') {
  1215.         dst = code;
  1216.         *dst++ = ZSTR;
  1217.         while (*src != '\0' &&
  1218.               (mat = matchp(beg, src, reg)) == NULL && *src != '\n')
  1219.             *dst++ = *src++;
  1220.         if (mat != NULL && *src != '\0') {
  1221.             if(mat > src)
  1222.                 src = mat;
  1223.             else if (dst == code + 1)
  1224.                 *dst++ = *src++;
  1225.         }
  1226.         else if (*src == '\n')
  1227.             src++;
  1228.         *dst++ = '\0';
  1229.         c->svalue.ival++;
  1230.         tp = getstr(tostring(c));
  1231.         if (ep == NULL) {
  1232.             ep = allawk(sizeof(ELEMENT));
  1233.             ep->anext = NULL;
  1234.             ep->aindex = tp;
  1235.             ep = add_element(ep, vp);
  1236.         }
  1237.         else
  1238.             ep->aindex = tp;
  1239.         ep->aclass = ACTUAL;
  1240.         ep->atype = STRING;
  1241.         ep->astr = getstr(code);
  1242.         if (isnumber(code+1)) {
  1243.             ep->avalue.dval = todouble((ITEM*)ep);
  1244.             ep->atype = NUMBER;
  1245.         }
  1246.         ep = NULL;
  1247.     }
  1248.     return c->svalue.ival;
  1249. }
  1250.  
  1251. /*
  1252.  * do the array index stepping in a 
  1253.  * for (x in y) loop
  1254.  */
  1255. int ijump(ITEM *ip, ITEM *vp)
  1256. {
  1257.     ELEMENT *ep;
  1258.  
  1259.     if (ip->stype != ARRAY)
  1260.         return 0;
  1261.     ep = ip->svalue.aptr;
  1262.     if (ep == NULL || (ep->atype == NUMBER && ep->astr == nullstr))
  1263.         return 0;
  1264.     free_item((ITEM*)vp);
  1265.     vp->stype = STRING;
  1266.     vp->sstr = getstr(ep->aindex);
  1267.     ip->svalue.aptr = ep->anext;
  1268.     return 1;
  1269. }
  1270.  
  1271. /*
  1272.  * perform memory allocation with error checking
  1273.  */
  1274. FSTR allstr(unsigned long int size)
  1275. {
  1276.     FSTR    fmp;
  1277.  
  1278.     fmp = farmalloc(size);
  1279.     if (fmp == NULL)
  1280.         error("Out of memory");
  1281.     return(fmp);
  1282. }
  1283.  
  1284. /*
  1285.  * perform memory allocation with error checking
  1286.  */
  1287. void *allawk(unsigned int size)
  1288. {
  1289.     void    *mp;
  1290.  
  1291.     mp = malloc(size);
  1292.     if (mp == NULL)
  1293.         error("Out of memory");
  1294.     memset(mp, 0, size);
  1295.     return(mp);
  1296. }
  1297.  
  1298. /*
  1299.  * convert the list of n items  in ip to a string
  1300.  * according to the format string sp
  1301.  */
  1302. char *xprintf(FSTR sp, ITEM *ip, int n)
  1303. {
  1304.     char    *dp;
  1305.     char    *fp;
  1306.     int     xf, fc;
  1307.     TRIX    trix;
  1308.  
  1309.     sp++;
  1310.     dp = code;
  1311.     *dp++ = ZSTR;
  1312.     while (*sp != 0) {
  1313.         while (*sp != 0 && *sp != '%' && dp < code+MAXCODE-1)
  1314.             *dp++ = *sp++;
  1315.         if (n > 0 && sp[0] == '%' && sp[1] != '%') {
  1316.             xf = 0;
  1317.             fp = fmtstr;
  1318.             *fp++ = ZSTR;
  1319.             *fp++ = *sp++;
  1320.             if (*sp == '-')
  1321.                 *fp++ = *sp++;
  1322.             while (*sp >= '0' && *sp <= '9')
  1323.                 *fp++ = *sp++;
  1324.             if (*sp == '.') {
  1325.                 *fp++ = *sp++;
  1326.                 while (*sp >= '0' && *sp <= '9')
  1327.                     *fp++ = *sp++;
  1328.             }
  1329.             if (*sp == 'l')
  1330.                 *fp++ = *sp++;
  1331.             *fp++ = fc = *sp++;
  1332.             *fp++ = '\0';
  1333.             switch (fc) {
  1334.             case 's':
  1335.                 fp[-2] = 'F';
  1336.                 fp[-1] = 's';
  1337.                 *fp++ = '\0';
  1338.                 trix.fstr = tostring(ip)+1;
  1339.                 break;
  1340.             case 'c':
  1341.                 if (ip->stype == STRING)
  1342.                     trix.lval = ip->sstr[1];
  1343.                 else
  1344.                     trix.lval = tolong(ip);
  1345.                 break;
  1346.             case 'X':
  1347.             case 'x':
  1348.             case 'o':
  1349.             case 'u':
  1350.             case 'd':
  1351.                 fp[-2] = 'l';
  1352.                 fp[-1] = fc;
  1353.                 *fp++ = '\0';
  1354.                 trix.lval = tolong(ip);
  1355.                 break;
  1356.             case 'E':
  1357.             case 'F':
  1358.             case 'G':
  1359.             case 'e':
  1360.             case 'f':
  1361.             case 'g':
  1362.                 trix.dval = todouble(ip);
  1363.                 break;
  1364.             default:
  1365.                 xf++;
  1366.                 trix.lval = 0;
  1367.             }
  1368.             if (xf == 0) {
  1369.                 n--;
  1370.                 ip--;
  1371.             }
  1372.             sprintf(dp, fmtstr+1, trix.dval);
  1373.             dp = strchr(dp, '\0');
  1374.         }
  1375.         else if (*sp == '%') {
  1376.             *dp++ = '%';
  1377.             sp += 2;
  1378.         }
  1379.     }
  1380.     *dp = '\0';
  1381.     return code;
  1382. }
  1383.  
  1384.