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