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