home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 6 / FreshFish_September1994.bin / bbs / gnu / gawk-2.15.5-src.lha / GNU / src / amiga / gawk-2.15.5 / eval.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-11  |  30.8 KB  |  1,261 lines
  1. /*
  2.  * eval.c - gawk parse tree interpreter 
  3.  */
  4.  
  5. /* 
  6.  * Copyright (C) 1986, 1988, 1989, 1991, 1992, 1993 the Free Software Foundation, Inc.
  7.  * 
  8.  * This file is part of GAWK, the GNU implementation of the
  9.  * AWK Progamming Language.
  10.  * 
  11.  * GAWK is free software; you can redistribute it and/or modify
  12.  * it under the terms of the GNU General Public License as published by
  13.  * the Free Software Foundation; either version 2 of the License, or
  14.  * (at your option) any later version.
  15.  * 
  16.  * GAWK is distributed in the hope that it will be useful,
  17.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  18.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19.  * GNU General Public License for more details.
  20.  * 
  21.  * You should have received a copy of the GNU General Public License
  22.  * along with GAWK; see the file COPYING.  If not, write to
  23.  * the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  24.  */
  25.  
  26. #include "awk.h"
  27.  
  28. extern double pow P((double x, double y));
  29. extern double modf P((double x, double *yp));
  30. extern double fmod P((double x, double y));
  31.  
  32. static int eval_condition P((NODE *tree));
  33. static NODE *op_assign P((NODE *tree));
  34. static NODE *func_call P((NODE *name, NODE *arg_list));
  35. static NODE *match_op P((NODE *tree));
  36.  
  37. NODE *_t;        /* used as a temporary in macros */
  38. #ifdef MSDOS
  39. double _msc51bug;    /* to get around a bug in MSC 5.1 */
  40. #endif
  41. NODE *ret_node;
  42. int OFSlen;
  43. int ORSlen;
  44. int OFMTidx;
  45. int CONVFMTidx;
  46.  
  47. /* Macros and variables to save and restore function and loop bindings */
  48. /*
  49.  * the val variable allows return/continue/break-out-of-context to be
  50.  * caught and diagnosed
  51.  */
  52. #define PUSH_BINDING(stack, x, val) (memcpy ((char *)(stack), (char *)(x), sizeof (jmp_buf)), val++)
  53. #define RESTORE_BINDING(stack, x, val) (memcpy ((char *)(x), (char *)(stack), sizeof (jmp_buf)), val--)
  54.  
  55. static jmp_buf loop_tag;    /* always the current binding */
  56. static int loop_tag_valid = 0;    /* nonzero when loop_tag valid */
  57. static int func_tag_valid = 0;
  58. static jmp_buf func_tag;
  59. extern int exiting, exit_val;
  60.  
  61. /*
  62.  * This table is used by the regexp routines to do case independant
  63.  * matching. Basically, every ascii character maps to itself, except
  64.  * uppercase letters map to lower case ones. This table has 256
  65.  * entries, which may be overkill. Note also that if the system this
  66.  * is compiled on doesn't use 7-bit ascii, casetable[] should not be
  67.  * defined to the linker, so gawk should not load.
  68.  *
  69.  * Do NOT make this array static, it is used in several spots, not
  70.  * just in this file.
  71.  */
  72. #if 'a' == 97    /* it's ascii */
  73. char casetable[] = {
  74.     '\000', '\001', '\002', '\003', '\004', '\005', '\006', '\007',
  75.     '\010', '\011', '\012', '\013', '\014', '\015', '\016', '\017',
  76.     '\020', '\021', '\022', '\023', '\024', '\025', '\026', '\027',
  77.     '\030', '\031', '\032', '\033', '\034', '\035', '\036', '\037',
  78.     /* ' '     '!'     '"'     '#'     '$'     '%'     '&'     ''' */
  79.     '\040', '\041', '\042', '\043', '\044', '\045', '\046', '\047',
  80.     /* '('     ')'     '*'     '+'     ','     '-'     '.'     '/' */
  81.     '\050', '\051', '\052', '\053', '\054', '\055', '\056', '\057',
  82.     /* '0'     '1'     '2'     '3'     '4'     '5'     '6'     '7' */
  83.     '\060', '\061', '\062', '\063', '\064', '\065', '\066', '\067',
  84.     /* '8'     '9'     ':'     ';'     '<'     '='     '>'     '?' */
  85.     '\070', '\071', '\072', '\073', '\074', '\075', '\076', '\077',
  86.     /* '@'     'A'     'B'     'C'     'D'     'E'     'F'     'G' */
  87.     '\100', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
  88.     /* 'H'     'I'     'J'     'K'     'L'     'M'     'N'     'O' */
  89.     '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
  90.     /* 'P'     'Q'     'R'     'S'     'T'     'U'     'V'     'W' */
  91.     '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
  92.     /* 'X'     'Y'     'Z'     '['     '\'     ']'     '^'     '_' */
  93.     '\170', '\171', '\172', '\133', '\134', '\135', '\136', '\137',
  94.     /* '`'     'a'     'b'     'c'     'd'     'e'     'f'     'g' */
  95.     '\140', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
  96.     /* 'h'     'i'     'j'     'k'     'l'     'm'     'n'     'o' */
  97.     '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
  98.     /* 'p'     'q'     'r'     's'     't'     'u'     'v'     'w' */
  99.     '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
  100.     /* 'x'     'y'     'z'     '{'     '|'     '}'     '~' */
  101.     '\170', '\171', '\172', '\173', '\174', '\175', '\176', '\177',
  102.     '\200', '\201', '\202', '\203', '\204', '\205', '\206', '\207',
  103.     '\210', '\211', '\212', '\213', '\214', '\215', '\216', '\217',
  104.     '\220', '\221', '\222', '\223', '\224', '\225', '\226', '\227',
  105.     '\230', '\231', '\232', '\233', '\234', '\235', '\236', '\237',
  106.     '\240', '\241', '\242', '\243', '\244', '\245', '\246', '\247',
  107.     '\250', '\251', '\252', '\253', '\254', '\255', '\256', '\257',
  108.     '\260', '\261', '\262', '\263', '\264', '\265', '\266', '\267',
  109.     '\270', '\271', '\272', '\273', '\274', '\275', '\276', '\277',
  110.     '\300', '\301', '\302', '\303', '\304', '\305', '\306', '\307',
  111.     '\310', '\311', '\312', '\313', '\314', '\315', '\316', '\317',
  112.     '\320', '\321', '\322', '\323', '\324', '\325', '\326', '\327',
  113.     '\330', '\331', '\332', '\333', '\334', '\335', '\336', '\337',
  114.     '\340', '\341', '\342', '\343', '\344', '\345', '\346', '\347',
  115.     '\350', '\351', '\352', '\353', '\354', '\355', '\356', '\357',
  116.     '\360', '\361', '\362', '\363', '\364', '\365', '\366', '\367',
  117.     '\370', '\371', '\372', '\373', '\374', '\375', '\376', '\377',
  118. };
  119. #else
  120. #include "You lose. You will need a translation table for your character set."
  121. #endif
  122.  
  123. /*
  124.  * Tree is a bunch of rules to run. Returns zero if it hit an exit()
  125.  * statement 
  126.  */
  127. int
  128. interpret(tree)
  129. register NODE *volatile tree;
  130. {
  131.     jmp_buf volatile loop_tag_stack; /* shallow binding stack for loop_tag */
  132.     static jmp_buf rule_tag; /* tag the rule currently being run, for NEXT
  133.                   * and EXIT statements.  It is static because
  134.                   * there are no nested rules */
  135.     register NODE *volatile t = NULL;    /* temporary */
  136.     NODE **volatile lhs;    /* lhs == Left Hand Side for assigns, etc */
  137.     NODE *volatile stable_tree;
  138.     int volatile traverse = 1;    /* True => loop thru tree (Node_rule_list) */
  139.  
  140.     /* avoid false source indications */
  141.     source = NULL;
  142.     sourceline = 0;
  143.  
  144.     if (tree == NULL)
  145.         return 1;
  146.     sourceline = tree->source_line;
  147.     source = tree->source_file;
  148.     switch (tree->type) {
  149.     case Node_rule_node:
  150.         traverse = 0;   /* False => one for-loop iteration only */
  151.         /* FALL THROUGH */
  152.     case Node_rule_list:
  153.         for (t = tree; t != NULL; t = t->rnode) {
  154.             if (traverse)
  155.                 tree = t->lnode;
  156.             sourceline = tree->source_line;
  157.             source = tree->source_file;
  158.             switch (setjmp(rule_tag)) {
  159.             case 0:    /* normal non-jump */
  160.                 /* test pattern, if any */
  161.                 if (tree->lnode == NULL ||
  162.                     eval_condition(tree->lnode))
  163.                     (void) interpret(tree->rnode);
  164.                 break;
  165.             case TAG_CONTINUE:    /* NEXT statement */
  166.                 return 1;
  167.             case TAG_BREAK:
  168.                 return 0;
  169.             default:
  170.                 cant_happen();
  171.             }
  172.             if (!traverse)          /* case Node_rule_node */
  173.                 break;          /* don't loop */
  174.         }
  175.         break;
  176.  
  177.     case Node_statement_list:
  178.         for (t = tree; t != NULL; t = t->rnode)
  179.             (void) interpret(t->lnode);
  180.         break;
  181.  
  182.     case Node_K_if:
  183.         if (eval_condition(tree->lnode)) {
  184.             (void) interpret(tree->rnode->lnode);
  185.         } else {
  186.             (void) interpret(tree->rnode->rnode);
  187.         }
  188.         break;
  189.  
  190.     case Node_K_while:
  191.         PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  192.  
  193.         stable_tree = tree;
  194.         while (eval_condition(stable_tree->lnode)) {
  195.             switch (setjmp(loop_tag)) {
  196.             case 0:    /* normal non-jump */
  197.                 (void) interpret(stable_tree->rnode);
  198.                 break;
  199.             case TAG_CONTINUE:    /* continue statement */
  200.                 break;
  201.             case TAG_BREAK:    /* break statement */
  202.                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  203.                 return 1;
  204.             default:
  205.                 cant_happen();
  206.             }
  207.         }
  208.         RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  209.         break;
  210.  
  211.     case Node_K_do:
  212.         PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  213.         stable_tree = tree;
  214.         do {
  215.             switch (setjmp(loop_tag)) {
  216.             case 0:    /* normal non-jump */
  217.                 (void) interpret(stable_tree->rnode);
  218.                 break;
  219.             case TAG_CONTINUE:    /* continue statement */
  220.                 break;
  221.             case TAG_BREAK:    /* break statement */
  222.                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  223.                 return 1;
  224.             default:
  225.                 cant_happen();
  226.             }
  227.         } while (eval_condition(stable_tree->lnode));
  228.         RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  229.         break;
  230.  
  231.     case Node_K_for:
  232.         PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  233.         (void) interpret(tree->forloop->init);
  234.         stable_tree = tree;
  235.         while (eval_condition(stable_tree->forloop->cond)) {
  236.             switch (setjmp(loop_tag)) {
  237.             case 0:    /* normal non-jump */
  238.                 (void) interpret(stable_tree->lnode);
  239.                 /* fall through */
  240.             case TAG_CONTINUE:    /* continue statement */
  241.                 (void) interpret(stable_tree->forloop->incr);
  242.                 break;
  243.             case TAG_BREAK:    /* break statement */
  244.                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  245.                 return 1;
  246.             default:
  247.                 cant_happen();
  248.             }
  249.         }
  250.         RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  251.         break;
  252.  
  253.     case Node_K_arrayfor:
  254.         {
  255.         volatile struct search l;    /* For array_for */
  256.         Func_ptr after_assign = NULL;
  257.  
  258. #define hakvar forloop->init
  259. #define arrvar forloop->incr
  260.         PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  261.         lhs = get_lhs(tree->hakvar, &after_assign);
  262.         t = tree->arrvar;
  263.         if (t->type == Node_param_list)
  264.             t = stack_ptr[t->param_cnt];
  265.         stable_tree = tree;
  266.         for (assoc_scan(t, (struct search *)&l);
  267.              l.retval;
  268.              assoc_next((struct search *)&l)) {
  269.             unref(*((NODE **) lhs));
  270.             *lhs = dupnode(l.retval);
  271.             if (after_assign)
  272.                 (*after_assign)();
  273.             switch (setjmp(loop_tag)) {
  274.             case 0:
  275.                 (void) interpret(stable_tree->lnode);
  276.             case TAG_CONTINUE:
  277.                 break;
  278.  
  279.             case TAG_BREAK:
  280.                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  281.                 return 1;
  282.             default:
  283.                 cant_happen();
  284.             }
  285.         }
  286.         RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  287.         break;
  288.         }
  289.  
  290.     case Node_K_break:
  291.         if (loop_tag_valid == 0)
  292.             fatal("unexpected break");
  293.         longjmp(loop_tag, TAG_BREAK);
  294.         break;
  295.  
  296.     case Node_K_continue:
  297.         if (loop_tag_valid == 0) {
  298.             /*
  299.              * AT&T nawk treats continue outside of loops like
  300.              * next.  Allow it if not posix, and complain if
  301.              * lint.
  302.              */
  303.             static int warned = 0;
  304.  
  305.             if (do_lint && ! warned) {
  306.                 warning("use of `continue' outside of loop is not portable");
  307.                 warned = 1;
  308.             }
  309.             if (do_posix)
  310.                 fatal("use of `continue' outside of loop is not allowed");
  311.             longjmp(rule_tag, TAG_CONTINUE);
  312.         } else
  313.             longjmp(loop_tag, TAG_CONTINUE);
  314.         break;
  315.  
  316.     case Node_K_print:
  317.         do_print(tree);
  318.         break;
  319.  
  320.     case Node_K_printf:
  321.         do_printf(tree);
  322.         break;
  323.  
  324.     case Node_K_delete:
  325.         if (tree->rnode != NULL)
  326.             do_delete(tree->lnode, tree->rnode);
  327.         else
  328.             assoc_clear(tree->lnode);
  329.         break;
  330.  
  331.     case Node_K_next:
  332.         longjmp(rule_tag, TAG_CONTINUE);
  333.         break;
  334.  
  335.     case Node_K_nextfile:
  336.         do_nextfile();
  337.         break;
  338.  
  339.     case Node_K_exit:
  340.         /*
  341.          * In A,K,&W, p. 49, it says that an exit statement "...
  342.          * causes the program to behave as if the end of input had
  343.          * occurred; no more input is read, and the END actions, if
  344.          * any are executed." This implies that the rest of the rules
  345.          * are not done. So we immediately break out of the main loop.
  346.          */
  347.         exiting = 1;
  348.         if (tree) {
  349.             t = tree_eval(tree->lnode);
  350.             exit_val = (int) force_number(t);
  351.         }
  352.         free_temp(t);
  353.         longjmp(rule_tag, TAG_BREAK);
  354.         break;
  355.  
  356.     case Node_K_return:
  357.         t = tree_eval(tree->lnode);
  358.         ret_node = dupnode(t);
  359.         free_temp(t);
  360.         longjmp(func_tag, TAG_RETURN);
  361.         break;
  362.  
  363.     default:
  364.         /*
  365.          * Appears to be an expression statement.  Throw away the
  366.          * value. 
  367.          */
  368.         if (do_lint && tree->type == Node_var)
  369.             warning("statement has no effect");
  370.         t = tree_eval(tree);
  371.         free_temp(t);
  372.         break;
  373.     }
  374.     return 1;
  375. }
  376.  
  377. /* evaluate a subtree */
  378.  
  379. NODE *
  380. r_tree_eval(tree)
  381. register NODE *tree;
  382. {
  383.     register NODE *r, *t1, *t2;    /* return value & temporary subtrees */
  384.     register NODE **lhs;
  385.     register int di;
  386.     AWKNUM x, x1, x2;
  387.     long lx;
  388. #ifdef _CRAY
  389.     long lx2;
  390. #endif
  391.  
  392. #ifdef DEBUG
  393.     if (tree == NULL)
  394.         return Nnull_string;
  395.     if (tree->type == Node_val) {
  396.         if ((char)tree->stref <= 0) cant_happen();
  397.         return tree;
  398.     }
  399.     if (tree->type == Node_var) {
  400.         if ((char)tree->var_value->stref <= 0) cant_happen();
  401.         return tree->var_value;
  402.     }
  403. #endif
  404.  
  405.     if (tree->type == Node_param_list) {
  406.         tree = stack_ptr[tree->param_cnt];
  407.         if (tree == NULL)
  408.             return Nnull_string;
  409.     }
  410.  
  411.     switch (tree->type) {
  412.     case Node_var:
  413.         return tree->var_value;
  414.  
  415.     case Node_and:
  416.         return tmp_number((AWKNUM) (eval_condition(tree->lnode)
  417.                         && eval_condition(tree->rnode)));
  418.  
  419.     case Node_or:
  420.         return tmp_number((AWKNUM) (eval_condition(tree->lnode)
  421.                         || eval_condition(tree->rnode)));
  422.  
  423.     case Node_not:
  424.         return tmp_number((AWKNUM) ! eval_condition(tree->lnode));
  425.  
  426.         /* Builtins */
  427.     case Node_builtin:
  428.         return ((*tree->proc) (tree->subnode));
  429.  
  430.     case Node_K_getline:
  431.         return (do_getline(tree));
  432.  
  433.     case Node_in_array:
  434.         return tmp_number((AWKNUM) in_array(tree->lnode, tree->rnode));
  435.  
  436.     case Node_func_call:
  437.         return func_call(tree->rnode, tree->lnode);
  438.  
  439.         /* unary operations */
  440.     case Node_NR:
  441.     case Node_FNR:
  442.     case Node_NF:
  443.     case Node_FIELDWIDTHS:
  444.     case Node_FS:
  445.     case Node_RS:
  446.     case Node_field_spec:
  447.     case Node_subscript:
  448.     case Node_IGNORECASE:
  449.     case Node_OFS:
  450.     case Node_ORS:
  451.     case Node_OFMT:
  452.     case Node_CONVFMT:
  453.         lhs = get_lhs(tree, (Func_ptr *)0);
  454.         return *lhs;
  455.  
  456.     case Node_var_array:
  457.         fatal("attempt to use array `%s' in a scalar context", tree->vname);
  458.  
  459.     case Node_unary_minus:
  460.         t1 = tree_eval(tree->subnode);
  461.         x = -force_number(t1);
  462.         free_temp(t1);
  463.         return tmp_number(x);
  464.  
  465.     case Node_cond_exp:
  466.         if (eval_condition(tree->lnode))
  467.             return tree_eval(tree->rnode->lnode);
  468.         return tree_eval(tree->rnode->rnode);
  469.  
  470.     case Node_match:
  471.     case Node_nomatch:
  472.     case Node_regex:
  473.         return match_op(tree);
  474.  
  475.     case Node_func:
  476.         fatal("function `%s' called with space between name and (,\n%s",
  477.             tree->lnode->param,
  478.             "or used in other expression context");
  479.  
  480.         /* assignments */
  481.     case Node_assign:
  482.         {
  483.         Func_ptr after_assign = NULL;
  484.  
  485.         r = tree_eval(tree->rnode);
  486.         lhs = get_lhs(tree->lnode, &after_assign);
  487.         if (r != *lhs) {
  488.             NODE *save;
  489.  
  490.             save = *lhs;
  491.             *lhs = dupnode(r);
  492.             unref(save);
  493.         }
  494.         free_temp(r);
  495.         if (after_assign)
  496.             (*after_assign)();
  497.         return *lhs;
  498.         }
  499.  
  500.     case Node_concat:
  501.         {
  502. #define    STACKSIZE    10
  503.         NODE *treelist[STACKSIZE+1];
  504.         NODE *strlist[STACKSIZE+1];
  505.         register NODE **treep;
  506.         register NODE **strp;
  507.         register size_t len;
  508.         char *str;
  509.         register char *dest;
  510.  
  511.         /*
  512.          * This is an efficiency hack for multiple adjacent string
  513.          * concatenations, to avoid recursion and string copies.
  514.          *
  515.          * Node_concat trees grow downward to the left, so
  516.          * descend to lowest (first) node, accumulating nodes
  517.          * to evaluate to strings as we go.
  518.          */
  519.         treep = treelist;
  520.         while (tree->type == Node_concat) {
  521.             *treep++ = tree->rnode;
  522.             tree = tree->lnode;
  523.             if (treep == &treelist[STACKSIZE])
  524.                 break;
  525.         }
  526.         *treep = tree;
  527.         /*
  528.          * Now, evaluate to strings in LIFO order, accumulating
  529.          * the string length, so we can do a single malloc at the
  530.          * end.
  531.          */
  532.         strp = strlist;
  533.         len = 0;
  534.         while (treep >= treelist) {
  535.             *strp = force_string(tree_eval(*treep--));
  536.             len += (*strp)->stlen;
  537.             strp++;
  538.         }
  539.         *strp = NULL;
  540.         emalloc(str, char *, len+2, "tree_eval");
  541.         str[len] = str[len+1] = '\0';    /* for good measure */
  542.         dest = str;
  543.         strp = strlist;
  544.         while (*strp) {
  545.             memcpy(dest, (*strp)->stptr, (*strp)->stlen);
  546.             dest += (*strp)->stlen;
  547.             free_temp(*strp);
  548.             strp++;
  549.         }
  550.         r = make_str_node(str, len, ALREADY_MALLOCED);
  551.         r->flags |= TEMP;
  552.         }
  553.         return r;
  554.  
  555.     /* other assignment types are easier because they are numeric */
  556.     case Node_preincrement:
  557.     case Node_predecrement:
  558.     case Node_postincrement:
  559.     case Node_postdecrement:
  560.     case Node_assign_exp:
  561.     case Node_assign_times:
  562.     case Node_assign_quotient:
  563.     case Node_assign_mod:
  564.     case Node_assign_plus:
  565.     case Node_assign_minus:
  566.         return op_assign(tree);
  567.     default:
  568.         break;    /* handled below */
  569.     }
  570.  
  571.     /* evaluate subtrees in order to do binary operation, then keep going */
  572.     t1 = tree_eval(tree->lnode);
  573.     t2 = tree_eval(tree->rnode);
  574.  
  575.     switch (tree->type) {
  576.     case Node_geq:
  577.     case Node_leq:
  578.     case Node_greater:
  579.     case Node_less:
  580.     case Node_notequal:
  581.     case Node_equal:
  582.         di = cmp_nodes(t1, t2);
  583.         free_temp(t1);
  584.         free_temp(t2);
  585.         switch (tree->type) {
  586.         case Node_equal:
  587.             return tmp_number((AWKNUM) (di == 0));
  588.         case Node_notequal:
  589.             return tmp_number((AWKNUM) (di != 0));
  590.         case Node_less:
  591.             return tmp_number((AWKNUM) (di < 0));
  592.         case Node_greater:
  593.             return tmp_number((AWKNUM) (di > 0));
  594.         case Node_leq:
  595.             return tmp_number((AWKNUM) (di <= 0));
  596.         case Node_geq:
  597.             return tmp_number((AWKNUM) (di >= 0));
  598.         default:
  599.             cant_happen();
  600.         }
  601.         break;
  602.     default:
  603.         break;    /* handled below */
  604.     }
  605.  
  606.     x1 = force_number(t1);
  607.     free_temp(t1);
  608.     x2 = force_number(t2);
  609.     free_temp(t2);
  610.     switch (tree->type) {
  611.     case Node_exp:
  612.         if ((lx = x2) == x2 && lx >= 0) {    /* integer exponent */
  613.             if (lx == 0)
  614.                 x = 1;
  615.             else if (lx == 1)
  616.                 x = x1;
  617.             else {
  618.                 /* doing it this way should be more precise */
  619.                 for (x = x1; --lx; )
  620.                     x *= x1;
  621.             }
  622.         } else
  623.             x = pow((double) x1, (double) x2);
  624.         return tmp_number(x);
  625.  
  626.     case Node_times:
  627.         return tmp_number(x1 * x2);
  628.  
  629.     case Node_quotient:
  630.         if (x2 == 0)
  631.             fatal("division by zero attempted");
  632. #ifdef _CRAY
  633.         /*
  634.          * special case for integer division, put in for Cray
  635.          */
  636.         lx2 = x2;
  637.         if (lx2 == 0)
  638.             return tmp_number(x1 / x2);
  639.         lx = (long) x1 / lx2;
  640.         if (lx * x2 == x1)
  641.             return tmp_number((AWKNUM) lx);
  642.         else
  643. #endif
  644.             return tmp_number(x1 / x2);
  645.  
  646.     case Node_mod:
  647.         if (x2 == 0)
  648.             fatal("division by zero attempted in mod");
  649. #ifndef FMOD_MISSING
  650.         return tmp_number(fmod (x1, x2));
  651. #else
  652.         (void) modf(x1 / x2, &x);
  653.         return tmp_number(x1 - x * x2);
  654. #endif
  655.  
  656.     case Node_plus:
  657.         return tmp_number(x1 + x2);
  658.  
  659.     case Node_minus:
  660.         return tmp_number(x1 - x2);
  661.  
  662.     case Node_var_array:
  663.         fatal("attempt to use array `%s' in a scalar context", tree->vname);
  664.  
  665.     default:
  666.         fatal("illegal type (%d) in tree_eval", tree->type);
  667.     }
  668.     return 0;
  669. }
  670.  
  671. /* Is TREE true or false?  Returns 0==false, non-zero==true */
  672. static int
  673. eval_condition(tree)
  674. register NODE *tree;
  675. {
  676.     register NODE *t1;
  677.     register int ret;
  678.  
  679.     if (tree == NULL)    /* Null trees are the easiest kinds */
  680.         return 1;
  681.     if (tree->type == Node_line_range) {
  682.         /*
  683.          * Node_line_range is kind of like Node_match, EXCEPT: the
  684.          * lnode field (more properly, the condpair field) is a node
  685.          * of a Node_cond_pair; whether we evaluate the lnode of that
  686.          * node or the rnode depends on the triggered word.  More
  687.          * precisely:  if we are not yet triggered, we tree_eval the
  688.          * lnode; if that returns true, we set the triggered word. 
  689.          * If we are triggered (not ELSE IF, note), we tree_eval the
  690.          * rnode, clear triggered if it succeeds, and perform our
  691.          * action (regardless of success or failure).  We want to be
  692.          * able to begin and end on a single input record, so this
  693.          * isn't an ELSE IF, as noted above.
  694.          */
  695.         if (!tree->triggered)
  696.             if (!eval_condition(tree->condpair->lnode))
  697.                 return 0;
  698.             else
  699.                 tree->triggered = 1;
  700.         /* Else we are triggered */
  701.         if (eval_condition(tree->condpair->rnode))
  702.             tree->triggered = 0;
  703.         return 1;
  704.     }
  705.  
  706.     /*
  707.      * Could just be J.random expression. in which case, null and 0 are
  708.      * false, anything else is true 
  709.      */
  710.  
  711.     t1 = tree_eval(tree);
  712.     if (t1->flags & MAYBE_NUM)
  713.         (void) force_number(t1);
  714.     if (t1->flags & NUMBER)
  715.         ret = t1->numbr != 0.0;
  716.     else
  717.         ret = t1->stlen != 0;
  718.     free_temp(t1);
  719.     return ret;
  720. }
  721.  
  722. /*
  723.  * compare two nodes, returning negative, 0, positive
  724.  */
  725. int
  726. cmp_nodes(t1, t2)
  727. register NODE *t1, *t2;
  728. {
  729.     register int ret;
  730.     register size_t len1, len2;
  731.  
  732.     if (t1 == t2)
  733.         return 0;
  734.     if (t1->flags & MAYBE_NUM)
  735.         (void) force_number(t1);
  736.     if (t2->flags & MAYBE_NUM)
  737.         (void) force_number(t2);
  738.     if ((t1->flags & NUMBER) && (t2->flags & NUMBER)) {
  739.         if (t1->numbr == t2->numbr) return 0;
  740.         else if (t1->numbr - t2->numbr < 0)  return -1;
  741.         else return 1;
  742.     }
  743.     (void) force_string(t1);
  744.     (void) force_string(t2);
  745.     len1 = t1->stlen;
  746.     len2 = t2->stlen;
  747.     if (len1 == 0 || len2 == 0)
  748.         return len1 - len2;
  749.     ret = memcmp(t1->stptr, t2->stptr, len1 <= len2 ? len1 : len2);
  750.     return ret == 0 ? len1-len2 : ret;
  751. }
  752.  
  753. static NODE *
  754. op_assign(tree)
  755. register NODE *tree;
  756. {
  757.     AWKNUM rval, lval;
  758.     NODE **lhs;
  759.     AWKNUM t1, t2;
  760.     long ltemp;
  761.     NODE *tmp;
  762.     Func_ptr after_assign = NULL;
  763.  
  764.     lhs = get_lhs(tree->lnode, &after_assign);
  765.     lval = force_number(*lhs);
  766.  
  767.     /*
  768.      * Can't unref *lhs until we know the type; doing so
  769.      * too early breaks   x += x   sorts of things.
  770.      */
  771.     switch(tree->type) {
  772.     case Node_preincrement:
  773.     case Node_predecrement:
  774.         unref(*lhs);
  775.         *lhs = make_number(lval +
  776.                    (tree->type == Node_preincrement ? 1.0 : -1.0));
  777.         if (after_assign)
  778.             (*after_assign)();
  779.         return *lhs;
  780.  
  781.     case Node_postincrement:
  782.     case Node_postdecrement:
  783.         unref(*lhs);
  784.         *lhs = make_number(lval +
  785.                    (tree->type == Node_postincrement ? 1.0 : -1.0));
  786.         if (after_assign)
  787.             (*after_assign)();
  788.         return tmp_number(lval);
  789.     default:
  790.         break;    /* handled below */
  791.     }
  792.  
  793.     tmp = tree_eval(tree->rnode);
  794.     rval = force_number(tmp);
  795.     free_temp(tmp);
  796.     unref(*lhs);
  797.     switch(tree->type) {
  798.     case Node_assign_exp:
  799.         if ((ltemp = rval) == rval) {    /* integer exponent */
  800.             if (ltemp == 0)
  801.                 *lhs = make_number((AWKNUM) 1);
  802.             else if (ltemp == 1)
  803.                 *lhs = make_number(lval);
  804.             else {
  805.                 /* doing it this way should be more precise */
  806.                 for (t1 = t2 = lval; --ltemp; )
  807.                     t1 *= t2;
  808.                 *lhs = make_number(t1);
  809.             }
  810.         } else
  811.             *lhs = make_number((AWKNUM) pow((double) lval, (double) rval));
  812.         break;
  813.  
  814.     case Node_assign_times:
  815.         *lhs = make_number(lval * rval);
  816.         break;
  817.  
  818.     case Node_assign_quotient:
  819.         if (rval == (AWKNUM) 0)
  820.             fatal("division by zero attempted in /=");
  821. #ifdef _CRAY
  822.         /*
  823.          * special case for integer division, put in for Cray
  824.          */
  825.         ltemp = rval;
  826.         if (ltemp == 0) {
  827.             *lhs = make_number(lval / rval);
  828.             break;
  829.         }
  830.         ltemp = (long) lval / ltemp;
  831.         if (ltemp * lval == rval)
  832.             *lhs = make_number((AWKNUM) ltemp);
  833.         else
  834. #endif
  835.             *lhs = make_number(lval / rval);
  836.         break;
  837.  
  838.     case Node_assign_mod:
  839.         if (rval == (AWKNUM) 0)
  840.             fatal("division by zero attempted in %=");
  841. #ifndef FMOD_MISSING
  842.         *lhs = make_number(fmod(lval, rval));
  843. #else
  844.         (void) modf(lval / rval, &t1);
  845.         t2 = lval - rval * t1;
  846.         *lhs = make_number(t2);
  847. #endif
  848.         break;
  849.  
  850.     case Node_assign_plus:
  851.         *lhs = make_number(lval + rval);
  852.         break;
  853.  
  854.     case Node_assign_minus:
  855.         *lhs = make_number(lval - rval);
  856.         break;
  857.     default:
  858.         cant_happen();
  859.     }
  860.     if (after_assign)
  861.         (*after_assign)();
  862.     return *lhs;
  863. }
  864.  
  865. NODE **stack_ptr;
  866.  
  867. static NODE *
  868. func_call(name, arg_list)
  869. NODE *name;        /* name is a Node_val giving function name */
  870. NODE *arg_list;        /* Node_expression_list of calling args. */
  871. {
  872.     register NODE *arg, *argp, *r;
  873.     NODE *n, *f;
  874.     jmp_buf volatile func_tag_stack;
  875.     jmp_buf volatile loop_tag_stack;
  876.     int volatile save_loop_tag_valid = 0;
  877.     NODE **volatile save_stack, *save_ret_node;
  878.     NODE **volatile local_stack = NULL, **sp;
  879.     int count;
  880.     extern NODE *ret_node;
  881.  
  882.     /*
  883.      * retrieve function definition node
  884.      */
  885.     f = lookup(name->stptr);
  886.     if (!f || f->type != Node_func)
  887.         fatal("function `%s' not defined", name->stptr);
  888. #ifdef FUNC_TRACE
  889.     fprintf(stderr, "function %s called\n", name->stptr);
  890. #endif
  891.     count = f->lnode->param_cnt;
  892.     if (count)
  893.         emalloc(local_stack, NODE **, count*sizeof(NODE *), "func_call");
  894.     sp = local_stack;
  895.  
  896.     /*
  897.      * for each calling arg. add NODE * on stack
  898.      */
  899.     for (argp = arg_list; count && argp != NULL; argp = argp->rnode) {
  900.         arg = argp->lnode;
  901.         getnode(r);
  902.         r->type = Node_var;
  903.         /*
  904.          * call by reference for arrays; see below also
  905.          */
  906.         if (arg->type == Node_param_list)
  907.             arg = stack_ptr[arg->param_cnt];
  908.         if (arg->type == Node_var_array)
  909.             *r = *arg;
  910.         else {
  911.             n = tree_eval(arg);
  912.             r->lnode = dupnode(n);
  913.             r->rnode = (NODE *) NULL;
  914.             free_temp(n);
  915.           }
  916.         *sp++ = r;
  917.         count--;
  918.     }
  919.     if (argp != NULL)    /* left over calling args. */
  920.         warning(
  921.             "function `%s' called with more arguments than declared",
  922.             name->stptr);
  923.     /*
  924.      * add remaining params. on stack with null value
  925.      */
  926.     while (count-- > 0) {
  927.         getnode(r);
  928.         r->type = Node_var;
  929.         r->lnode = Nnull_string;
  930.         r->rnode = (NODE *) NULL;
  931.         *sp++ = r;
  932.     }
  933.  
  934.     /*
  935.      * Execute function body, saving context, as a return statement
  936.      * will longjmp back here.
  937.      *
  938.      * Have to save and restore the loop_tag stuff so that a return
  939.      * inside a loop in a function body doesn't scrog any loops going
  940.      * on in the main program.  We save the necessary info in variables
  941.      * local to this function so that function nesting works OK.
  942.      * We also only bother to save the loop stuff if we're in a loop
  943.      * when the function is called.
  944.      */
  945.     if (loop_tag_valid) {
  946.         int junk = 0;
  947.  
  948.         save_loop_tag_valid = (volatile int) loop_tag_valid;
  949.         PUSH_BINDING(loop_tag_stack, loop_tag, junk);
  950.         loop_tag_valid = 0;
  951.     }
  952.     save_stack = stack_ptr;
  953.     stack_ptr = local_stack;
  954.     PUSH_BINDING(func_tag_stack, func_tag, func_tag_valid);
  955.     save_ret_node = ret_node;
  956.     ret_node = Nnull_string;    /* default return value */
  957.     if (setjmp(func_tag) == 0)
  958.         (void) interpret(f->rnode);
  959.  
  960.     r = ret_node;
  961.     ret_node = (NODE *) save_ret_node;
  962.     RESTORE_BINDING(func_tag_stack, func_tag, func_tag_valid);
  963.     stack_ptr = (NODE **) save_stack;
  964.  
  965.     /*
  966.      * here, we pop each parameter and check whether
  967.      * it was an array.  If so, and if the arg. passed in was
  968.      * a simple variable, then the value should be copied back.
  969.      * This achieves "call-by-reference" for arrays.
  970.      */
  971.     sp = local_stack;
  972.     count = f->lnode->param_cnt;
  973.     for (argp = arg_list; count > 0 && argp != NULL; argp = argp->rnode) {
  974.         arg = argp->lnode;
  975.         if (arg->type == Node_param_list)
  976.             arg = stack_ptr[arg->param_cnt];
  977.         n = *sp++;
  978.         if ((arg->type == Node_var || arg->type == Node_var_array)
  979.             && n->type == Node_var_array) {
  980.             /* should we free arg->var_value ? */
  981.             arg->var_array = n->var_array;
  982.             arg->type = Node_var_array;
  983.             arg->array_size = n->array_size;
  984.             arg->table_size = n->table_size;
  985.             arg->flags = n->flags;
  986.         }
  987.         /* n->lnode overlays the array size, don't unref it if array */
  988.         if (n->type != Node_var_array)
  989.             unref(n->lnode);
  990.         freenode(n);
  991.         count--;
  992.     }
  993.     while (count-- > 0) {
  994.         n = *sp++;
  995.         /* if n is an (local) array, all the elements should be freed */
  996.         if (n->type == Node_var_array)
  997.             assoc_clear(n);
  998.         unref(n->lnode);
  999.         freenode(n);
  1000.     }
  1001.     if (local_stack)
  1002.         free((char *) local_stack);
  1003.  
  1004.     /* Restore the loop_tag stuff if necessary. */
  1005.     if (save_loop_tag_valid) {
  1006.         int junk = 0;
  1007.  
  1008.         loop_tag_valid = (int) save_loop_tag_valid;
  1009.         RESTORE_BINDING(loop_tag_stack, loop_tag, junk);
  1010.     }
  1011.  
  1012.     if (!(r->flags & PERM))
  1013.         r->flags |= TEMP;
  1014.     return r;
  1015. }
  1016.  
  1017. /*
  1018.  * This returns a POINTER to a node pointer. get_lhs(ptr) is the current
  1019.  * value of the var, or where to store the var's new value 
  1020.  */
  1021.  
  1022. NODE **
  1023. r_get_lhs(ptr, assign)
  1024. register NODE *ptr;
  1025. Func_ptr *assign;
  1026. {
  1027.     register NODE **aptr = NULL;
  1028.     register NODE *n;
  1029.  
  1030.     switch (ptr->type) {
  1031.     case Node_var_array:
  1032.         fatal("attempt to use array `%s' in a scalar context", ptr->vname);
  1033.     case Node_var:
  1034.         aptr = &(ptr->var_value);
  1035. #ifdef DEBUG
  1036.         if ((char)ptr->var_value->stref <= 0)
  1037.             cant_happen();
  1038. #endif
  1039.         break;
  1040.  
  1041.     case Node_FIELDWIDTHS:
  1042.         aptr = &(FIELDWIDTHS_node->var_value);
  1043.         if (assign)
  1044.             *assign = set_FIELDWIDTHS;
  1045.         break;
  1046.  
  1047.     case Node_RS:
  1048.         aptr = &(RS_node->var_value);
  1049.         if (assign)
  1050.             *assign = set_RS;
  1051.         break;
  1052.  
  1053.     case Node_FS:
  1054.         aptr = &(FS_node->var_value);
  1055.         if (assign)
  1056.             *assign = set_FS;
  1057.         break;
  1058.  
  1059.     case Node_FNR:
  1060.         unref(FNR_node->var_value);
  1061.         FNR_node->var_value = make_number((AWKNUM) FNR);
  1062.         aptr = &(FNR_node->var_value);
  1063.         if (assign)
  1064.             *assign = set_FNR;
  1065.         break;
  1066.  
  1067.     case Node_NR:
  1068.         unref(NR_node->var_value);
  1069.         NR_node->var_value = make_number((AWKNUM) NR);
  1070.         aptr = &(NR_node->var_value);
  1071.         if (assign)
  1072.             *assign = set_NR;
  1073.         break;
  1074.  
  1075.     case Node_NF:
  1076.         if (NF == -1)
  1077.             (void) get_field(HUGE-1, assign); /* parse record */
  1078.         unref(NF_node->var_value);
  1079.         NF_node->var_value = make_number((AWKNUM) NF);
  1080.         aptr = &(NF_node->var_value);
  1081.         if (assign)
  1082.             *assign = set_NF;
  1083.         break;
  1084.  
  1085.     case Node_IGNORECASE:
  1086.         unref(IGNORECASE_node->var_value);
  1087.         IGNORECASE_node->var_value = make_number((AWKNUM) IGNORECASE);
  1088.         aptr = &(IGNORECASE_node->var_value);
  1089.         if (assign)
  1090.             *assign = set_IGNORECASE;
  1091.         break;
  1092.  
  1093.     case Node_OFMT:
  1094.         aptr = &(OFMT_node->var_value);
  1095.         if (assign)
  1096.             *assign = set_OFMT;
  1097.         break;
  1098.  
  1099.     case Node_CONVFMT:
  1100.         aptr = &(CONVFMT_node->var_value);
  1101.         if (assign)
  1102.             *assign = set_CONVFMT;
  1103.         break;
  1104.  
  1105.     case Node_ORS:
  1106.         aptr = &(ORS_node->var_value);
  1107.         if (assign)
  1108.             *assign = set_ORS;
  1109.         break;
  1110.  
  1111.     case Node_OFS:
  1112.         aptr = &(OFS_node->var_value);
  1113.         if (assign)
  1114.             *assign = set_OFS;
  1115.         break;
  1116.  
  1117.     case Node_param_list:
  1118.         aptr = &(stack_ptr[ptr->param_cnt]->var_value);
  1119.         break;
  1120.  
  1121.     case Node_field_spec:
  1122.         {
  1123.         int field_num;
  1124.  
  1125.         n = tree_eval(ptr->lnode);
  1126.         field_num = (int) force_number(n);
  1127.         free_temp(n);
  1128.         if (field_num < 0)
  1129.             fatal("attempt to access field %d", field_num);
  1130.         if (field_num == 0 && field0_valid) {    /* short circuit */
  1131.             aptr = &fields_arr[0];
  1132.             if (assign)
  1133.                 *assign = reset_record;
  1134.             break;
  1135.         }
  1136.         aptr = get_field(field_num, assign);
  1137.         break;
  1138.         }
  1139.     case Node_subscript:
  1140.         n = ptr->lnode;
  1141.         if (n->type == Node_param_list)
  1142.             n = stack_ptr[n->param_cnt];
  1143.         aptr = assoc_lookup(n, concat_exp(ptr->rnode));
  1144.         break;
  1145.  
  1146.     case Node_func:
  1147.         fatal ("`%s' is a function, assignment is not allowed",
  1148.             ptr->lnode->param);
  1149.     default:
  1150.         cant_happen();
  1151.     }
  1152.     return aptr;
  1153. }
  1154.  
  1155. static NODE *
  1156. match_op(tree)
  1157. register NODE *tree;
  1158. {
  1159.     register NODE *t1;
  1160.     register Regexp *rp;
  1161.     int i;
  1162.     int match = 1;
  1163.  
  1164.     if (tree->type == Node_nomatch)
  1165.         match = 0;
  1166.     if (tree->type == Node_regex)
  1167.         t1 = *get_field(0, (Func_ptr *) 0);
  1168.     else {
  1169.         t1 = force_string(tree_eval(tree->lnode));
  1170.         tree = tree->rnode;
  1171.     }
  1172.     rp = re_update(tree);
  1173.     i = research(rp, t1->stptr, 0, t1->stlen, 0);
  1174.     i = (i == -1) ^ (match == 1);
  1175.     free_temp(t1);
  1176.     return tmp_number((AWKNUM) i);
  1177. }
  1178.  
  1179. void
  1180. set_IGNORECASE()
  1181. {
  1182.     static int warned = 0;
  1183.  
  1184.     if ((do_lint || do_unix) && ! warned) {
  1185.         warned = 1;
  1186.         warning("IGNORECASE not supported in compatibility mode");
  1187.     }
  1188.     IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
  1189.     set_FS();
  1190. }
  1191.  
  1192. void
  1193. set_OFS()
  1194. {
  1195.     OFS = force_string(OFS_node->var_value)->stptr;
  1196.     OFSlen = OFS_node->var_value->stlen;
  1197.     OFS[OFSlen] = '\0';
  1198. }
  1199.  
  1200. void
  1201. set_ORS()
  1202. {
  1203.     ORS = force_string(ORS_node->var_value)->stptr;
  1204.     ORSlen = ORS_node->var_value->stlen;
  1205.     ORS[ORSlen] = '\0';
  1206. }
  1207.  
  1208. NODE **fmt_list = NULL;
  1209. static int fmt_ok P((NODE *n));
  1210. static int fmt_index P((NODE *n));
  1211.  
  1212. static int
  1213. fmt_ok(n)
  1214. NODE *n;
  1215. {
  1216.     /* to be done later */
  1217.     return 1;
  1218. }
  1219.  
  1220. static int
  1221. fmt_index(n)
  1222. NODE *n;
  1223. {
  1224.     register int ix = 0;
  1225.     static int fmt_num = 4;
  1226.     static int fmt_hiwater = 0;
  1227.  
  1228.     if (fmt_list == NULL)
  1229.         emalloc(fmt_list, NODE **, fmt_num*sizeof(*fmt_list), "fmt_index");
  1230.     (void) force_string(n);
  1231.     while (ix < fmt_hiwater) {
  1232.         if (cmp_nodes(fmt_list[ix], n) == 0)
  1233.             return ix;
  1234.         ix++;
  1235.     }
  1236.     /* not found */
  1237.     n->stptr[n->stlen] = '\0';
  1238.     if (!fmt_ok(n))
  1239.         warning("bad FMT specification");
  1240.     if (fmt_hiwater >= fmt_num) {
  1241.         fmt_num *= 2;
  1242.         emalloc(fmt_list, NODE **, fmt_num, "fmt_index");
  1243.     }
  1244.     fmt_list[fmt_hiwater] = dupnode(n);
  1245.     return fmt_hiwater++;
  1246. }
  1247.  
  1248. void
  1249. set_OFMT()
  1250. {
  1251.     OFMTidx = fmt_index(OFMT_node->var_value);
  1252.     OFMT = fmt_list[OFMTidx]->stptr;
  1253. }
  1254.  
  1255. void
  1256. set_CONVFMT()
  1257. {
  1258.     CONVFMTidx = fmt_index(CONVFMT_node->var_value);
  1259.     CONVFMT = fmt_list[CONVFMTidx]->stptr;
  1260. }
  1261.