home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 11 / AUCD11B.iso / LANGUAGES / WraithSet / AwkStuff / GawkSrc / c / eval < prev    next >
Encoding:
Text File  |  1999-06-30  |  43.0 KB  |  1,757 lines
  1. /*
  2.  * eval.c - gawk parse tree interpreter 
  3.  */
  4.  
  5. /* 
  6.  * Copyright (C) 1986, 1988, 1989, 1991-1999 the Free Software Foundation, Inc.
  7.  * 
  8.  * This file is part of GAWK, the GNU implementation of the
  9.  * AWK Programming 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 this program; if not, write to the Free Software
  23.  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, 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. static void push_args P((int count, NODE *arglist, NODE **oldstack, char *func_name));
  37. static void pop_fcall_stack P((void));
  38. static void pop_fcall P((void));
  39. static int in_function P((void));
  40. char *nodetype2str P((NODETYPE type));
  41. char *flags2str P((int flagval));
  42.  
  43. #if __GNUC__ < 2
  44. NODE *_t;        /* used as a temporary in macros */
  45. #endif
  46. #ifdef MSDOS
  47. double _msc51bug;    /* to get around a bug in MSC 5.1 */
  48. #endif
  49. NODE *ret_node;
  50. int OFSlen;
  51. int ORSlen;
  52. int OFMTidx;
  53. int CONVFMTidx;
  54.  
  55. /* Macros and variables to save and restore function and loop bindings */
  56. /*
  57.  * the val variable allows return/continue/break-out-of-context to be
  58.  * caught and diagnosed
  59.  */
  60. #define PUSH_BINDING(stack, x, val) (memcpy((char *)(stack), (char *)(x), sizeof(jmp_buf)), val++)
  61. #define RESTORE_BINDING(stack, x, val) (memcpy((char *)(x), (char *)(stack), sizeof(jmp_buf)), val--)
  62.  
  63. static jmp_buf loop_tag;        /* always the current binding */
  64. static int loop_tag_valid = FALSE;    /* nonzero when loop_tag valid */
  65. static int func_tag_valid = FALSE;
  66. static jmp_buf func_tag;
  67. extern int exiting, exit_val;
  68.  
  69. /*
  70.  * This table is used by the regexp routines to do case independant
  71.  * matching. Basically, every ascii character maps to itself, except
  72.  * uppercase letters map to lower case ones. This table has 256
  73.  * entries, for ISO 8859-1. Note also that if the system this
  74.  * is compiled on doesn't use 7-bit ascii, casetable[] should not be
  75.  * defined to the linker, so gawk should not load.
  76.  *
  77.  * Do NOT make this array static, it is used in several spots, not
  78.  * just in this file.
  79.  */
  80. #if 'a' == 97    /* it's ascii */
  81. char casetable[] = {
  82.     '\000', '\001', '\002', '\003', '\004', '\005', '\006', '\007',
  83.     '\010', '\011', '\012', '\013', '\014', '\015', '\016', '\017',
  84.     '\020', '\021', '\022', '\023', '\024', '\025', '\026', '\027',
  85.     '\030', '\031', '\032', '\033', '\034', '\035', '\036', '\037',
  86.     /* ' '     '!'     '"'     '#'     '$'     '%'     '&'     ''' */
  87.     '\040', '\041', '\042', '\043', '\044', '\045', '\046', '\047',
  88.     /* '('     ')'     '*'     '+'     ','     '-'     '.'     '/' */
  89.     '\050', '\051', '\052', '\053', '\054', '\055', '\056', '\057',
  90.     /* '0'     '1'     '2'     '3'     '4'     '5'     '6'     '7' */
  91.     '\060', '\061', '\062', '\063', '\064', '\065', '\066', '\067',
  92.     /* '8'     '9'     ':'     ';'     '<'     '='     '>'     '?' */
  93.     '\070', '\071', '\072', '\073', '\074', '\075', '\076', '\077',
  94.     /* '@'     'A'     'B'     'C'     'D'     'E'     'F'     'G' */
  95.     '\100', '\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', '\133', '\134', '\135', '\136', '\137',
  102.     /* '`'     'a'     'b'     'c'     'd'     'e'     'f'     'g' */
  103.     '\140', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
  104.     /* 'h'     'i'     'j'     'k'     'l'     'm'     'n'     'o' */
  105.     '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
  106.     /* 'p'     'q'     'r'     's'     't'     'u'     'v'     'w' */
  107.     '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
  108.     /* 'x'     'y'     'z'     '{'     '|'     '}'     '~' */
  109.     '\170', '\171', '\172', '\173', '\174', '\175', '\176', '\177',
  110. #ifndef USE_PURE_ASCII
  111.     '\200', '\201', '\202', '\203', '\204', '\205', '\206', '\207',
  112.     '\210', '\211', '\212', '\213', '\214', '\215', '\216', '\217',
  113.     '\220', '\221', '\222', '\223', '\224', '\225', '\226', '\227',
  114.     '\230', '\231', '\232', '\233', '\234', '\235', '\236', '\237',
  115.     '\240', '\241', '\242', '\243', '\244', '\245', '\246', '\247',
  116.     '\250', '\251', '\252', '\253', '\254', '\255', '\256', '\257',
  117.     '\260', '\261', '\262', '\263', '\264', '\265', '\266', '\267',
  118.     '\270', '\271', '\272', '\273', '\274', '\275', '\276', '\277',
  119.     '\340', '\341', '\342', '\343', '\344', '\345', '\346', '\347',
  120.     '\350', '\351', '\352', '\353', '\354', '\355', '\356', '\357',
  121.     '\360', '\361', '\362', '\363', '\364', '\365', '\366', '\327',
  122.     '\370', '\371', '\372', '\373', '\374', '\375', '\376', '\337',
  123.     '\340', '\341', '\342', '\343', '\344', '\345', '\346', '\347',
  124.     '\350', '\351', '\352', '\353', '\354', '\355', '\356', '\357',
  125.     '\360', '\361', '\362', '\363', '\364', '\365', '\366', '\367',
  126.     '\370', '\371', '\372', '\373', '\374', '\375', '\376', '\377',
  127. #else
  128.     '\200', '\201', '\202', '\203', '\204', '\205', '\206', '\207',
  129.     '\210', '\211', '\212', '\213', '\214', '\215', '\216', '\217',
  130.     '\220', '\221', '\222', '\223', '\224', '\225', '\226', '\227',
  131.     '\230', '\231', '\232', '\233', '\234', '\235', '\236', '\237',
  132.     '\240', '\241', '\242', '\243', '\244', '\245', '\246', '\247',
  133.     '\250', '\251', '\252', '\253', '\254', '\255', '\256', '\257',
  134.     '\260', '\261', '\262', '\263', '\264', '\265', '\266', '\267',
  135.     '\270', '\271', '\272', '\273', '\274', '\275', '\276', '\277',
  136.     '\300', '\301', '\302', '\303', '\304', '\305', '\306', '\307',
  137.     '\310', '\311', '\312', '\313', '\314', '\315', '\316', '\317',
  138.     '\320', '\321', '\322', '\323', '\324', '\325', '\326', '\327',
  139.     '\330', '\331', '\332', '\333', '\334', '\335', '\336', '\337',
  140.     '\340', '\341', '\342', '\343', '\344', '\345', '\346', '\347',
  141.     '\350', '\351', '\352', '\353', '\354', '\355', '\356', '\357',
  142.     '\360', '\361', '\362', '\363', '\364', '\365', '\366', '\367',
  143.     '\370', '\371', '\372', '\373', '\374', '\375', '\376', '\377',
  144. #endif
  145. };
  146. #else
  147. #include "You lose. You will need a translation table for your character set."
  148. #endif
  149.  
  150. /*
  151.  * This table maps node types to strings for debugging.
  152.  * KEEP IN SYNC WITH awk.h!!!!
  153.  */
  154. static char *nodetypes[] = {
  155.     "Node_illegal",
  156.     "Node_times",
  157.     "Node_quotient",
  158.     "Node_mod",
  159.     "Node_plus",
  160.     "Node_minus",
  161.     "Node_cond_pair",
  162.     "Node_subscript",
  163.     "Node_concat",
  164.     "Node_exp",
  165.     "Node_preincrement",
  166.     "Node_predecrement",
  167.     "Node_postincrement",
  168.     "Node_postdecrement",
  169.     "Node_unary_minus",
  170.     "Node_field_spec",
  171.     "Node_assign",
  172.     "Node_assign_times",
  173.     "Node_assign_quotient",
  174.     "Node_assign_mod",
  175.     "Node_assign_plus",
  176.     "Node_assign_minus",
  177.     "Node_assign_exp",
  178.     "Node_and",
  179.     "Node_or",
  180.     "Node_equal",
  181.     "Node_notequal",
  182.     "Node_less",
  183.     "Node_greater",
  184.     "Node_leq",
  185.     "Node_geq",
  186.     "Node_match",
  187.     "Node_nomatch",
  188.     "Node_not",
  189.     "Node_rule_list",
  190.     "Node_rule_node",
  191.     "Node_statement_list",
  192.     "Node_if_branches",
  193.     "Node_expression_list",
  194.     "Node_param_list",
  195.     "Node_K_if",
  196.     "Node_K_while",    
  197.     "Node_K_for",
  198.     "Node_K_arrayfor",
  199.     "Node_K_break",
  200.     "Node_K_continue",
  201.     "Node_K_print",
  202.     "Node_K_printf",
  203.     "Node_K_next",
  204.     "Node_K_exit",
  205.     "Node_K_do",
  206.     "Node_K_return",
  207.     "Node_K_delete",
  208.     "Node_K_getline",
  209.     "Node_K_function",
  210.     "Node_K_nextfile",
  211.     "Node_redirect_output",
  212.     "Node_redirect_append",
  213.     "Node_redirect_pipe",
  214.     "Node_redirect_pipein",
  215.     "Node_redirect_input",
  216.     "Node_var",
  217.     "Node_var_array",
  218.     "Node_val",
  219.     "Node_builtin",
  220.     "Node_line_range",
  221.     "Node_in_array",
  222.     "Node_func",
  223.     "Node_func_call",
  224.     "Node_cond_exp",
  225.     "Node_regex",
  226.     "Node_hashnode",
  227.     "Node_ahash",
  228.     "Node_NF",
  229.     "Node_NR",
  230.     "Node_FNR",
  231.     "Node_FS",
  232.     "Node_RS",
  233.     "Node_FIELDWIDTHS",
  234.     "Node_IGNORECASE",
  235.     "Node_OFS",
  236.     "Node_ORS",
  237.     "Node_OFMT",
  238.     "Node_CONVFMT",
  239.     "Node_final",
  240.     NULL
  241. };
  242.  
  243. char *
  244. nodetype2str(type)
  245. NODETYPE type;
  246. {
  247.     static char buf[40];
  248.  
  249.     if (type >= Node_illegal && type <= Node_final)
  250.         return nodetypes[(int) type];
  251.  
  252.     sprintf(buf, "unknown nodetype %d", (int) type);
  253.     return buf;
  254. }
  255.  
  256. /* flags2str --- make a flags value readable */
  257.  
  258. char *
  259. flags2str(flagval)
  260. int flagval;
  261. {
  262.     static char buffer[BUFSIZ];
  263.     char *sp;
  264.  
  265.     sp = buffer;
  266.  
  267.     if (flagval & MALLOC) {
  268.         strcpy(sp, "MALLOC");
  269.         sp += strlen(sp);
  270.     }
  271.     if (flagval & TEMP) {
  272.         if (sp != buffer)
  273.             *sp++ = '|';
  274.         strcpy(sp, "TEMP");
  275.         sp += strlen(sp);
  276.     }
  277.     if (flagval & PERM) {
  278.         if (sp != buffer)
  279.             *sp++ = '|';
  280.         strcpy(sp, "PERM");
  281.         sp += strlen(sp);
  282.     }
  283.     if (flagval & STRING) {
  284.         if (sp != buffer)
  285.             *sp++ = '|';
  286.         strcpy(sp, "STRING");
  287.         sp += strlen(sp);
  288.     }
  289.     if (flagval & STR) {
  290.         if (sp != buffer)
  291.             *sp++ = '|';
  292.         strcpy(sp, "STR");
  293.         sp += strlen(sp);
  294.     }
  295.     if (flagval & NUM) {
  296.         if (sp != buffer)
  297.             *sp++ = '|';
  298.         strcpy(sp, "NUM");
  299.         sp += strlen(sp);
  300.     }
  301.     if (flagval & NUMBER) {
  302.         if (sp != buffer)
  303.             *sp++ = '|';
  304.         strcpy(sp, "NUMBER");
  305.         sp += strlen(sp);
  306.     }
  307.     if (flagval & MAYBE_NUM) {
  308.         if (sp != buffer)
  309.             *sp++ = '|';
  310.         strcpy(sp, "MAYBE_NUM");
  311.         sp += strlen(sp);
  312.     }
  313.     if (flagval & ARRAYMAXED) {
  314.         if (sp != buffer)
  315.             *sp++ = '|';
  316.         strcpy(sp, "ARRAYMAXED");
  317.         sp += strlen(sp);
  318.     }
  319.     if (flagval & SCALAR) {
  320.         if (sp != buffer)
  321.             *sp++ = '|';
  322.         strcpy(sp, "SCALAR");
  323.         sp += strlen(sp);
  324.     }
  325.     if (flagval & FUNC) {
  326.         if (sp != buffer)
  327.             *sp++ = '|';
  328.         strcpy(sp, "FUNC");
  329.         sp += strlen(sp);
  330.     }
  331.     if (flagval & FIELD) {
  332.         if (sp != buffer)
  333.             *sp++ = '|';
  334.         strcpy(sp, "FIELD");
  335.         sp += strlen(sp);
  336.     }
  337.  
  338.     return buffer;
  339. }
  340.  
  341. /*
  342.  * interpret:
  343.  * Tree is a bunch of rules to run. Returns zero if it hit an exit()
  344.  * statement 
  345.  */
  346. int
  347. interpret(tree)
  348. register NODE *volatile tree;
  349. {
  350.     jmp_buf volatile loop_tag_stack; /* shallow binding stack for loop_tag */
  351.     static jmp_buf rule_tag; /* tag the rule currently being run, for NEXT
  352.                   * and EXIT statements.  It is static because
  353.                   * there are no nested rules */
  354.     register NODE *volatile t = NULL;    /* temporary */
  355.     NODE **volatile lhs;    /* lhs == Left Hand Side for assigns, etc */
  356.     NODE *volatile stable_tree;
  357.     int volatile traverse = TRUE;    /* True => loop thru tree (Node_rule_list) */
  358.  
  359.     /* avoid false source indications */
  360.     source = NULL;
  361.     sourceline = 0;
  362.  
  363.     if (tree == NULL)
  364.         return 1;
  365.     sourceline = tree->source_line;
  366.     source = tree->source_file;
  367.     switch (tree->type) {
  368.     case Node_rule_node:
  369.         traverse = FALSE;  /* False => one for-loop iteration only */
  370.         /* FALL THROUGH */
  371.     case Node_rule_list:
  372.         for (t = tree; t != NULL; t = t->rnode) {
  373.             if (traverse)
  374.                 tree = t->lnode;
  375.             sourceline = tree->source_line;
  376.             source = tree->source_file;
  377.             switch (setjmp(rule_tag)) {
  378.             case 0:    /* normal non-jump */
  379.                 /* test pattern, if any */
  380.                 if (tree->lnode == NULL ||
  381.                     eval_condition(tree->lnode))
  382.                     (void) interpret(tree->rnode);
  383.                 break;
  384.             case TAG_CONTINUE:    /* NEXT statement */
  385.                 return 1;
  386.             case TAG_BREAK:
  387.                 return 0;
  388.             default:
  389.                 cant_happen();
  390.             }
  391.             if (! traverse)     /* case Node_rule_node */
  392.                 break;        /* don't loop */
  393.         }
  394.         break;
  395.  
  396.     case Node_statement_list:
  397.         for (t = tree; t != NULL; t = t->rnode)
  398.             (void) interpret(t->lnode);
  399.         break;
  400.  
  401.     case Node_K_if:
  402.         if (eval_condition(tree->lnode))
  403.             (void) interpret(tree->rnode->lnode);
  404.         else
  405.             (void) interpret(tree->rnode->rnode);
  406.         break;
  407.  
  408.     case Node_K_while:
  409.         PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  410.  
  411.         stable_tree = tree;
  412.         while (eval_condition(stable_tree->lnode)) {
  413.             switch (setjmp(loop_tag)) {
  414.             case 0:    /* normal non-jump */
  415.                 (void) interpret(stable_tree->rnode);
  416.                 break;
  417.             case TAG_CONTINUE:    /* continue statement */
  418.                 break;
  419.             case TAG_BREAK:    /* break statement */
  420.                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  421.                 return 1;
  422.             default:
  423.                 cant_happen();
  424.             }
  425.         }
  426.         RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  427.         break;
  428.  
  429.     case Node_K_do:
  430.         PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  431.         stable_tree = tree;
  432.         do {
  433.             switch (setjmp(loop_tag)) {
  434.             case 0:    /* normal non-jump */
  435.                 (void) interpret(stable_tree->rnode);
  436.                 break;
  437.             case TAG_CONTINUE:    /* continue statement */
  438.                 break;
  439.             case TAG_BREAK:    /* break statement */
  440.                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  441.                 return 1;
  442.             default:
  443.                 cant_happen();
  444.             }
  445.         } while (eval_condition(stable_tree->lnode));
  446.         RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  447.         break;
  448.  
  449.     case Node_K_for:
  450.         PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  451.         (void) interpret(tree->forloop->init);
  452.         stable_tree = tree;
  453.         while (eval_condition(stable_tree->forloop->cond)) {
  454.             switch (setjmp(loop_tag)) {
  455.             case 0:    /* normal non-jump */
  456.                 (void) interpret(stable_tree->lnode);
  457.                 /* fall through */
  458.             case TAG_CONTINUE:    /* continue statement */
  459.                 (void) interpret(stable_tree->forloop->incr);
  460.                 break;
  461.             case TAG_BREAK:    /* break statement */
  462.                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  463.                 return 1;
  464.             default:
  465.                 cant_happen();
  466.             }
  467.         }
  468.         RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  469.         break;
  470.  
  471.     case Node_K_arrayfor:
  472.         {
  473.         volatile struct search l;    /* For array_for */
  474.         Func_ptr after_assign = NULL;
  475.  
  476. #define hakvar forloop->init
  477. #define arrvar forloop->incr
  478.         PUSH_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  479.         lhs = get_lhs(tree->hakvar, &after_assign);
  480.         t = tree->arrvar;
  481.         if (t->type == Node_param_list)
  482.             t = stack_ptr[t->param_cnt];
  483.         stable_tree = tree;
  484.         if ((t->flags & SCALAR) != 0)
  485.             fatal("attempt to use scalar as array");
  486.         for (assoc_scan(t, (struct search *)&l);
  487.              l.retval;
  488.              assoc_next((struct search *)&l)) {
  489.             unref(*((NODE **) lhs));
  490.             *lhs = dupnode(l.retval);
  491.             if (after_assign)
  492.                 (*after_assign)();
  493.             switch (setjmp(loop_tag)) {
  494.             case 0:
  495.                 (void) interpret(stable_tree->lnode);
  496.             case TAG_CONTINUE:
  497.                 break;
  498.  
  499.             case TAG_BREAK:
  500.                 RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  501.                 return 1;
  502.             default:
  503.                 cant_happen();
  504.             }
  505.         }
  506.         RESTORE_BINDING(loop_tag_stack, loop_tag, loop_tag_valid);
  507.         break;
  508.         }
  509.  
  510.     case Node_K_break:
  511.         if (! loop_tag_valid) {
  512.             /*
  513.              * Old AT&T nawk treats break outside of loops like
  514.              * next. New ones catch it at parse time. Allow it if
  515.              * do_traditional is on, and complain if lint.
  516.              */
  517.             static int warned = FALSE;
  518.  
  519.             if (do_lint && ! warned) {
  520.                 warning("use of `break' outside a loop is not portable");
  521.                 warned = TRUE;
  522.             }
  523.             if (! do_traditional || do_posix)
  524.                 fatal("use of `break' outside a loop is not allowed");
  525.             if (in_function())
  526.                 pop_fcall_stack();
  527.             longjmp(rule_tag, TAG_CONTINUE);
  528.         } else
  529.             longjmp(loop_tag, TAG_BREAK);
  530.         break;
  531.  
  532.     case Node_K_continue:
  533.         if (! loop_tag_valid) {
  534.             /*
  535.              * Old AT&T nawk treats continue outside of loops like
  536.              * next. New ones catch it at parse time. Allow it if
  537.              * do_traditional is on, and complain if lint.
  538.              */
  539.             static int warned = FALSE;
  540.  
  541.             if (do_lint && ! warned) {
  542.                 warning("use of `continue' outside a loop is not portable");
  543.                 warned = TRUE;
  544.             }
  545.             if (! do_traditional || do_posix)
  546.                 fatal("use of `continue' outside a loop is not allowed");
  547.             if (in_function())
  548.                 pop_fcall_stack();
  549.             longjmp(rule_tag, TAG_CONTINUE);
  550.         } else
  551.             longjmp(loop_tag, TAG_CONTINUE);
  552.         break;
  553.  
  554.     case Node_K_print:
  555.         do_print(tree);
  556.         break;
  557.  
  558.     case Node_K_printf:
  559.         do_printf(tree);
  560.         break;
  561.  
  562.     case Node_K_delete:
  563.         do_delete(tree->lnode, tree->rnode);
  564.         break;
  565.  
  566.     case Node_K_next:
  567.         if (in_begin_rule)
  568.             fatal("`next' cannot be called from a BEGIN rule");
  569.         else if (in_end_rule)
  570.             fatal("`next' cannot be called from an END rule");
  571.  
  572.         if (in_function())
  573.             pop_fcall_stack();
  574.  
  575.         longjmp(rule_tag, TAG_CONTINUE);
  576.         break;
  577.  
  578.     case Node_K_nextfile:
  579.         if (in_begin_rule)
  580.             fatal("`nextfile' cannot be called from a BEGIN rule");
  581.         else if (in_end_rule)
  582.             fatal("`nextfile' cannot be called from an END rule");
  583.  
  584.         if (in_function())
  585.             pop_fcall_stack();
  586.  
  587.         do_nextfile();
  588.         break;
  589.  
  590.     case Node_K_exit:
  591.         /*
  592.          * In A,K,&W, p. 49, it says that an exit statement "...
  593.          * causes the program to behave as if the end of input had
  594.          * occurred; no more input is read, and the END actions, if
  595.          * any are executed." This implies that the rest of the rules
  596.          * are not done. So we immediately break out of the main loop.
  597.          */
  598.         exiting = TRUE;
  599.         if (tree->lnode != NULL) {
  600.             t = tree_eval(tree->lnode);
  601.             exit_val = (int) force_number(t);
  602.             free_temp(t);
  603.         }
  604.         longjmp(rule_tag, TAG_BREAK);
  605.         break;
  606.  
  607.     case Node_K_return:
  608.         t = tree_eval(tree->lnode);
  609.         ret_node = dupnode(t);
  610.         free_temp(t);
  611.         longjmp(func_tag, TAG_RETURN);
  612.         break;
  613.  
  614.     default:
  615.         /*
  616.          * Appears to be an expression statement.  Throw away the
  617.          * value. 
  618.          */
  619.         if (do_lint && tree->type == Node_var)
  620.             warning("statement has no effect");
  621.         t = tree_eval(tree);
  622.         free_temp(t);
  623.         break;
  624.     }
  625.     return 1;
  626. }
  627.  
  628. /* r_tree_eval --- evaluate a subtree */
  629.  
  630. NODE *
  631. r_tree_eval(tree, iscond)
  632. register NODE *tree;
  633. int iscond;
  634. {
  635.     register NODE *r, *t1, *t2;    /* return value & temporary subtrees */
  636.     register NODE **lhs;
  637.     register int di;
  638.     AWKNUM x, x1, x2;
  639.     long lx;
  640. #ifdef _CRAY
  641.     long lx2;
  642. #endif
  643.     char namebuf[100];
  644.  
  645. #ifdef DEBUG
  646.     if (tree == NULL)
  647.         return Nnull_string;
  648.     else if (tree->type == Node_val) {
  649.         if (tree->stref <= 0)
  650.             cant_happen();
  651.         return tree;
  652.     } else if (tree->type == Node_var) {
  653.         if (tree->var_value->stref <= 0)
  654.             cant_happen();
  655.         return tree->var_value;
  656.     }
  657. #endif
  658.  
  659.     if (tree->type == Node_param_list) {
  660.         int paramnum = tree->param_cnt + 1;
  661.  
  662.         tree = stack_ptr[tree->param_cnt];
  663.         if (tree == NULL)
  664.             return Nnull_string;
  665.         sprintf(namebuf, "parameter #%d", paramnum);
  666.         tree->vname = namebuf;
  667.     }
  668.  
  669.     switch (tree->type) {
  670.     case Node_var:
  671.         return tree->var_value;
  672.  
  673.     case Node_and:
  674.         return tmp_number((AWKNUM) (eval_condition(tree->lnode)
  675.                         && eval_condition(tree->rnode)));
  676.  
  677.     case Node_or:
  678.         return tmp_number((AWKNUM) (eval_condition(tree->lnode)
  679.                         || eval_condition(tree->rnode)));
  680.  
  681.     case Node_not:
  682.         return tmp_number((AWKNUM) ! eval_condition(tree->lnode));
  683.  
  684.         /* Builtins */
  685.     case Node_builtin:
  686.         return (*tree->proc)(tree->subnode);
  687.  
  688.     case Node_K_getline:
  689.         return (do_getline(tree));
  690.  
  691.     case Node_in_array:
  692.         return tmp_number((AWKNUM) in_array(tree->lnode, tree->rnode));
  693.  
  694.     case Node_func_call:
  695.         return func_call(tree->rnode, tree->lnode);
  696.  
  697.         /* unary operations */
  698.     case Node_NR:
  699.     case Node_FNR:
  700.     case Node_NF:
  701.     case Node_FIELDWIDTHS:
  702.     case Node_FS:
  703.     case Node_RS:
  704.     case Node_field_spec:
  705.     case Node_subscript:
  706.     case Node_IGNORECASE:
  707.     case Node_OFS:
  708.     case Node_ORS:
  709.     case Node_OFMT:
  710.     case Node_CONVFMT:
  711.         lhs = get_lhs(tree, (Func_ptr *) NULL);
  712.         return *lhs;
  713.  
  714.     case Node_var_array:
  715.         fatal("attempt to use array `%s' in a scalar context",
  716.             tree->vname);
  717.  
  718.     case Node_unary_minus:
  719.         t1 = tree_eval(tree->subnode);
  720.         x = -force_number(t1);
  721.         free_temp(t1);
  722.         return tmp_number(x);
  723.  
  724.     case Node_cond_exp:
  725.         if (eval_condition(tree->lnode))
  726.             return tree_eval(tree->rnode->lnode);
  727.         return tree_eval(tree->rnode->rnode);
  728.  
  729.     case Node_match:
  730.     case Node_nomatch:
  731.     case Node_regex:
  732.         return match_op(tree);
  733.  
  734.     case Node_func:
  735.         fatal("function `%s' called with space between name and (,\n%s",
  736.             tree->lnode->param,
  737.             "or used in other expression context");
  738.  
  739.         /* assignments */
  740.     case Node_assign:
  741.         {
  742.         Func_ptr after_assign = NULL;
  743.  
  744.         if (iscond && do_lint)
  745.             warning("assignment used in conditional context");
  746.         r = tree_eval(tree->rnode);
  747.         lhs = get_lhs(tree->lnode, &after_assign);
  748.         if (r != *lhs) {
  749.             NODE *save;
  750.  
  751.             save = *lhs;
  752.             *lhs = dupnode(r);
  753.             unref(save);
  754.         }
  755.         free_temp(r);
  756.         tree->lnode->flags |= SCALAR;
  757.         if (after_assign)
  758.             (*after_assign)();
  759.         return *lhs;
  760.         }
  761.  
  762.     case Node_concat:
  763.         {
  764.         NODE **treelist;
  765.         NODE **strlist;
  766.         NODE *save_tree;
  767.         register NODE **treep;
  768.         register NODE **strp;
  769.         register size_t len;
  770.         char *str;
  771.         register char *dest;
  772.         int alloc_count, str_count;
  773.         int i;
  774.  
  775.         /*
  776.          * This is an efficiency hack for multiple adjacent string
  777.          * concatenations, to avoid recursion and string copies.
  778.          *
  779.          * Node_concat trees grow downward to the left, so
  780.          * descend to lowest (first) node, accumulating nodes
  781.          * to evaluate to strings as we go.
  782.          */
  783.  
  784.         /*
  785.          * But first, no arbitrary limits. Count the number of
  786.          * nodes and malloc the treelist and strlist arrays.
  787.          * There will be alloc_count + 1 items to concatenate. We
  788.          * also leave room for an extra pointer at the end to
  789.          * use as a sentinel.  Thus, start alloc_count at 2.
  790.          */
  791.         save_tree = tree;
  792.         for (alloc_count = 2; tree && tree->type == Node_concat; tree = tree->lnode)
  793.             alloc_count++;
  794.         tree = save_tree;
  795.         emalloc(treelist, NODE **, sizeof(NODE *) * alloc_count, "tree_eval");
  796.         emalloc(strlist, NODE **, sizeof(NODE *) * alloc_count, "tree_eval");
  797.  
  798.         /* Now, here we go. */
  799.         treep = treelist;
  800.         while (tree && tree->type == Node_concat) {
  801.             *treep++ = tree->rnode;
  802.             tree = tree->lnode;
  803.         }
  804.         *treep = tree;
  805.         /*
  806.          * Now, evaluate to strings in LIFO order, accumulating
  807.          * the string length, so we can do a single malloc at the
  808.          * end.
  809.          *
  810.          * Evaluate the expressions first, then get their
  811.          * lengthes, in case one of the expressions has a
  812.          * side effect that changes one of the others.
  813.          * See test/nasty.awk.
  814.          */
  815.         strp = strlist;
  816.         len = 0;
  817.         while (treep >= treelist) {
  818.             *strp = force_string(tree_eval(*treep--));
  819.             strp++;
  820.         }
  821.         *strp = NULL;
  822.  
  823.         str_count = strp - strlist;
  824.         strp = strlist;
  825.         for (i = 0; i < str_count; i++) {
  826.             len += (*strp)->stlen;
  827.             strp++;
  828.         }
  829.         emalloc(str, char *, len+2, "tree_eval");
  830.         str[len] = str[len+1] = '\0';    /* for good measure */
  831.         dest = str;
  832.         strp = strlist;
  833.         while (*strp) {
  834.             memcpy(dest, (*strp)->stptr, (*strp)->stlen);
  835.             dest += (*strp)->stlen;
  836.             free_temp(*strp);
  837.             strp++;
  838.         }
  839.         r = make_str_node(str, len, ALREADY_MALLOCED);
  840.         r->flags |= TEMP;
  841.  
  842.         free(strlist);
  843.         free(treelist);
  844.         }
  845.         return r;
  846.  
  847.     /* other assignment types are easier because they are numeric */
  848.     case Node_preincrement:
  849.     case Node_predecrement:
  850.     case Node_postincrement:
  851.     case Node_postdecrement:
  852.     case Node_assign_exp:
  853.     case Node_assign_times:
  854.     case Node_assign_quotient:
  855.     case Node_assign_mod:
  856.     case Node_assign_plus:
  857.     case Node_assign_minus:
  858.         return op_assign(tree);
  859.     default:
  860.         break;    /* handled below */
  861.     }
  862.  
  863.     /* evaluate subtrees in order to do binary operation, then keep going */
  864.     t1 = tree_eval(tree->lnode);
  865.     t2 = tree_eval(tree->rnode);
  866.  
  867.     switch (tree->type) {
  868.     case Node_geq:
  869.     case Node_leq:
  870.     case Node_greater:
  871.     case Node_less:
  872.     case Node_notequal:
  873.     case Node_equal:
  874.         di = cmp_nodes(t1, t2);
  875.         free_temp(t1);
  876.         free_temp(t2);
  877.         switch (tree->type) {
  878.         case Node_equal:
  879.             return tmp_number((AWKNUM) (di == 0));
  880.         case Node_notequal:
  881.             return tmp_number((AWKNUM) (di != 0));
  882.         case Node_less:
  883.             return tmp_number((AWKNUM) (di < 0));
  884.         case Node_greater:
  885.             return tmp_number((AWKNUM) (di > 0));
  886.         case Node_leq:
  887.             return tmp_number((AWKNUM) (di <= 0));
  888.         case Node_geq:
  889.             return tmp_number((AWKNUM) (di >= 0));
  890.         default:
  891.             cant_happen();
  892.         }
  893.         break;
  894.     default:
  895.         break;    /* handled below */
  896.     }
  897.  
  898.     x1 = force_number(t1);
  899.     free_temp(t1);
  900.     x2 = force_number(t2);
  901.     free_temp(t2);
  902.     switch (tree->type) {
  903.     case Node_exp:
  904.         if ((lx = x2) == x2 && lx >= 0) {    /* integer exponent */
  905.             if (lx == 0)
  906.                 x = 1;
  907.             else if (lx == 1)
  908.                 x = x1;
  909.             else {
  910.                 /* doing it this way should be more precise */
  911.                 for (x = x1; --lx; )
  912.                     x *= x1;
  913.             }
  914.         } else
  915.             x = pow((double) x1, (double) x2);
  916.         return tmp_number(x);
  917.  
  918.     case Node_times:
  919.         return tmp_number(x1 * x2);
  920.  
  921.     case Node_quotient:
  922.         if (x2 == 0)
  923.             fatal("division by zero attempted");
  924. #ifdef _CRAY
  925.         /* special case for integer division, put in for Cray */
  926.         lx2 = x2;
  927.         if (lx2 == 0)
  928.             return tmp_number(x1 / x2);
  929.         lx = (long) x1 / lx2;
  930.         if (lx * x2 == x1)
  931.             return tmp_number((AWKNUM) lx);
  932.         else
  933. #endif
  934.             return tmp_number(x1 / x2);
  935.  
  936.     case Node_mod:
  937.         if (x2 == 0)
  938.             fatal("division by zero attempted in mod");
  939. #ifdef HAVE_FMOD
  940.         return tmp_number(fmod(x1, x2));
  941. #else    /* ! HAVE_FMOD */
  942.         (void) modf(x1 / x2, &x);
  943.         return tmp_number(x1 - x * x2);
  944. #endif    /* ! HAVE_FMOD */
  945.  
  946.     case Node_plus:
  947.         return tmp_number(x1 + x2);
  948.  
  949.     case Node_minus:
  950.         return tmp_number(x1 - x2);
  951.  
  952.     case Node_var_array:
  953.         fatal("attempt to use array `%s' in a scalar context",
  954.             tree->vname);
  955.  
  956.     default:
  957.         fatal("illegal type (%s) in tree_eval", nodetype2str(tree->type));
  958.     }
  959.     return 0;
  960. }
  961.  
  962. /* eval_condition --- is TREE true or false? Returns 0==false, non-zero==true */
  963.  
  964. static int
  965. eval_condition(tree)
  966. register NODE *tree;
  967. {
  968.     register NODE *t1;
  969.     register int ret;
  970.  
  971.     if (tree == NULL)    /* Null trees are the easiest kinds */
  972.         return TRUE;
  973.     if (tree->type == Node_line_range) {
  974.         /*
  975.          * Node_line_range is kind of like Node_match, EXCEPT: the
  976.          * lnode field (more properly, the condpair field) is a node
  977.          * of a Node_cond_pair; whether we evaluate the lnode of that
  978.          * node or the rnode depends on the triggered word.  More
  979.          * precisely:  if we are not yet triggered, we tree_eval the
  980.          * lnode; if that returns true, we set the triggered word. 
  981.          * If we are triggered (not ELSE IF, note), we tree_eval the
  982.          * rnode, clear triggered if it succeeds, and perform our
  983.          * action (regardless of success or failure).  We want to be
  984.          * able to begin and end on a single input record, so this
  985.          * isn't an ELSE IF, as noted above.
  986.          */
  987.         if (! tree->triggered)
  988.             if (! eval_condition(tree->condpair->lnode))
  989.                 return FALSE;
  990.             else
  991.                 tree->triggered = TRUE;
  992.         /* Else we are triggered */
  993.         if (eval_condition(tree->condpair->rnode))
  994.             tree->triggered = FALSE;
  995.         return TRUE;
  996.     }
  997.  
  998.     /*
  999.      * Could just be J.random expression. in which case, null and 0 are
  1000.      * false, anything else is true 
  1001.      */
  1002.  
  1003.     t1 = m_tree_eval(tree, TRUE);
  1004.     if (t1->flags & MAYBE_NUM)
  1005.         (void) force_number(t1);
  1006.     if (t1->flags & NUMBER)
  1007.         ret = (t1->numbr != 0.0);
  1008.     else
  1009.         ret = (t1->stlen != 0);
  1010.     free_temp(t1);
  1011.     return ret;
  1012. }
  1013.  
  1014. /* cmp_nodes --- compare two nodes, returning negative, 0, positive */
  1015.  
  1016. int
  1017. cmp_nodes(t1, t2)
  1018. register NODE *t1, *t2;
  1019. {
  1020.     register int ret;
  1021.     register size_t len1, len2;
  1022.     register int l;
  1023.     int ldiff;
  1024.  
  1025.     if (t1 == t2)
  1026.         return 0;
  1027.     if (t1->flags & MAYBE_NUM)
  1028.         (void) force_number(t1);
  1029.     if (t2->flags & MAYBE_NUM)
  1030.         (void) force_number(t2);
  1031.     if ((t1->flags & NUMBER) && (t2->flags & NUMBER)) {
  1032.         if (t1->numbr == t2->numbr)
  1033.             return 0;
  1034.         /* don't subtract, in case one or both are infinite */
  1035.         else if (t1->numbr < t2->numbr)
  1036.             return -1;
  1037.         else
  1038.             return 1;
  1039.     }
  1040.     (void) force_string(t1);
  1041.     (void) force_string(t2);
  1042.     len1 = t1->stlen;
  1043.     len2 = t2->stlen;
  1044.     ldiff = len1 - len2;
  1045.     if (len1 == 0 || len2 == 0)
  1046.         return ldiff;
  1047.     l = (ldiff <= 0 ? len1 : len2);
  1048.     if (IGNORECASE) {
  1049.         register unsigned char *cp1 = (unsigned char *) t1->stptr;
  1050.         register unsigned char *cp2 = (unsigned char *) t2->stptr;
  1051.  
  1052.         for (ret = 0; l-- > 0 && ret == 0; cp1++, cp2++)
  1053.             ret = casetable[*cp1] - casetable[*cp2];
  1054.     } else
  1055.         ret = memcmp(t1->stptr, t2->stptr, l);
  1056.     return (ret == 0 ? ldiff : ret);
  1057. }
  1058.  
  1059. /* op_assign --- do +=, -=, etc. */
  1060.  
  1061. static NODE *
  1062. op_assign(tree)
  1063. register NODE *tree;
  1064. {
  1065.     AWKNUM rval, lval;
  1066.     NODE **lhs;
  1067.     AWKNUM t1, t2;
  1068.     long ltemp;
  1069.     NODE *tmp;
  1070.     Func_ptr after_assign = NULL;
  1071.  
  1072.     lhs = get_lhs(tree->lnode, &after_assign);
  1073.     lval = force_number(*lhs);
  1074.  
  1075.     /*
  1076.      * Can't unref *lhs until we know the type; doing so
  1077.      * too early breaks   x += x   sorts of things.
  1078.      */
  1079.     switch(tree->type) {
  1080.     case Node_preincrement:
  1081.     case Node_predecrement:
  1082.         unref(*lhs);
  1083.         *lhs = make_number(lval +
  1084.                    (tree->type == Node_preincrement ? 1.0 : -1.0));
  1085.         tree->lnode->flags |= SCALAR;
  1086.         if (after_assign)
  1087.             (*after_assign)();
  1088.         return *lhs;
  1089.  
  1090.     case Node_postincrement:
  1091.     case Node_postdecrement:
  1092.         unref(*lhs);
  1093.         *lhs = make_number(lval +
  1094.                    (tree->type == Node_postincrement ? 1.0 : -1.0));
  1095.         tree->lnode->flags |= SCALAR;
  1096.         if (after_assign)
  1097.             (*after_assign)();
  1098.         return tmp_number(lval);
  1099.     default:
  1100.         break;    /* handled below */
  1101.     }
  1102.  
  1103.     tmp = tree_eval(tree->rnode);
  1104.     rval = force_number(tmp);
  1105.     free_temp(tmp);
  1106.  
  1107.     /*
  1108.      * Do this again; the lhs and the rhs could both be fields.
  1109.      * Accessing the rhs could cause the lhs to have moved around.
  1110.      * (Yet another special case. Gack.)
  1111.      */
  1112.     lhs = get_lhs(tree->lnode, &after_assign);
  1113.  
  1114.     unref(*lhs);
  1115.     switch(tree->type) {
  1116.     case Node_assign_exp:
  1117.         if ((ltemp = rval) == rval) {    /* integer exponent */
  1118.             if (ltemp == 0)
  1119.                 *lhs = make_number((AWKNUM) 1);
  1120.             else if (ltemp == 1)
  1121.                 *lhs = make_number(lval);
  1122.             else {
  1123.                 /* doing it this way should be more precise */
  1124.                 for (t1 = t2 = lval; --ltemp; )
  1125.                     t1 *= t2;
  1126.                 *lhs = make_number(t1);
  1127.             }
  1128.         } else
  1129.             *lhs = make_number((AWKNUM) pow((double) lval, (double) rval));
  1130.         break;
  1131.  
  1132.     case Node_assign_times:
  1133.         *lhs = make_number(lval * rval);
  1134.         break;
  1135.  
  1136.     case Node_assign_quotient:
  1137.         if (rval == (AWKNUM) 0)
  1138.             fatal("division by zero attempted in /=");
  1139. #ifdef _CRAY
  1140.         /* special case for integer division, put in for Cray */
  1141.         ltemp = rval;
  1142.         if (ltemp == 0) {
  1143.             *lhs = make_number(lval / rval);
  1144.             break;
  1145.         }
  1146.         ltemp = (long) lval / ltemp;
  1147.         if (ltemp * lval == rval)
  1148.             *lhs = make_number((AWKNUM) ltemp);
  1149.         else
  1150. #endif    /* _CRAY */
  1151.             *lhs = make_number(lval / rval);
  1152.         break;
  1153.  
  1154.     case Node_assign_mod:
  1155.         if (rval == (AWKNUM) 0)
  1156.             fatal("division by zero attempted in %%=");
  1157. #ifdef HAVE_FMOD
  1158.         *lhs = make_number(fmod(lval, rval));
  1159. #else    /* ! HAVE_FMOD */
  1160.         (void) modf(lval / rval, &t1);
  1161.         t2 = lval - rval * t1;
  1162.         *lhs = make_number(t2);
  1163. #endif    /* ! HAVE_FMOD */
  1164.         break;
  1165.  
  1166.     case Node_assign_plus:
  1167.         *lhs = make_number(lval + rval);
  1168.         break;
  1169.  
  1170.     case Node_assign_minus:
  1171.         *lhs = make_number(lval - rval);
  1172.         break;
  1173.     default:
  1174.         cant_happen();
  1175.     }
  1176.     tree->lnode->flags |= SCALAR;
  1177.     if (after_assign)
  1178.         (*after_assign)();
  1179.     return *lhs;
  1180. }
  1181.  
  1182. static struct fcall {
  1183.     char *fname;
  1184.     unsigned long count;
  1185.     NODE *arglist;
  1186.     NODE **prevstack;
  1187.     NODE **stack;
  1188. } *fcall_list = NULL;
  1189.  
  1190. static long fcall_list_size = 0;
  1191. static long curfcall = -1;
  1192.  
  1193. /* in_function --- return true/false if we need to unwind awk functions */
  1194.  
  1195. static int
  1196. in_function()
  1197. {
  1198.     return (curfcall >= 0);
  1199. }
  1200.  
  1201. /* pop_fcall --- pop off a single function call */
  1202.  
  1203. static void
  1204. pop_fcall()
  1205. {
  1206.     NODE *n, **sp, *arg, *argp;
  1207.     int count;
  1208.     struct fcall *f;
  1209.  
  1210.     assert(curfcall >= 0);
  1211.     f = & fcall_list[curfcall];
  1212.     stack_ptr = f->prevstack;
  1213.  
  1214.     /*
  1215.      * here, we pop each parameter and check whether
  1216.      * it was an array.  If so, and if the arg. passed in was
  1217.      * a simple variable, then the value should be copied back.
  1218.      * This achieves "call-by-reference" for arrays.
  1219.      */
  1220.     sp = f->stack;
  1221.     count = f->count;
  1222.  
  1223.     for (argp = f->arglist; count > 0 && argp != NULL; argp = argp->rnode) {
  1224.         arg = argp->lnode;
  1225.         if (arg->type == Node_param_list)
  1226.             arg = stack_ptr[arg->param_cnt];
  1227.         n = *sp++;
  1228.         if ((arg->type == Node_var || arg->type == Node_var_array)
  1229.             && n->type == Node_var_array) {
  1230.             /* should we free arg->var_value ? */
  1231.             arg->var_array = n->var_array;
  1232.             arg->type = Node_var_array;
  1233.             arg->array_size = n->array_size;
  1234.             arg->table_size = n->table_size;
  1235.             arg->flags = n->flags;
  1236.         }
  1237.         /* n->lnode overlays the array size, don't unref it if array */
  1238.         if (n->type != Node_var_array)
  1239.             unref(n->lnode);
  1240.         freenode(n);
  1241.         count--;
  1242.     }
  1243.     while (count-- > 0) {
  1244.         n = *sp++;
  1245.         /* if n is a local array, all the elements should be freed */
  1246.         if (n->type == Node_var_array)
  1247.             assoc_clear(n);
  1248.         unref(n->lnode);
  1249.         freenode(n);
  1250.     }
  1251.     if (f->stack)
  1252.         free((char *) f->stack);
  1253.     memset(f, '\0', sizeof(struct fcall));
  1254.     curfcall--;
  1255. }
  1256.  
  1257. /* pop_fcall_stack --- pop off all function args, don't leak memory */
  1258.  
  1259. static void
  1260. pop_fcall_stack()
  1261. {
  1262.     while (curfcall >= 0)
  1263.         pop_fcall();
  1264. }
  1265.  
  1266. /* push_args --- push function arguments onto the stack */
  1267.  
  1268. static void
  1269. push_args(count, arglist, oldstack, func_name)
  1270. int count;
  1271. NODE *arglist;
  1272. NODE **oldstack;
  1273. char *func_name;
  1274. {
  1275.     struct fcall *f;
  1276.     NODE *arg, *argp, *r, **sp, *n;
  1277.  
  1278.     if (fcall_list_size == 0) {    /* first time */
  1279.         emalloc(fcall_list, struct fcall *, 10 * sizeof(struct fcall),
  1280.             "push_args");
  1281.         fcall_list_size = 10;
  1282.     }
  1283.  
  1284.     if (++curfcall >= fcall_list_size) {
  1285.         fcall_list_size *= 2;
  1286.         erealloc(fcall_list, struct fcall *,
  1287.             fcall_list_size * sizeof(struct fcall), "push_args");
  1288.     }
  1289.     f = & fcall_list[curfcall];
  1290.     memset(f, '\0', sizeof(struct fcall));
  1291.  
  1292.     if (count > 0)
  1293.         emalloc(f->stack, NODE **, count*sizeof(NODE *), "func_call");
  1294.     f->count = count;
  1295.     f->fname = func_name;    /* not used, for debugging, just in case */
  1296.     f->arglist = arglist;
  1297.     f->prevstack = oldstack;
  1298.  
  1299.     sp = f->stack;
  1300.  
  1301.     /* for each calling arg. add NODE * on stack */
  1302.     for (argp = arglist; count > 0 && argp != NULL; argp = argp->rnode) {
  1303.         arg = argp->lnode;
  1304.         getnode(r);
  1305.         r->type = Node_var;
  1306.  
  1307.         /* call by reference for arrays; see below also */
  1308.         if (arg->type == Node_param_list)
  1309.             arg = f->prevstack[arg->param_cnt];
  1310.         if (arg->type == Node_var_array)
  1311.             *r = *arg;
  1312.         else {
  1313.             n = tree_eval(arg);
  1314.             r->lnode = dupnode(n);
  1315.             r->rnode = (NODE *) NULL;
  1316.               if ((n->flags & SCALAR) != 0)
  1317.                   r->flags |= SCALAR;
  1318.             free_temp(n);
  1319.           }
  1320.         *sp++ = r;
  1321.         count--;
  1322.     }
  1323.     if (argp != NULL)    /* left over calling args. */
  1324.         warning(
  1325.             "function `%s' called with more arguments than declared",
  1326.             func_name);
  1327.  
  1328.     /* add remaining params. on stack with null value */
  1329.     while (count-- > 0) {
  1330.         getnode(r);
  1331.         r->type = Node_var;
  1332.         r->lnode = Nnull_string;
  1333.         r->flags &= ~SCALAR;
  1334.         r->rnode = (NODE *) NULL;
  1335.         *sp++ = r;
  1336.     }
  1337.  
  1338.     /*
  1339.      * We have to reassign f. Why, you may ask?  It is possible that
  1340.      * other functions were called during the course of tree_eval()-ing
  1341.      * the arguments to this function. As a result of that, fcall_list
  1342.      * may have been realloc()'ed, with the result that f is now
  1343.      * pointing into free()'d space.  This was a nasty one to track down.
  1344.      */
  1345.     f = & fcall_list[curfcall];
  1346.  
  1347.     stack_ptr = f->stack;
  1348. }
  1349.  
  1350. /* func_call --- call a function, call by reference for arrays */
  1351.  
  1352. NODE **stack_ptr;
  1353.  
  1354. static NODE *
  1355. func_call(name, arg_list)
  1356. NODE *name;        /* name is a Node_val giving function name */
  1357. NODE *arg_list;        /* Node_expression_list of calling args. */
  1358. {
  1359.     register NODE *r;
  1360.     NODE *f;
  1361.     jmp_buf volatile func_tag_stack;
  1362.     jmp_buf volatile loop_tag_stack;
  1363.     int volatile save_loop_tag_valid = FALSE;
  1364.     NODE *save_ret_node;
  1365.     extern NODE *ret_node;
  1366.  
  1367.     /* retrieve function definition node */
  1368.     f = lookup(name->stptr);
  1369.     if (f == NULL || f->type != Node_func)
  1370.         fatal("function `%s' not defined", name->stptr);
  1371. #ifdef FUNC_TRACE
  1372.     fprintf(stderr, "function %s called\n", name->stptr);
  1373. #endif
  1374.     push_args(f->lnode->param_cnt, arg_list, stack_ptr, name->stptr);
  1375.  
  1376.     /*
  1377.      * Execute function body, saving context, as a return statement
  1378.      * will longjmp back here.
  1379.      *
  1380.      * Have to save and restore the loop_tag stuff so that a return
  1381.      * inside a loop in a function body doesn't scrog any loops going
  1382.      * on in the main program.  We save the necessary info in variables
  1383.      * local to this function so that function nesting works OK.
  1384.      * We also only bother to save the loop stuff if we're in a loop
  1385.      * when the function is called.
  1386.      */
  1387.     if (loop_tag_valid) {
  1388.         int junk = 0;
  1389.  
  1390.         save_loop_tag_valid = (volatile int) loop_tag_valid;
  1391.         PUSH_BINDING(loop_tag_stack, loop_tag, junk);
  1392.         loop_tag_valid = FALSE;
  1393.     }
  1394.     PUSH_BINDING(func_tag_stack, func_tag, func_tag_valid);
  1395.     save_ret_node = ret_node;
  1396.     ret_node = Nnull_string;    /* default return value */
  1397.     if (setjmp(func_tag) == 0)
  1398.         (void) interpret(f->rnode);
  1399.  
  1400.     r = ret_node;
  1401.     ret_node = (NODE *) save_ret_node;
  1402.     RESTORE_BINDING(func_tag_stack, func_tag, func_tag_valid);
  1403.     pop_fcall();
  1404.  
  1405.     /* Restore the loop_tag stuff if necessary. */
  1406.     if (save_loop_tag_valid) {
  1407.         int junk = 0;
  1408.  
  1409.         loop_tag_valid = (int) save_loop_tag_valid;
  1410.         RESTORE_BINDING(loop_tag_stack, loop_tag, junk);
  1411.     }
  1412.  
  1413.     if ((r->flags & PERM) == 0)
  1414.         r->flags |= TEMP;
  1415.     return r;
  1416. }
  1417.  
  1418. /*
  1419.  * r_get_lhs:
  1420.  * This returns a POINTER to a node pointer. get_lhs(ptr) is the current
  1421.  * value of the var, or where to store the var's new value 
  1422.  *
  1423.  * For the special variables, don't unref their current value if it's
  1424.  * the same as the internal copy; perhaps the current one is used in
  1425.  * a concatenation or some other expression somewhere higher up in the
  1426.  * call chain.  Ouch.
  1427.  */
  1428.  
  1429. NODE **
  1430. r_get_lhs(ptr, assign)
  1431. register NODE *ptr;
  1432. Func_ptr *assign;
  1433. {
  1434.     register NODE **aptr = NULL;
  1435.     register NODE *n;
  1436.  
  1437.     if (assign)
  1438.         *assign = NULL;    /* for safety */
  1439.     if (ptr->type == Node_param_list) {
  1440.         if ((ptr->flags & FUNC) != 0)
  1441.             fatal("can't use function name `%s' as variable or array", ptr->vname);
  1442.         ptr = stack_ptr[ptr->param_cnt];
  1443.     }
  1444.  
  1445.     switch (ptr->type) {
  1446.     case Node_var_array:
  1447.         fatal("attempt to use array `%s' in a scalar context",
  1448.             ptr->vname);
  1449.  
  1450.     case Node_var:
  1451.         aptr = &(ptr->var_value);
  1452. #ifdef DEBUG
  1453.         if (ptr->var_value->stref <= 0)
  1454.             cant_happen();
  1455. #endif
  1456.         break;
  1457.  
  1458.     case Node_FIELDWIDTHS:
  1459.         aptr = &(FIELDWIDTHS_node->var_value);
  1460.         if (assign != NULL)
  1461.             *assign = set_FIELDWIDTHS;
  1462.         break;
  1463.  
  1464.     case Node_RS:
  1465.         aptr = &(RS_node->var_value);
  1466.         if (assign != NULL)
  1467.             *assign = set_RS;
  1468.         break;
  1469.  
  1470.     case Node_FS:
  1471.         aptr = &(FS_node->var_value);
  1472.         if (assign != NULL)
  1473.             *assign = set_FS;
  1474.         break;
  1475.  
  1476.     case Node_FNR:
  1477.         if (FNR_node->var_value->numbr != FNR) {
  1478.             unref(FNR_node->var_value);
  1479.             FNR_node->var_value = make_number((AWKNUM) FNR);
  1480.         }
  1481.         aptr = &(FNR_node->var_value);
  1482.         if (assign != NULL)
  1483.             *assign = set_FNR;
  1484.         break;
  1485.  
  1486.     case Node_NR:
  1487.         if (NR_node->var_value->numbr != NR) {
  1488.             unref(NR_node->var_value);
  1489.             NR_node->var_value = make_number((AWKNUM) NR);
  1490.         }
  1491.         aptr = &(NR_node->var_value);
  1492.         if (assign != NULL)
  1493.             *assign = set_NR;
  1494.         break;
  1495.  
  1496.     case Node_NF:
  1497.         if (NF == -1 || NF_node->var_value->numbr != NF) {
  1498.             if (NF == -1)
  1499.                 (void) get_field(HUGE-1, assign); /* parse record */
  1500.             unref(NF_node->var_value);
  1501.             NF_node->var_value = make_number((AWKNUM) NF);
  1502.         }
  1503.         aptr = &(NF_node->var_value);
  1504.         if (assign != NULL)
  1505.             *assign = set_NF;
  1506.         break;
  1507.  
  1508.     case Node_IGNORECASE:
  1509.         aptr = &(IGNORECASE_node->var_value);
  1510.         if (assign != NULL)
  1511.             *assign = set_IGNORECASE;
  1512.         break;
  1513.  
  1514.     case Node_OFMT:
  1515.         aptr = &(OFMT_node->var_value);
  1516.         if (assign != NULL)
  1517.             *assign = set_OFMT;
  1518.         break;
  1519.  
  1520.     case Node_CONVFMT:
  1521.         aptr = &(CONVFMT_node->var_value);
  1522.         if (assign != NULL)
  1523.             *assign = set_CONVFMT;
  1524.         break;
  1525.  
  1526.     case Node_ORS:
  1527.         aptr = &(ORS_node->var_value);
  1528.         if (assign != NULL)
  1529.             *assign = set_ORS;
  1530.         break;
  1531.  
  1532.     case Node_OFS:
  1533.         aptr = &(OFS_node->var_value);
  1534.         if (assign != NULL)
  1535.             *assign = set_OFS;
  1536.         break;
  1537.  
  1538.     case Node_param_list:
  1539.         aptr = &(stack_ptr[ptr->param_cnt]->var_value);
  1540.         break;
  1541.  
  1542.     case Node_field_spec:
  1543.         {
  1544.         int field_num;
  1545.  
  1546.         n = tree_eval(ptr->lnode);
  1547.         field_num = (int) force_number(n);
  1548.         free_temp(n);
  1549.         if (field_num < 0)
  1550.             fatal("attempt to access field %d", field_num);
  1551.         if (field_num == 0 && field0_valid) {    /* short circuit */
  1552.             aptr = &fields_arr[0];
  1553.             if (assign != NULL)
  1554.                 *assign = reset_record;
  1555.             break;
  1556.         }
  1557.         aptr = get_field(field_num, assign);
  1558.         break;
  1559.         }
  1560.     case Node_subscript:
  1561.         n = ptr->lnode;
  1562.         if (n->type == Node_param_list) {
  1563.             int i = n->param_cnt + 1;
  1564.  
  1565.             n = stack_ptr[n->param_cnt];
  1566.             if ((n->flags & SCALAR) != 0)
  1567.                 fatal("attempt to use scalar parameter %d as an array", i);
  1568.         } else if (n->type == Node_func) {
  1569.             fatal("attempt to use function `%s' as array",
  1570.                 n->lnode->param);
  1571.         }
  1572.         aptr = assoc_lookup(n, concat_exp(ptr->rnode));
  1573.         break;
  1574.  
  1575.     case Node_func:
  1576.         fatal("`%s' is a function, assignment is not allowed",
  1577.             ptr->lnode->param);
  1578.  
  1579.     case Node_builtin:
  1580.         fatal("assignment is not allowed to result of builtin function");
  1581.     default:
  1582.         cant_happen();
  1583.     }
  1584.     return aptr;
  1585. }
  1586.  
  1587. /* match_op --- do ~ and !~ */
  1588.  
  1589. static NODE *
  1590. match_op(tree)
  1591. register NODE *tree;
  1592. {
  1593.     register NODE *t1;
  1594.     register Regexp *rp;
  1595.     int i;
  1596.     int match = TRUE;
  1597.     int kludge_need_start = FALSE;    /* FIXME: --- see below */
  1598.  
  1599.     if (tree->type == Node_nomatch)
  1600.         match = FALSE;
  1601.     if (tree->type == Node_regex)
  1602.         t1 = *get_field(0, (Func_ptr *) 0);
  1603.     else {
  1604.         t1 = force_string(tree_eval(tree->lnode));
  1605.         tree = tree->rnode;
  1606.     }
  1607.     rp = re_update(tree);
  1608.     /*
  1609.      * FIXME:
  1610.      *
  1611.      * Any place where research() is called with a last parameter of
  1612.      * FALSE, we need to use the avoid_dfa test. This is the only place
  1613.      * at the moment.
  1614.      *
  1615.      * A new or improved dfa that distinguishes beginning/end of
  1616.      * string from beginning/end of line will allow us to get rid of
  1617.      * this temporary hack.
  1618.      *
  1619.      * The avoid_dfa() function is in re.c; it is not very smart.
  1620.      */
  1621.     if (avoid_dfa(tree, t1->stptr, t1->stlen))
  1622.         kludge_need_start = TRUE;
  1623.     i = research(rp, t1->stptr, 0, t1->stlen, kludge_need_start);
  1624.     i = (i == -1) ^ (match == TRUE);
  1625.     free_temp(t1);
  1626.     return tmp_number((AWKNUM) i);
  1627. }
  1628.  
  1629. /* set_IGNORECASE --- update IGNORECASE as appropriate */
  1630.  
  1631. void
  1632. set_IGNORECASE()
  1633. {
  1634.     static int warned = FALSE;
  1635.  
  1636.     if ((do_lint || do_traditional) && ! warned) {
  1637.         warned = TRUE;
  1638.         warning("IGNORECASE not supported in compatibility mode");
  1639.     }
  1640.     if (do_traditional)
  1641.         IGNORECASE = FALSE;
  1642.     else if ((IGNORECASE_node->var_value->flags & (STRING|STR)) != 0) {
  1643.         if ((IGNORECASE_node->var_value->flags & MAYBE_NUM) == 0)
  1644.             IGNORECASE = (force_string(IGNORECASE_node->var_value)->stlen > 0);
  1645.         else
  1646.             IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
  1647.     } else if ((IGNORECASE_node->var_value->flags & (NUM|NUMBER)) != 0)
  1648.         IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
  1649.     else
  1650.         IGNORECASE = FALSE;        /* shouldn't happen */
  1651.     set_FS_if_not_FIELDWIDTHS();
  1652. }
  1653.  
  1654. /* set_OFS --- update OFS related variables when OFS assigned to */
  1655.  
  1656. void
  1657. set_OFS()
  1658. {
  1659.     OFS = force_string(OFS_node->var_value)->stptr;
  1660.     OFSlen = OFS_node->var_value->stlen;
  1661.     OFS[OFSlen] = '\0';
  1662. }
  1663.  
  1664. /* set_ORS --- update ORS related variables when ORS assigned to */
  1665.  
  1666. void
  1667. set_ORS()
  1668. {
  1669.     ORS = force_string(ORS_node->var_value)->stptr;
  1670.     ORSlen = ORS_node->var_value->stlen;
  1671.     ORS[ORSlen] = '\0';
  1672. }
  1673.  
  1674. /* fmt_ok --- is the conversion format a valid one? */
  1675.  
  1676. NODE **fmt_list = NULL;
  1677. static int fmt_ok P((NODE *n));
  1678. static int fmt_index P((NODE *n));
  1679.  
  1680. static int
  1681. fmt_ok(n)
  1682. NODE *n;
  1683. {
  1684.     NODE *tmp = force_string(n);
  1685.     char *p = tmp->stptr;
  1686.  
  1687.     if (*p++ != '%')
  1688.         return 0;
  1689.     while (*p && strchr(" +-#", *p) != NULL)    /* flags */
  1690.         p++;
  1691.     while (*p && isdigit(*p))    /* width - %*.*g is NOT allowed */
  1692.         p++;
  1693.     if (*p == '\0' || (*p != '.' && ! isdigit(*p)))
  1694.         return 0;
  1695.     if (*p == '.')
  1696.         p++;
  1697.     while (*p && isdigit(*p))    /* precision */
  1698.         p++;
  1699.     if (*p == '\0' || strchr("efgEG", *p) == NULL)
  1700.         return 0;
  1701.     if (*++p != '\0')
  1702.         return 0;
  1703.     return 1;
  1704. }
  1705.  
  1706. /* fmt_index --- track values of OFMT and CONVFMT to keep semantics correct */
  1707.  
  1708. static int
  1709. fmt_index(n)
  1710. NODE *n;
  1711. {
  1712.     register int ix = 0;
  1713.     static int fmt_num = 4;
  1714.     static int fmt_hiwater = 0;
  1715.  
  1716.     if (fmt_list == NULL)
  1717.         emalloc(fmt_list, NODE **, fmt_num*sizeof(*fmt_list), "fmt_index");
  1718.     (void) force_string(n);
  1719.     while (ix < fmt_hiwater) {
  1720.         if (cmp_nodes(fmt_list[ix], n) == 0)
  1721.             return ix;
  1722.         ix++;
  1723.     }
  1724.     /* not found */
  1725.     n->stptr[n->stlen] = '\0';
  1726.     if (do_lint && ! fmt_ok(n))
  1727.         warning("bad %sFMT specification",
  1728.                 n == CONVFMT_node->var_value ? "CONV"
  1729.               : n == OFMT_node->var_value ? "O"
  1730.               : "");
  1731.  
  1732.     if (fmt_hiwater >= fmt_num) {
  1733.         fmt_num *= 2;
  1734.         emalloc(fmt_list, NODE **, fmt_num, "fmt_index");
  1735.     }
  1736.     fmt_list[fmt_hiwater] = dupnode(n);
  1737.     return fmt_hiwater++;
  1738. }
  1739.  
  1740. /* set_OFMT --- track OFMT correctly */
  1741.  
  1742. void
  1743. set_OFMT()
  1744. {
  1745.     OFMTidx = fmt_index(OFMT_node->var_value);
  1746.     OFMT = fmt_list[OFMTidx]->stptr;
  1747. }
  1748.  
  1749. /* set_CONVFMT --- track CONVFMT correctly */
  1750.  
  1751. void
  1752. set_CONVFMT()
  1753. {
  1754.     CONVFMTidx = fmt_index(CONVFMT_node->var_value);
  1755.     CONVFMT = fmt_list[CONVFMTidx]->stptr;
  1756. }
  1757.