home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / vol_300 / 333_01 / awk2.c < prev    next >
C/C++ Source or Header  |  1989-04-22  |  33KB  |  1,232 lines
  1. /*
  2.  * awk2 --- gawk parse tree interpreter
  3.  *
  4.  * Copyright (C) 1986 Free Software Foundation
  5.  *   Written by Paul Rubin, August 1986
  6.  *
  7.  */
  8.  
  9.  
  10. #include <stdio.h>
  11. #include <stdlib.h>
  12. #include <string.h>
  13. #include <math.h>
  14. #include <setjmp.h>
  15. #include "awk.h"
  16.  
  17.  
  18. /* More of that debugging stuff */
  19. #ifdef FAST
  20. #define DEBUG(X)
  21. #else
  22. #define DEBUG(X)         print_debug X
  23. #endif
  24.  
  25. /* longjmp return codes, must be nonzero */
  26. /* Continue means either for loop/while continue, or next input record */
  27. #define TAG_CONTINUE 1
  28. /* Break means either for/while break, or stop reading input */
  29. #define TAG_BREAK 2
  30.  
  31. /* the loop_tag_valid variable allows continue/break-out-of-context
  32.  * to be caught and diagnosed (jfw) */
  33.  
  34. #define PUSH_BINDING(stack, x)            \
  35.             (memcpy((stack), (x), sizeof(jmp_buf)), loop_tag_valid++)
  36.  
  37. #define RESTORE_BINDING(stack, x)        \
  38.             (memcpy((x), (stack), sizeof(jmp_buf)), loop_tag_valid--)
  39.  
  40. /* for "for(iggy in foo) {" */
  41. struct search
  42. {
  43.     int             numleft;
  44.     AHASH         **arr_ptr;
  45.     AHASH          *bucket;
  46.     NODE           *symbol;
  47.     NODE           *retval;
  48. };
  49.  
  50. STATIC struct search *    NEAR PASCAL    assoc_scan(NODE *symbol);
  51. STATIC struct search *    NEAR PASCAL    assoc_next(struct search *lookat);
  52.  
  53.  
  54. /* Tree is a bunch of rules to run.
  55.    Returns zero if it hit an exit() statement */
  56.  
  57. int PASCAL interpret(NODE *tree)
  58. {
  59.     register NODE  *t;             /* temporary */
  60.  
  61.     auto jmp_buf    loop_tag_stack;  /* shallow binding stack for loop_tag */
  62.     static jmp_buf  loop_tag;         /* always the current binding */
  63.     static int      loop_tag_valid = 0;    /* nonzero when loop_tag valid (jfw) */
  64.  
  65.     static jmp_buf  rule_tag;    /* tag the rule currently being run, for NEXT
  66.                  * and EXIT statements.  It is static because
  67.                  * there are no nested rules */
  68.  
  69.     register NODE **lhs;    /* lhs == Left Hand Side for assigns, etc */
  70.     register struct search *l;    /* For array_for */
  71.  
  72.     /* clean up temporary strings created by evaluating expressions in
  73.      * previous recursive calls */
  74.     obstack_free(&temp_strings, ob_dummy);
  75.  
  76.     if (tree == NULL)
  77.     return(1);
  78.     switch (tree->type)
  79.     {
  80. #ifndef FAST
  81.         /* Can't run these! */
  82.     case NODE_ILLEGAL:
  83.     case NODE_RULE_NODE:
  84.     case NODE_IF_BRANCHES:
  85.     case NODE_EXPRESSION_LIST:
  86.     case NODE_K_BEGIN:
  87.     case NODE_K_END:
  88.     case NODE_REDIRECT_OUTPUT:
  89.     case NODE_REDIRECT_APPEND:
  90.     case NODE_REDIRECT_PIPE:
  91.     case NODE_VAR_ARRAY:
  92.     case NODE_CONDEXP_BRANCHES:
  93.         panic("Illegal node type (%d) in interpret()", tree->type);
  94. #endif
  95.     case NODE_RULE_LIST:
  96.         for (t = tree; t != NULL; t = t->rnode)
  97.         {
  98.         switch (setjmp(rule_tag))
  99.         {
  100.             case 0:    /* normal non-jump */
  101.             if (eval_condition(t->lnode->lnode))
  102.             {
  103.                 DEBUG(("Found a rule:%p", (FPTR)t->lnode->rnode));
  104.                 if (t->lnode->rnode == NULL)
  105.                 {
  106.                 /* special case: pattern with no action is
  107.                  * equivalent to an action of {print} (jfw) */
  108.                 NODE            printnode;
  109.  
  110.                 printnode.type = NODE_K_PRINT;
  111.                 printnode.lnode = NULL;
  112.                 printnode.rnode = NULL;
  113.                 hack_print_node(&printnode);
  114.                 }
  115.                 else
  116.                 (void) interpret(t->lnode->rnode);
  117.             }
  118.             break;
  119.             case TAG_CONTINUE:    /* NEXT statement */
  120.             return(1);
  121.             case TAG_BREAK:
  122.             return(0);
  123.         }
  124.         }
  125.         break;
  126.     case NODE_STATEMENT_LIST:
  127.         /* print_a_node(tree); */
  128.         /* because BEGIN and END do not have Node_rule_list nature, yet
  129.          * can have exits and nexts, we special-case a setjmp of rule_tag
  130.          * here. (jfw) */
  131.         if (tree == begin_block || tree == end_block)
  132.         {
  133.         switch (setjmp(rule_tag))
  134.         {
  135.             case TAG_CONTINUE:    /* next */
  136.             panic("unexpected next");
  137.             return(1);
  138.             case TAG_BREAK:
  139.             return(0);
  140.         }
  141.         }
  142.         for (t = tree; t != NULL; t = t->rnode)
  143.         {
  144.         DEBUG(("Statements:%p", (FPTR) t->lnode));
  145.         (void) interpret(t->lnode);
  146.         }
  147.         break;
  148.     case NODE_K_IF:
  149.         DEBUG(("IF:%p", (FPTR) tree->lnode));
  150.         if (eval_condition(tree->lnode))
  151.         {
  152.         DEBUG(("True:%p", (FPTR) tree->rnode->lnode));
  153.         (void) interpret(tree->rnode->lnode);
  154.         }
  155.         else
  156.         {
  157.         DEBUG(("False:%p", (FPTR) tree->rnode->rnode));
  158.         (void) interpret(tree->rnode->rnode);
  159.         }
  160.         break;
  161.     case NODE_K_WHILE:
  162.         PUSH_BINDING(loop_tag_stack, loop_tag);
  163.  
  164.         DEBUG(("WHILE:%p", (FPTR) tree->lnode));
  165.         while (eval_condition(tree->lnode))
  166.         {
  167.         switch (setjmp(loop_tag))
  168.         {
  169.             case 0:    /* normal non-jump */
  170.             DEBUG(("DO:%p", (FPTR) tree->rnode));
  171.             (void) interpret(tree->rnode);
  172.             break;
  173.             case TAG_CONTINUE:    /* continue statement */
  174.             break;
  175.             case TAG_BREAK:    /* break statement */
  176.             RESTORE_BINDING(loop_tag_stack, loop_tag);
  177.             return(1);
  178. #ifndef FAST
  179.             default:
  180.             panic("Bad setjmp return (WHILE) - interpret()");
  181. #endif
  182.         }
  183.         }
  184.         RESTORE_BINDING(loop_tag_stack, loop_tag);
  185.         break;
  186.     case NODE_K_FOR:
  187.         PUSH_BINDING(loop_tag_stack, loop_tag);
  188.         DEBUG(("FOR:%p", (FPTR) tree->forloop->init));
  189.         (void) interpret(tree->forloop->init);
  190.         DEBUG(("FOR.WHILE:%p", (FPTR) tree->forloop->cond));
  191.         while (eval_condition(tree->forloop->cond))
  192.         {
  193.         switch (setjmp(loop_tag))
  194.         {
  195.             case 0:    /* normal non-jump */
  196.             DEBUG(("FOR.DO:%p", (FPTR) tree->lnode));
  197.             (void) interpret(tree->lnode);
  198.             /* fall through */
  199.             case TAG_CONTINUE:    /* continue statement */
  200.             DEBUG(("FOR.INCR:%p", (FPTR)tree->forloop->incr));
  201.             (void) interpret(tree->forloop->incr);
  202.             break;
  203.             case TAG_BREAK:    /* break statement */
  204.             RESTORE_BINDING(loop_tag_stack, loop_tag);
  205.             return(1);
  206. #ifndef FAST
  207.             default:
  208.             panic("Bad setjmp return (FOR.WHILE) - interpret()");
  209. #endif
  210.         }
  211.         }
  212.         RESTORE_BINDING(loop_tag_stack, loop_tag);
  213.         break;
  214.     case NODE_K_ARRAYFOR:
  215.         PUSH_BINDING(loop_tag_stack, loop_tag);
  216.         DEBUG(("AFOR.VAR:%p", (FPTR) tree->forloop->init));
  217.         lhs = get_lhs(tree->forloop->init);
  218.         do_deref();
  219.         for (l = assoc_scan(tree->forloop->incr); l; l = assoc_next(l))
  220.         {
  221.         *lhs = dupnode(l->retval);
  222.         DEBUG(("AFOR.NEXTIS:%p", (FPTR) *lhs));
  223.         switch (setjmp(loop_tag))
  224.         {
  225.             case 0:
  226.             DEBUG(("AFOR.DO:%p", (FPTR) tree->lnode));
  227.             (void) interpret(tree->lnode);
  228.             case TAG_CONTINUE:
  229.             break;
  230.  
  231.             case TAG_BREAK:
  232.             RESTORE_BINDING(loop_tag_stack, loop_tag);
  233.             return(1);
  234. #ifndef FAST
  235.             default:
  236.             panic("Bad setjmp return (AFOR.NEXT) - interpret()");
  237. #endif
  238.         }
  239.         }
  240.         RESTORE_BINDING(loop_tag_stack, loop_tag);
  241.         break;
  242.     case NODE_K_BREAK:
  243.         DEBUG(("BREAK:"));
  244.         if (loop_tag_valid == 0)    /* jfw */
  245.         panic("unexpected break or continue");
  246.         longjmp(loop_tag, TAG_BREAK);
  247.         break;
  248.     case NODE_K_CONTINUE:
  249.         DEBUG(("CONTINUE:"));
  250.         if (loop_tag_valid == 0)    /* jfw */
  251.         panic("unexpected break or continue");
  252.         longjmp(loop_tag, TAG_CONTINUE);
  253.         break;
  254.     case NODE_K_PRINT:
  255.         DEBUG(("PRINT:%p", (FPTR) tree));
  256.         (void) hack_print_node(tree);
  257.         break;
  258.     case NODE_K_PRINTF:
  259.         DEBUG(("PRINTF:%p", (FPTR) tree));
  260.         (void) do_printf(tree);
  261.         break;
  262.     case NODE_K_NEXT:
  263.         DEBUG(("NEXT:"));
  264.         longjmp(rule_tag, TAG_CONTINUE);
  265.         break;
  266.     case NODE_K_EXIT:
  267.         /* The unix awk doc says to skip the rest of the input.  Does
  268.          * that mean after performing all the rules on the current line?
  269.          * Unix awk quits immediately, so this does too. */
  270.         /* The UN*X exit can also take an optional arg return code.  We
  271.          * don't */
  272.         /* Well, we parse it, but never *DO* it */
  273.         DEBUG(("EXIT:"));
  274.         longjmp(rule_tag, TAG_BREAK);
  275.         break;
  276.     case NODE_K_DELETE:
  277.         assoc_lookup(tree->lnode, tree->rnode, ASSOC_DELETE);
  278.         break;
  279.     default:
  280.         /* Appears to be an expression statement.  Throw away the value. */
  281.         DEBUG(("Exp:"));
  282.         (void) tree_eval(tree);
  283.         break;
  284.     }
  285.     return(1);
  286. }
  287.  
  288.  
  289. /* evaluate a subtree, allocating strings on a temporary stack. */
  290. /* This used to return a whole NODE, instead of a ptr to one, but that
  291.    led to lots of obnoxious copying.  I got rid of it (JF) */
  292.  
  293. NODE * PASCAL tree_eval(NODE *tree)
  294. {
  295.     register NODE    *r, *t1, *t2; /* return value and temporary subtrees */
  296.     register NODE   **lhs;
  297.     auto     AWKNUM   x;       /* Why are these static? */
  298.  
  299.     if (tree == NULL)
  300.     {
  301.     DEBUG(("NULL"));
  302.     return(Nnull_string);
  303.     }
  304.     switch (tree->type)
  305.     {
  306.         /* trivial data */
  307.     case NODE_STRING:
  308.         DEBUG(("DATA:(string) %p [%s]", (FPTR) tree, force_string(tree)->stptr));
  309.         return(tree);
  310.     case NODE_NUMBER:
  311.         DEBUG(("DATA:(number) %p [%g]", (FPTR) tree, force_number(tree)));
  312.         return(tree);
  313.     case NODE_REGEXP:
  314.         DEBUG(("DATA:(regexp) %p", (FPTR) tree));
  315.         return(tree);
  316.  
  317.         /* Builtins */
  318.     case NODE_BUILTIN:
  319.         DEBUG(("builtin:%p", (FPTR) tree));
  320.         return((*tree->proc)(tree->subnode));
  321.  
  322.     case NODE_CONDEXP:
  323.         DEBUG(("condexp:%p", (FPTR) tree));
  324.         if (eval_condition(tree->lnode))
  325.         {
  326.         DEBUG(("True:%p", (FPTR) tree->rnode->lnode));
  327.         r = tree->rnode->lnode;
  328.         }
  329.         else
  330.         {
  331.         DEBUG(("False:%p", (FPTR) tree->rnode->rnode));
  332.         r = tree->rnode->rnode;
  333.         }
  334.         return(r);
  335.  
  336.  
  337.         /* unary operations */
  338.     case NODE_VAR:
  339.     case NODE_SUBSCRIPT:
  340.     case NODE_FIELD_SPEC:
  341.         DEBUG(("var_type ref:%p", (FPTR) tree));
  342.         lhs = get_lhs(tree);
  343.         return(*lhs);
  344.  
  345.     case NODE_PREINCREMENT:
  346.     case NODE_PREDECREMENT:
  347.         DEBUG(("+-X:%p", (FPTR) tree));
  348.         lhs = get_lhs(tree->subnode);
  349.         assign_number(lhs, force_number(*lhs) +
  350.                    (tree->type == NODE_PREINCREMENT ? 1.0 : -1.0));
  351.         return(*lhs);
  352.  
  353.     case NODE_POSTINCREMENT:
  354.     case NODE_POSTDECREMENT:
  355.         DEBUG(("X+-:%p", (FPTR) tree));
  356.         lhs = get_lhs(tree->subnode);
  357.         x = force_number(*lhs);
  358.         assign_number(lhs, x +
  359.                   (tree->type == NODE_POSTINCREMENT ? 1.0 : -1.0));
  360.         return(tmp_number(x));
  361.  
  362.     case NODE_UNARY_MINUS:
  363.         DEBUG(("UMINUS:%p", (FPTR) tree));
  364.         return(tmp_number(-force_number(tree_eval(tree->subnode))));
  365.  
  366.         /* assignments */
  367.     case NODE_ASSIGN:
  368.         DEBUG(("ASSIGN:%p", (FPTR) tree));
  369.         r = tree_eval(tree->rnode);
  370.         lhs = get_lhs(tree->lnode);
  371.         *lhs = dupnode(r);
  372.         do_deref();
  373.         if (tree->lnode->type == NODE_FIELD_SPEC)
  374.         field_spec_changed(tree->lnode->lnode->numbr);
  375.         return(r);
  376.  
  377.         /* other assignment types are easier because they are numeric */
  378.     case NODE_ASSIGN_EXPONENTIAL:
  379.         r = tree_eval(tree->rnode);
  380.         lhs = get_lhs(tree->lnode);
  381.         assign_number(lhs, pow(force_number(*lhs), force_number(r)));
  382.         do_deref();
  383.         if (tree->lnode->type == NODE_FIELD_SPEC)
  384.         field_spec_changed(tree->lnode->lnode->numbr);
  385.         return(r);
  386.  
  387.     case NODE_ASSIGN_TIMES:
  388.         r = tree_eval(tree->rnode);
  389.         lhs = get_lhs(tree->lnode);
  390.         assign_number(lhs, force_number(*lhs) * force_number(r));
  391.         do_deref();
  392.         if (tree->lnode->type == NODE_FIELD_SPEC)
  393.         field_spec_changed(tree->lnode->lnode->numbr);
  394.         return(r);
  395.  
  396.     case NODE_ASSIGN_QUOTIENT:
  397.         r = tree_eval(tree->rnode);
  398.         lhs = get_lhs(tree->lnode);
  399.         assign_number(lhs, force_number(*lhs) / force_number(r));
  400.         do_deref();
  401.         if (tree->lnode->type == NODE_FIELD_SPEC)
  402.         field_spec_changed(tree->lnode->lnode->numbr);
  403.         return(r);
  404.  
  405.     case NODE_ASSIGN_MOD:
  406.         r = tree_eval(tree->rnode);
  407.         lhs = get_lhs(tree->lnode);
  408.         assign_number(lhs, (AWKNUM) (((int) force_number(*lhs)) % ((int) force_number(r))));
  409.         do_deref();
  410.         if (tree->lnode->type == NODE_FIELD_SPEC)
  411.         field_spec_changed(tree->lnode->lnode->numbr);
  412.         return(r);
  413.  
  414.     case NODE_ASSIGN_PLUS:
  415.         r = tree_eval(tree->rnode);
  416.         lhs = get_lhs(tree->lnode);
  417.         assign_number(lhs, force_number(*lhs) + force_number(r));
  418.         do_deref();
  419.         if (tree->lnode->type == NODE_FIELD_SPEC)
  420.         field_spec_changed(tree->lnode->lnode->numbr);
  421.         return(r);
  422.  
  423.     case NODE_ASSIGN_MINUS:
  424.         r = tree_eval(tree->rnode);
  425.         lhs = get_lhs(tree->lnode);
  426.         assign_number(lhs, force_number(*lhs) - force_number(r));
  427.         do_deref();
  428.         if (tree->lnode->type == NODE_FIELD_SPEC)
  429.         field_spec_changed(tree->lnode->lnode->numbr);
  430.         return(r);
  431.     }
  432.     /* Note that if TREE is invalid, gAWK will probably bomb in one of these
  433.      * tree_evals here.  */
  434.     /* evaluate subtrees in order to do binary operation, then keep going */
  435.     t1 = tree_eval(tree->lnode);
  436.     t2 = tree_eval(tree->rnode);
  437.  
  438.     switch (tree->type)
  439.     {
  440.     case NODE_CONCAT:
  441.         t1 = force_string(t1);
  442.         t2 = force_string(t2);
  443.         r  = (NODE *) obstack_alloc(&temp_strings, sizeof(NODE));
  444.         r->type = NODE_TEMP_STRING;
  445.         r->stlen = t1->stlen + t2->stlen;
  446.         r->stref = 1;
  447.         r->stptr = (char *) obstack_alloc(&temp_strings, r->stlen + 1);
  448.         memcpy(r->stptr, t1->stptr, t1->stlen);
  449.         memcpy(r->stptr + t1->stlen, t2->stptr, t2->stlen);
  450.         r->stptr[r->stlen] = EOS;
  451.         return(r);
  452.  
  453.     case NODE_TIMES:
  454.         return(tmp_number(force_number(t1) * force_number(t2)));
  455.  
  456.     case NODE_EXPONENTIAL:
  457.         return(tmp_number(pow(force_number(t1), force_number(t2))));
  458.  
  459.     case NODE_QUOTIENT:
  460.         x = force_number(t2);
  461.         if (x == (AWKNUM) 0)
  462.         return(tmp_number((AWKNUM) 0.0));
  463.         else
  464.         return(tmp_number(force_number(t1) / x));
  465.  
  466.     case NODE_MOD:
  467.         x = force_number(t2);
  468.         if (x == (AWKNUM) 0)
  469.         return(tmp_number((AWKNUM) 0.0));
  470.         return(tmp_number((AWKNUM)    /* uggh... */
  471.                   (((int) force_number(t1)) % ((int) x))));
  472.  
  473.     case NODE_PLUS:
  474.         return(tmp_number(force_number(t1) + force_number(t2)));
  475.  
  476.     case NODE_MINUS:
  477.         return(tmp_number(force_number(t1) - force_number(t2)));
  478.  
  479. #ifndef FAST
  480.     default:
  481.         panic("internal error: illegal numeric operation - tree_eval()");
  482. #endif
  483.     }
  484.     return(0);
  485. }
  486.  
  487.  
  488. /* This returns a POINTER to a node pointer.  *get_lhs(ptr) is the current  */
  489. /* value of the var, or where to store the var's new value.                 */
  490.  
  491. NODE ** PASCAL get_lhs(NODE *ptr)
  492. {
  493.     register NODE     **aptr;
  494.     register int    num;
  495.  
  496. #ifndef FAST
  497.     if (ptr == NULL)
  498.     panic("NULL pointer passed to get_lhs()");
  499. #endif
  500.     deref = NULL;
  501.     switch (ptr->type)
  502.     {
  503.     case NODE_VAR:
  504.         deref = ptr->var_value;
  505.         return(&ptr->var_value);
  506.  
  507.     case NODE_FIELD_SPEC:
  508.         num = (int) force_number(tree_eval(ptr->lnode));
  509.         if (num < 0)
  510.         num = 0;    /* JF what should I do? */
  511.         if (num > f_arr_siz)
  512.         set_field(num, f_empty, 0);    /* jfw: so blank_strings can
  513.                          * be simpler */
  514.         deref = NULL;
  515.         return(&fields_arr[num]);
  516.  
  517.     case NODE_SUBSCRIPT:
  518.         aptr  = assoc_lookup(ptr->lnode, ptr->rnode, ASSOC_CREATE);
  519.         deref = *aptr;
  520.         return(aptr);
  521.     }
  522. #ifndef FAST
  523.     panic("Bad node type (%d) in get_lhs()", ptr->type);
  524. #endif
  525.     return(NULL);
  526. }
  527.  
  528.  
  529. VOID PASCAL do_deref(void)
  530. {
  531.     if (deref)
  532.     {
  533.     switch (deref->type)
  534.     {
  535.         case NODE_STRING:
  536.         if (deref != Nnull_string)
  537.             FREE_ONE_REFERENCE(deref);
  538.         break;
  539.         case NODE_NUMBER:
  540.         free((char *) deref);
  541.         break;
  542. #ifndef FAST
  543.         default:
  544.         panic("Bad node type (%d) in do_deref()", deref->type);
  545. #endif
  546.     }
  547.     deref = 0;
  548.     }
  549. }
  550.  
  551.  
  552. /* This makes numeric operations slightly more efficient.
  553.    Just change the value of a numeric node, if possible */
  554.  
  555. VOID PASCAL assign_number(NODE **ptr, AWKNUM value)
  556. {
  557.     switch ((*ptr)->type)
  558.     {
  559.     case NODE_STRING:
  560.         if (*ptr != Nnull_string)
  561.         FREE_ONE_REFERENCE(*ptr);
  562.     case NODE_TEMP_STRING:          /* jfw: dont crash if we say $2 += 4 */
  563.         *ptr = make_number(value);
  564.         return;
  565.     case NODE_NUMBER:
  566.         (*ptr)->numbr = value;
  567.         deref = 0;
  568.         break;
  569. #ifndef FAST
  570.     default:
  571.         panic("Bad node type (%d) in assign_number()", (*ptr)->type);
  572. #endif
  573.     }
  574. }
  575.  
  576.  
  577.  
  578. /* Routines to deal with fields */
  579. #define ORIG_F                30
  580.  
  581.  
  582. VOID PASCAL init_fields(void)
  583. {
  584.     register NODE     **tmp;
  585.     register NODE      *xtmp;
  586.  
  587.     f_arr_siz = ORIG_F;
  588.     fields_arr = (NODE **) malloc(ORIG_F * sizeof(NODE *));
  589.     fields_nodes = (NODE *) malloc(ORIG_F * sizeof(NODE));
  590.     tmp = &fields_arr[f_arr_siz];
  591.     xtmp = &fields_nodes[f_arr_siz];
  592.     while (--tmp >= &fields_arr[0])
  593.     {
  594.     --xtmp;
  595.     *tmp = xtmp;
  596.     xtmp->type = NODE_TEMP_STRING;
  597.     xtmp->stlen = 0;
  598.     xtmp->stref = 1;
  599.     xtmp->stptr = f_empty;
  600.     }
  601.     return;
  602. }
  603.  
  604.  
  605. VOID PASCAL blank_fields(void)
  606. {
  607.     register NODE     **tmp;
  608.  
  609.     tmp = &fields_arr[f_arr_siz];
  610.     while (--tmp >= &fields_arr[0])
  611.     {
  612.     switch ((*tmp)->type)
  613.     {
  614.         case NODE_NUMBER:
  615.         free((char *) *tmp);
  616.         *tmp = &fields_nodes[tmp - fields_arr];
  617.         break;
  618.         case NODE_STRING:
  619.         if (*tmp != Nnull_string)
  620.             FREE_ONE_REFERENCE(*tmp);
  621.         *tmp = &fields_nodes[tmp - fields_arr];
  622.         break;
  623.         case NODE_TEMP_STRING:
  624.         break;
  625. #ifndef FAST
  626.         default:
  627.         panic("Invalid node type (%d) in blank_fields()",
  628.               tmp[0]->type);
  629. #endif
  630.     }
  631.     if ((*tmp)->stptr != f_empty)
  632.     {            /* jfw */
  633.         /* Then it was assigned a string with set_field */
  634.         /* out of a private buffer to inrec, so don't free it */
  635.         (*tmp)->stptr = f_empty;
  636.         (*tmp)->stlen = 0;
  637.         (*tmp)->stref = 1;
  638.     }
  639.     }
  640.     return;
  641. }
  642.  
  643.  
  644. /* Danger!  Must only be called for fields we know have just been blanked,
  645.    or fields we know don't exist yet.  */
  646.  
  647. VOID PASCAL set_field(int n, char *str, int len)
  648. {
  649.     if (n > f_arr_siz)
  650.     {
  651.     int             t;
  652.  
  653.     fields_arr = (NODE **) realloc((char *) fields_arr,
  654.                        (n + 1) * sizeof(NODE *));
  655.     fields_nodes = (NODE *) realloc((char *) fields_nodes,
  656.                     (n + 1) * sizeof(NODE));
  657.     if (NULL == fields_arr || NULL == fields_nodes)
  658.         panic("Out of memory in set_field()");
  659.     for (t = f_arr_siz; t <= n; t++)
  660.     {
  661.         fields_arr[t] = &fields_nodes[t];
  662.         fields_nodes[t].type = NODE_TEMP_STRING;
  663.         fields_nodes[t].stlen = 0;
  664.         fields_nodes[t].stref = 1;
  665.         fields_nodes[t].stptr = f_empty;
  666.     }
  667.     f_arr_siz = n + 1;
  668.     }
  669.     fields_nodes[n].stlen = len;
  670.     if (n == 0)
  671.     {
  672.     fields_nodes[n].stptr = (char *) obstack_alloc(&other_stack, len + 1);
  673.     memcpy(fields_nodes[n].stptr, str, len);
  674.     fields_nodes[n].stptr[len] = EOS;
  675.     }
  676.     else
  677.     {
  678.     fields_nodes[n].stptr = str;
  679.     str[len] = EOS;
  680.     }
  681.     return;
  682. }
  683.  
  684.  
  685. /* Nodes created with this will go away when the next input line is read */
  686.  
  687. NODE * PASCAL field_string(char *s, int len)
  688. {
  689.     register NODE  *r;
  690.  
  691.     r = (NODE *) obstack_alloc(&other_stack, sizeof(NODE));
  692.     r->type = NODE_TEMP_STRING;
  693.     r->stref = 1;
  694.     r->stlen = len;
  695.     r->stptr = (char *) obstack_alloc(&other_stack, len + 1);
  696.     memcpy(r->stptr, s, len);
  697.     r->stptr[len] = EOS;
  698.  
  699.     return(r);
  700. }
  701.  
  702.  
  703. /* Someone assigned a value to $(something).  Fix up $0 to be right */
  704.  
  705. VOID PASCAL fix_fields(void)
  706. {
  707.     register int    tlen;
  708.     register NODE  *tmp;
  709.     NODE           *ofs;
  710.     char           *ops;
  711.     register char  *cops;
  712.     register NODE **ptr, **maxp;
  713.  
  714.     maxp = NULL;
  715.     tlen = 0;
  716.     ofs = force_string(*get_lhs(OFS_node));
  717.     ptr = &fields_arr[f_arr_siz];
  718.     while (--ptr > &fields_arr[0])
  719.     {
  720.     tmp = force_string(*ptr);
  721.     tlen += tmp->stlen;
  722.     if (tmp->stlen && !maxp)
  723.         maxp = ptr;
  724.     }
  725.     if (!maxp)
  726.     {
  727.     if (fields_arr[0] != fields_nodes)
  728.         FREE_ONE_REFERENCE(fields_arr[0]);
  729.     fields_arr[0] = Nnull_string;
  730.     return;
  731.     }
  732.  
  733.     tlen += ((maxp - fields_arr) - 1) * ofs->stlen;
  734.     ops = (char *) malloc(tlen + 1);
  735.     cops = ops;
  736.     for (ptr = &fields_arr[1]; ptr <= maxp; ptr++)
  737.     {
  738.     tmp = force_string(*ptr);
  739.     memcpy(cops, tmp->stptr, tmp->stlen);
  740.     cops += tmp->stlen;
  741.     if (ptr != maxp)
  742.     {
  743.         memcpy(cops, ofs->stptr, ofs->stlen);
  744.         cops += ofs->stlen;
  745.     }
  746.     }
  747.     tmp = newnode(NODE_STRING);
  748.     tmp->stptr = ops;
  749.     tmp->stlen = tlen;
  750.     tmp->stref = 1;
  751.     tmp->stptr[tlen] = EOS;
  752.  
  753.     /* don't free unless it's new */
  754.     if (fields_arr[0] != fields_nodes)
  755.     FREE_ONE_REFERENCE(fields_arr[0]);
  756.     fields_arr[0] = tmp;
  757.     return;
  758. }
  759.  
  760.  
  761.  
  762. /* Is TREE true or false?  Returns 0==false, non-zero==true */
  763.  
  764. int PASCAL eval_condition(NODE *tree)
  765. {
  766.     register int           di;
  767.     register NODE          *t1, *t2;
  768.     auto     NODE         **tmp;
  769.     auto     char          *err;
  770.  
  771.     if (tree == NULL)        /* Null trees are the easiest kinds */
  772.     return(1);
  773.     switch (tree->type)
  774.     {
  775.         /* Maybe it's easy; check and see. */
  776.         /* BEGIN and END are always false */
  777.     case NODE_K_BEGIN:
  778.         return(0);
  779.  
  780.     case NODE_K_END:
  781.         return(0);
  782.  
  783.     case NODE_MEMBER_COND:
  784.         tmp = assoc_lookup(tree->lnode, tree->rnode, ASSOC_TEST);
  785.         if (NULL == tmp)
  786.         return(FALSE);
  787.         return(TRUE);
  788.  
  789.     case NODE_AND:
  790.         return(eval_condition(tree->lnode)
  791.                && eval_condition(tree->rnode));
  792.  
  793.     case NODE_OR:
  794.         return(eval_condition(tree->lnode)
  795.                || eval_condition(tree->rnode));
  796.  
  797.     case NODE_NOT:
  798.         return(!eval_condition(tree->lnode));
  799.  
  800.         /* Node_line_range is kind of like Node_match, EXCEPT: the lnode
  801.          * field (more properly, the condpair field) is a node of a
  802.          * Node_cond_pair; whether we evaluate the lnode of that node or
  803.          * the rnode depends on the triggered word.  More precisely:  if
  804.          * we are not yet triggered, we tree_eval the lnode; if that
  805.          * returns true, we set the triggered word.  If we are triggered
  806.          * (not ELSE IF, note), we tree_eval the rnode, clear triggered
  807.          * if it succeeds, and perform our action (regardless of success
  808.          * or failure).  We want to be able to begin and end on a single
  809.          * input record, so this isn't an ELSE IF, as noted above. This
  810.          * feature was implemented by John Woods, jfw@eddie.mit.edu,
  811.          * during a rainy weekend. */
  812.     case NODE_LINE_RANGE:
  813.         if (!tree->triggered)
  814.         if (!eval_condition(tree->condpair->lnode))
  815.             return(0);
  816.         else
  817.             tree->triggered = 1;
  818.         /* Else we are triggered */
  819.         if (eval_condition(tree->condpair->rnode))
  820.         tree->triggered = 0;
  821.         return(1);
  822.     }
  823.  
  824.     /* Could just be J.random expression. in which case, null and 0 are
  825.      * false, anything else is true */
  826.  
  827.     switch (tree->type)
  828.     {
  829.     case NODE_REGEXP:
  830.     case NODE_MATCH:
  831.     case NODE_NOMATCH:
  832.     case NODE_EQUAL:
  833.     case NODE_NOTEQUAL:
  834.     case NODE_LESS:
  835.     case NODE_GREATER:
  836.     case NODE_LEQ:
  837.     case NODE_GEQ:
  838.         break;
  839.  
  840.     default:        /* This is so 'if(iggy)', etc, will work */
  841.         /* Non-zero and non-empty are true */
  842.         t1 = tree_eval(tree);
  843.         switch (t1->type)
  844.         {
  845.         case NODE_NUMBER:
  846.             return(t1->numbr != 0.0);
  847.         case NODE_STRING:
  848.         case NODE_TEMP_STRING:
  849.             return(t1->stlen != 0);
  850. #ifndef FAST
  851.         default:
  852.             panic("Bad node type (%d) in eval_condition()", t1->type);
  853. #endif
  854.         }
  855.     }
  856.     /* couldn't fob it off recursively, eval left subtree and see if it's a
  857.      * pattern match operation */
  858.  
  859.     if (NODE_REGEXP == tree->type)
  860.     {
  861.     return(re_search(tree->rereg, WHOLELINE->stptr, WHOLELINE->stlen,
  862.              0, WHOLELINE->stlen, NULL) != -1);
  863.     }
  864.  
  865.     t1 = tree_eval(tree->lnode);
  866.  
  867.     if (tree->type == NODE_MATCH || tree->type == NODE_NOMATCH)
  868.     {
  869.     t1 = force_string(t1);
  870.     if (NODE_REGEXP == tree->rnode->type)
  871.     {
  872.         return(re_search(tree->rnode->rereg, t1->stptr,
  873.                   t1->stlen, 0, t1->stlen,
  874.                   NULL) == -1)
  875.             ^ (tree->type == NODE_MATCH);
  876.     }
  877.     t2 = tree_eval(tree->rnode);
  878.     t2 = force_string(t2);
  879.     clear_wrk_repat();
  880.     err = re_compile_pattern(t2->stptr, t2->stlen, &wrk_repat);
  881.     if (err)
  882.         panic("Illegal REGEXP(%s) in condition: %s", t2->stptr, err);
  883.     di = re_search(&wrk_repat, t1->stptr, t1->stlen, 0, t1->stlen, NULL);
  884.     return((-1 == di) ^ (NODE_MATCH == tree->type));
  885.     }
  886.  
  887.     /* still no luck--- eval the right subtree and try binary ops */
  888.  
  889.     t2 = tree_eval(tree->rnode);
  890.  
  891.     di = cmp_nodes(t1, t2);
  892.  
  893.     switch (tree->type)
  894.     {
  895.     case NODE_EQUAL:
  896.         return(di == 0);
  897.     case NODE_NOTEQUAL:
  898.         return(di != 0);
  899.     case NODE_LESS:
  900.         return(di < 0);
  901.     case NODE_GREATER:
  902.         return(di > 0);
  903.     case NODE_LEQ:
  904.         return(di <= 0);
  905.     case NODE_GEQ:
  906.         return(di >= 0);
  907. #ifndef FAST
  908.     default:
  909.         panic("unknown conditonal node (%d) in eval_condition()",
  910.           tree->type);
  911. #endif
  912.     }
  913.     return(0);
  914. }
  915.  
  916.  
  917. /* FOO this doesn't properly compare "12.0" and 12.0 etc */
  918. /* or "1E1" and 10 etc */
  919. /* Perhaps someone should fix it.  */
  920. /* Consider it fixed (jfw) */
  921.  
  922. /* strtod() would have been better, except (1) real awk is needlessly
  923.  * restrictive in what strings it will consider to be numbers, and
  924.  * (2) I couldn't find the public domain version anywhere handy.
  925.  *
  926.  * does the string str have pure-numeric syntax?  don't convert it,
  927.  * assume that atof is better.
  928.  */
  929.  
  930. int PASCAL is_a_number(char *str)
  931. {
  932.     if (*str == 0)
  933.     return(1);         /* null string has numeric value of 0 */
  934.     /* This is still a bug: in real awk, an explicit "" string is not treated
  935.      * as a number.  Perhaps it is only variables that, when empty, are also
  936.      * 0s.  This bug-lette here at least lets uninitialized variables to
  937.      * compare equal to zero like they should. */
  938.     if (*str == '-')
  939.     str++;
  940.     if (*str == 0)
  941.     return(0);
  942.     /* must be either . or digits (.4 is legal) */
  943.     if (*str != '.' && !isdigit(*str))
  944.     return(0);
  945.     while (isdigit(*str))
  946.     str++;
  947.     if (*str == '.')
  948.     {
  949.     str++;
  950.     while (isdigit(*str))
  951.         str++;
  952.     }
  953.     /* curiously, real awk DOESN'T consider "1E1" to be equal to 10! Or even
  954.      * equal to 1E1 for that matter!  For a laugh, try: awk 'BEGIN {if ("1E1"
  955.      * == 1E1) print "eq"; else print "neq";exit}' Since this behavior is
  956.      * QUITE curious, I include the code for the adventurous.  One might also
  957.      * feel like skipping leading whitespace (awk doesn't) and allowing a
  958.      * leading + (awk doesn't). #ifdef Allow_Exponents if (*str == 'e' ||
  959.      * *str == 'E') { str++; if (*str == '+' || *str == '-') str++; if
  960.      * (!isdigit(*str)) return 0; while (isdigit(*str)) str++; } #endif /* if
  961.      * we have digested the whole string, we are successful */
  962.     return(*str == 0);
  963. }
  964.  
  965.  
  966. int PASCAL cmp_nodes(NODE *t1, NODE *t2)
  967. {
  968.     register int    di;
  969.     register AWKNUM d;
  970.  
  971.  
  972.     if (t1 == t2)
  973.     {
  974.     return(0);
  975.     }
  976.  
  977. #ifndef FAST
  978.     if (!t1 || !t2)
  979.     panic("NULL pointer passed to cmp_nodes()");
  980. #endif
  981.  
  982.     if (t1->type == NODE_NUMBER && t2->type == NODE_NUMBER)
  983.     {
  984.     d = t1->numbr - t2->numbr;
  985.     if (d < 0.0)
  986.         return(-1);
  987.     if (d > 0.0)
  988.         return(1);
  989.     return(0);
  990.     }
  991.     t1 = force_string(t1);
  992.     t2 = force_string(t2);
  993.  
  994.     /* "real" awk treats things as numbers if they both "look" like numbers. */
  995.     if (*t1->stptr && *t2->stptr && is_a_number(t1->stptr)
  996.                  && is_a_number(t2->stptr))
  997.     {
  998.     d = atof(t1->stptr) - atof(t2->stptr);
  999.     if (d < 0.0)
  1000.         return(-1);
  1001.     if (d > 0.0)
  1002.         return(1);
  1003.     return(0);
  1004.     }
  1005.  
  1006.     di = strncmp(t1->stptr, t2->stptr, min(t1->stlen, t2->stlen));
  1007.     if (di == 0)
  1008.     di = t1->stlen - t2->stlen;
  1009.     if (di > 0)
  1010.     return(1);
  1011.     if (di < 0)
  1012.     return(-1);
  1013.     return(0);
  1014. }
  1015.  
  1016.  
  1017. /* routines for associative arrays.  SYMBOL is the address of the node
  1018.    (or other pointer) being dereferenced.  SUBS is a number or string
  1019.    used as the subscript. */
  1020.  
  1021.  
  1022. /* Flush all the values in symbol[] before doing a split() */
  1023.  
  1024. VOID PASCAL assoc_clear(NODE *symbol)
  1025. {
  1026.     register int     i;
  1027.     auto     AHASH    *bucket, *next;
  1028.  
  1029.     if (symbol->var_array == NULL)
  1030.     return;
  1031.     for (i = 0; i < ASSOC_HASHSIZE; ++i)
  1032.     {
  1033.     for (bucket = symbol->var_array[i]; bucket; bucket = next)
  1034.     {
  1035.         next = bucket->next;
  1036.         deref = bucket->name;
  1037.         do_deref();
  1038.         deref = bucket->value;
  1039.         do_deref();
  1040.         free((void *) bucket);
  1041.     }
  1042.     symbol->var_array[i] = NULL;
  1043.     }
  1044.     return;
  1045. }
  1046.  
  1047.  
  1048. /* Find SYMBOL[SUBS] in the assoc array.  Install it with value "" if it    */
  1049. /* isn't there.  Returns a pointer ala get_lhs to where its value is stored */
  1050.  
  1051. NODE ** PASCAL assoc_lookup(NODE *symbol, NODE *subs, int operation)
  1052. {
  1053.     register int       hash1 = 0, i;
  1054.     auto     AHASH      *bucket, *prev_bucket;
  1055.     auto     NODE      *tmp, *tmp1;
  1056.     auto     NODE      *subsep;
  1057.     auto     char       wrk[MAX_SUBSCRIPT_LEN], *pwrk;
  1058.  
  1059.     switch (subs->type)
  1060.     {
  1061.     case NODE_NUMBER:
  1062.         i     = (int) subs->numbr;
  1063.         subs = tmp_string(wrk, sprintf(wrk, "%d", i));
  1064.         break;
  1065.  
  1066.     case NODE_EXPRESSION_LIST:
  1067.         subsep = force_string(SUBSEP_node->var_value);
  1068.         pwrk   = wrk;
  1069.         tmp    = subs;
  1070.         while (tmp)
  1071.         {
  1072.         tmp1    = tree_eval(tmp->lnode);
  1073.         if (NULL == tmp1)
  1074.             panic("Invalid subscript expression in assoc_lookup()");
  1075.         tmp1    = force_string(tmp1);
  1076.         memcpy(pwrk, tmp1->stptr, tmp1->stlen);
  1077.         pwrk   += tmp1->stlen;
  1078.         if (subsep->stlen > 0)
  1079.         {
  1080.             memcpy(pwrk, subsep->stptr, subsep->stlen);
  1081.             pwrk += subsep->stlen;
  1082.         }
  1083.         tmp    = tmp->rnode;
  1084.         }
  1085.         if (pwrk == wrk)
  1086.         *pwrk = EOS;
  1087.         else
  1088.         *(pwrk - subsep->stlen) = EOS;
  1089.         subs  = tmp_string(wrk, strlen(wrk));
  1090.                        /* intentional fall thru - BW */
  1091.     default:
  1092.         subs = force_string(subs);
  1093.         break;
  1094.     }
  1095.     for (i = 0; i < subs->stlen; i++)
  1096.     hash1 = HASHSTEP(hash1, subs->stptr[i]);
  1097.  
  1098.     hash1 = STIR_BITS(hash1);
  1099.     hash1 = MAKE_POS(hash1) % ASSOC_HASHSIZE;
  1100.  
  1101.     /* this table really should grow dynamically */
  1102.     if (symbol->var_array == NULL)
  1103.     {
  1104.     if (ASSOC_TEST == operation || ASSOC_DELETE == operation)
  1105.         return(NULL);
  1106.     symbol->var_array = (AHASH **) malloc(sizeof(AHASH *) * ASSOC_HASHSIZE);
  1107.     for (i = 0; i < ASSOC_HASHSIZE; i++)
  1108.         symbol->var_array[i] = NULL;
  1109.     }
  1110.     else
  1111.     {
  1112.     bucket        = symbol->var_array[hash1];
  1113.     prev_bucket = NULL;
  1114.     while (bucket)
  1115.     {
  1116.         if (0 == cmp_nodes(bucket->name, subs))
  1117.         {
  1118.         if (ASSOC_DELETE == operation)
  1119.         {
  1120.             if (prev_bucket)
  1121.             prev_bucket->next = bucket->next;
  1122.             else
  1123.             symbol->var_array[hash1] = NULL;
  1124.             deref = bucket->name;
  1125.             do_deref();
  1126.             deref = bucket->value;
  1127.             do_deref();
  1128.             free(bucket);
  1129.             return(NULL);
  1130.         }
  1131.         return(&(bucket->value));
  1132.         }
  1133.         prev_bucket = bucket;
  1134.         bucket    = bucket->next;
  1135.     }
  1136. #if 0
  1137.     for (bucket = symbol->var_array[hash1]; bucket; bucket = bucket->next)
  1138.     {
  1139.         if (0 == cmp_nodes(bucket->name, subs))
  1140.         return(&(bucket->value));
  1141.     }
  1142. #endif
  1143.     }
  1144.     if (ASSOC_TEST == operation)
  1145.     return(NULL);
  1146.     bucket = (AHASH *) malloc(sizeof(AHASH));
  1147.     if (NULL == bucket)
  1148.     panic("Out of memory in function assoc_lookup()");
  1149.     bucket->symbol = symbol;
  1150.     bucket->name   = dupnode(subs);
  1151.     bucket->value  = Nnull_string;
  1152.     bucket->next   = symbol->var_array[hash1];
  1153.     symbol->var_array[hash1] = bucket;
  1154.     return(&(bucket->value));
  1155. }
  1156.  
  1157.  
  1158. STATIC struct search * NEAR PASCAL assoc_scan(NODE *symbol)
  1159. {
  1160.     auto     struct search    *lookat;
  1161.  
  1162.     if (!symbol->var_array)
  1163.     return(NULL);
  1164.     lookat = (struct search *) obstack_alloc(&other_stack,
  1165.                          sizeof(struct search));
  1166.     /* lookat->symbol = symbol; */
  1167.     lookat->numleft = ASSOC_HASHSIZE;
  1168.     lookat->arr_ptr = symbol->var_array;
  1169.     lookat->bucket  = symbol->var_array[0];
  1170.     return(assoc_next(lookat));
  1171. }
  1172.  
  1173.  
  1174. STATIC struct search * NEAR PASCAL assoc_next(struct search *lookat)
  1175. {
  1176.     for (; lookat->numleft; lookat->numleft--)
  1177.     {
  1178.     while (lookat->bucket != 0)
  1179.     {
  1180.         lookat->retval = lookat->bucket->name;
  1181.         lookat->bucket = lookat->bucket->next;
  1182.         return(lookat);
  1183.     }
  1184.     lookat->bucket = *++(lookat->arr_ptr);
  1185.     }
  1186.     return(NULL);
  1187. }
  1188.  
  1189.  
  1190. AWKNUM PASCAL force_number(NODE *n)
  1191. {
  1192.     if (n)
  1193.     {
  1194.     switch (n->type)
  1195.     {
  1196.         case NODE_NUMBER:
  1197.         return(n->numbr);
  1198.         case NODE_STRING:
  1199.         case NODE_TEMP_STRING:
  1200.         return(atof(n->stptr));
  1201.     }
  1202.     }
  1203.     panic("Bad node type (%d) in force_number()", n->type);
  1204. }
  1205.  
  1206.  
  1207. NODE * PASCAL force_string(NODE *s)
  1208. {
  1209.     auto     int       num;
  1210.  
  1211.     if (s)
  1212.     {
  1213.     switch (s->type)
  1214.     {
  1215.         case NODE_STRING:
  1216.         case NODE_TEMP_STRING:
  1217.         return(s);
  1218.         case NODE_NUMBER:
  1219.         if ((*get_lhs(OFMT_node))->type != NODE_STRING)
  1220.             panic("Insane value for OFMT in force_string()");
  1221.         dumb[1].lnode = s;
  1222.         return(do_sprintf(&dumb[0]));
  1223.         case NODE_FIELD_SPEC:
  1224.         num = (int) force_number(tree_eval(s->lnode));
  1225.         if (num > f_arr_siz)
  1226.             set_field(num, f_empty, 0);
  1227.         return(force_string(fields_arr[num]));
  1228.     }
  1229.     }
  1230.     panic("Bad node type (%d) in force_string()", s->type);
  1231. }
  1232.