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