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