home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 11 Util / 11-Util.zip / NGAWK1.ZIP / AWK.Y < prev    next >
Text File  |  1988-07-17  |  27KB  |  1,054 lines
  1.  
  2. /*
  3.  * gawk -- GNU version of awk
  4.  * Copyright (C) 1986 Free Software Foundation
  5.  *   Written by Paul Rubin, August 1986
  6.  *
  7.  *     Modified by Andrew D. Estes, July 1988
  8.  */
  9.  
  10. /*
  11. GAWK is distributed in the hope that it will be useful, but WITHOUT ANY
  12. WARRANTY.  No author or distributor accepts responsibility to anyone
  13. for the consequences of using it or for whether it serves any
  14. particular purpose or works at all, unless he says so in writing.
  15. Refer to the GAWK General Public License for full details.
  16.  
  17. Everyone is granted permission to copy, modify and redistribute GAWK,
  18. but only under the conditions described in the GAWK General Public
  19. License.  A copy of this license is supposed to have been given to you
  20. along with GAWK so you can know your rights and responsibilities.  It
  21. should be in a file named COPYING.  Among other things, the copyright
  22. notice and this notice must be preserved on all copies.
  23.  
  24. In other words, go ahead and share GAWK, but don't try to stop
  25. anyone else from sharing it farther.  Help stamp out software hoarding!
  26. */
  27.  
  28. %{
  29. #define YYDEBUG 12
  30.  
  31. #include <stdio.h>
  32. #include <string.h>
  33. #include "awk.h"
  34.  
  35.   static int yylex ();
  36.  
  37.  
  38.   /*
  39.    * The following variable is used for a very sickening thing.
  40.    * The awk language uses white space as the string concatenation
  41.    * operator, but having a white space token that would have to appear
  42.    * everywhere in all the grammar rules would be unbearable.
  43.    * It turns out we can return CONCAT_OP exactly when there really
  44.    * is one, just from knowing what kinds of other tokens it can appear
  45.    * between (namely, constants, variables, or close parentheses).
  46.    * This is because concatenation has the lowest priority of all
  47.    * operators.  want_concat_token is used to remember that something
  48.    * that could be the left side of a concat has just been returned.
  49.    *
  50.    * If anyone knows a cleaner way to do this (don't look at the Un*x
  51.    * code to find one, though), please suggest it.
  52.    */
  53.   static int want_concat_token;
  54.  
  55.   /* Two more horrible kludges.  The same comment applies to these two too */
  56.   static int want_regexp;    /* lexical scanning kludge */
  57.   static int want_redirect; /* similarly */
  58.   int lineno = 1;    /* JF for error msgs */
  59.  
  60.   /* Speaking of kludges.  We don't want to treat arguments as filenames
  61.   ** if there are no pattern action pairs to perform; sooo I am creating
  62.   ** a counter for patterns and actions. -ADE */
  63.   int patterns = 0;
  64.   int actions = 0;
  65. /* During parsing of a gawk program, the pointer to the next character
  66.    is in this variable.  */
  67.   char *lexptr;        /* JF moved it up here */
  68.   char *lexptr_begin;    /* JF for error msgs */
  69. %}
  70.  
  71. %union {
  72.   long lval;
  73.   AWKNUM fval;
  74.   NODE *nodeval;
  75.   NODETYPE nodetypeval;
  76.   char *sval;
  77.   NODE *(*ptrval)();
  78. }
  79.  
  80. %type <nodeval> expr start program rule pattern regex opt_argument_expr_list
  81. %type <nodeval> action redirection argument_expr_list iteration_statement
  82. %type <nodeval> statement if_statement output_statement expression_statement
  83. %type <nodeval> opt_exp compound_statement statement_list concat_expr
  84. %type <nodeval> primary_expr postfix_expr unary_expr arith_expr mult_expr
  85. %type <nodeval> cond_expr assign_expr primary_pattern and_expr or_expr
  86. %type <nodetypeval> whitespace
  87.  
  88. %token <sval> NAME REGEXP YSTRING
  89. %token <lval> ERROR INCDEC
  90. %token <fval> NUMBER
  91. %token <nodetypeval> ASSIGNOP RELOP MATCHOP NEWLINE REDIRECT_OP CONCAT_OP
  92. %token <nodetypeval> LEX_BEGIN LEX_END LEX_IF LEX_ELSE
  93. %token <nodetypeval> LEX_WHILE LEX_FOR LEX_BREAK LEX_CONTINUE
  94. %token <nodetypeval> LEX_GETLINE LEX_PRINT LEX_PRINTF LEX_NEXT LEX_EXIT
  95. %token  LEX_IN
  96. %token <lval> LEX_AND LEX_OR INCREMENT DECREMENT
  97. %token <ptrval> LEX_BUILTIN LEX_SUB
  98.  
  99. /* these are just yylval numbers */
  100. /* %token <lval> CHAR JF this isn't used anymore */
  101.  
  102. /* Lowest to highest */
  103. %left ','
  104. %left LEX_OR
  105. %left LEX_AND
  106. %right ASSIGNOP
  107. %left CONCAT_OP
  108. %left '+' '-'
  109. %left '*' '/'
  110. %left '%'
  111. %left '^'
  112. %right UNARY
  113. %nonassoc MATCHOP RELOP INCREMENT DECREMENT
  114.  
  115. %%
  116.  
  117. start
  118.     :    optional_newlines program
  119.             { expression_value = $2; }
  120.     ;
  121.  
  122.  
  123. program
  124.     :    rule
  125.             { $$ = node ($1, Node_rule_list,(NODE *) NULL); }
  126.     |    program rule
  127.             /* cons the rule onto the tail of list */
  128.             { $$ = append_right ($1, node($2, Node_rule_list,(NODE *) NULL)); }
  129.     ;
  130.  
  131. rule
  132.     :    pattern action NEWLINE optional_newlines
  133.             {
  134.             ++patterns;
  135.             ++actions;
  136.             $$ = node ($1, Node_rule_node, $2);
  137.             }
  138.     ;
  139.  
  140.  
  141. primary_pattern
  142.     :    /* EMPTY */
  143.             { $$ = NULL; }
  144.     |    LEX_BEGIN
  145.             {
  146.               --patterns;
  147.               --actions;
  148.               $$ = node ((NODE *)NULL, Node_K_BEGIN,(NODE *) NULL);
  149.             }
  150.     |    LEX_END
  151.             {  $$ = node ((NODE *)NULL, Node_K_END,(NODE *) NULL); }
  152.     |    expr
  153.             { $$ = $1; }
  154.     ;
  155.  
  156. pattern
  157.     :    primary_pattern
  158.             { $$ = $1; }
  159.     |    regex
  160.             { $$ = node (node (make_number((AWKNUM)0), Node_field_spec,
  161.                     (NODE *)NULL), Node_match, $1); }
  162.     |    '!' primary_pattern  %prec UNARY
  163.             { $$ = node ($2, Node_not,(NODE *) NULL); }
  164.     |    primary_pattern LEX_AND pattern
  165.             { $$ = node ($1, Node_and, $3); }
  166.     |    primary_pattern LEX_OR pattern
  167.             { $$ = node ($1, Node_or, $3); }
  168.     |    '(' pattern ')'
  169.             {
  170.               $$ = $2;
  171.               want_concat_token = 0;
  172.             }
  173.     |    pattern MATCHOP regex
  174.             { $$ = node($1, Node_match, $3); }
  175.     |    pattern MATCHOP primary_pattern
  176.             { $$ = node($1, Node_match, $3); }
  177.     |    pattern ',' pattern
  178.             { $$ = mkrangenode ( node($1, Node_cond_pair, $3) ); } /*jfw*/
  179.     ;
  180.  
  181.  
  182. action
  183.     :    /* empty */
  184.             { --actions; $$ = NULL; }
  185.     |    compound_statement
  186.             { $$ = $1; }
  187.     ;
  188.  
  189.  
  190. statement
  191.     :    compound_statement optional_newlines
  192.             { $$ = $1; }
  193.     |    expression_statement
  194.             { $$ = $1; }
  195.     |    if_statement
  196.             { $$ = $1; }
  197.     |    iteration_statement
  198.             { $$ = $1; }
  199.     |    output_statement
  200.             { $$ = $1; }
  201.     ;
  202.  
  203. compound_statement
  204.     :    '{' optional_newlines statement_list '}'
  205.             { $$ = node ($3, Node_statement_list, (NODE *)NULL); }
  206.     ;
  207.  
  208. statement_list
  209.     :    statement
  210.             { $$ = node ($1, Node_statement_list, (NODE *)NULL); }
  211.     |    statement_list statement
  212.             { $$ = append_right($1,
  213.                 node($2, Node_statement_list, (NODE *)NULL)); }
  214.     ;
  215.  
  216. expression_statement
  217.     :    ';' optional_newlines
  218.             { $$ = (NODE *)NULL; }
  219.     |    expr statement_term
  220.             { $$ = node ($1, Node_statement_list, (NODE *)NULL); }
  221.     ;
  222.  
  223.  
  224. if_statement
  225.     :    LEX_IF '(' expr ')' optional_newlines statement
  226.             { $$ = node ($3, Node_K_if,
  227.                 node ($6, Node_if_branches, (NODE *)NULL)); }
  228.     |    LEX_IF '(' expr ')' optional_newlines statement
  229.                 LEX_ELSE optional_newlines statement
  230.            { $$ = node ($3, Node_K_if,
  231.                 node ($6, Node_if_branches, $9)); }
  232.     ;
  233.  
  234.  
  235. iteration_statement
  236.     :    LEX_WHILE '(' expr ')'
  237.             { want_concat_token = 0; }
  238.             optional_newlines statement
  239.             { $$ = node ($3, Node_K_while, $7); }
  240.     |    LEX_FOR '(' opt_exp ';' expr ';' opt_exp ')'
  241.             { want_concat_token = 0; }
  242.             optional_newlines statement
  243.             { $$ = node ($11, Node_K_for, (NODE *)make_for_loop ($3, $5, $7)); }
  244.     |    LEX_FOR '(' opt_exp ';' ';' opt_exp ')'
  245.             { want_concat_token = 0; }
  246.             optional_newlines statement
  247.             { $$ = node ($10, Node_K_for,
  248.                 (NODE *)make_for_loop ($3, (NODE *)NULL, $6)); }
  249.     |    LEX_FOR '(' NAME CONCAT_OP LEX_IN NAME ')'
  250.             { want_concat_token = 0; }
  251.           optional_newlines statement
  252.             { $$ = node ($10, Node_K_arrayfor,
  253.                 (NODE *)make_for_loop(variable($3), (NODE *)NULL, variable($6))); }
  254.     |    LEX_BREAK statement_term
  255.        /* for break, maybe we'll have to remember where to break to */
  256.             { $$ = node ((NODE *)NULL, Node_K_break, (NODE *)NULL); }
  257.     |    LEX_CONTINUE statement_term
  258.             { $$ = node ((NODE *)NULL, Node_K_continue, (NODE *)NULL); }
  259.     |    LEX_NEXT statement_term
  260.             { $$ = node ((NODE *)NULL, Node_K_next, (NODE *)NULL); }
  261.     |    LEX_EXIT statement_term
  262.             { $$ = node ((NODE *)NULL, Node_K_exit, (NODE *)NULL); }
  263.     |    LEX_EXIT '(' expr ')' statement_term
  264.             { $$ = node ($3, Node_K_exit, (NODE *)NULL); }
  265.     ;
  266.  
  267.  
  268. output_statement
  269.     :    LEX_PRINT
  270.             { ++want_redirect; want_concat_token = 0; }
  271.         opt_argument_expr_list redirection statement_term
  272.             {
  273.               want_redirect = 0;
  274.               /* $4->lnode = NULL; */
  275.               $$ = node ($3, Node_K_print, $4);
  276.             }
  277.     |    LEX_PRINTF
  278.             { ++want_redirect; want_concat_token = 0}
  279.         opt_argument_expr_list redirection statement_term
  280.             {
  281.               want_redirect = 0;
  282.               /* $4->lnode = NULL; */
  283.               $$ = node ($3, Node_K_printf, $4);
  284.             }
  285.     |    LEX_PRINTF '(' argument_expr_list ')'
  286.             { ++want_redirect;
  287.             want_concat_token = 0; }
  288.         redirection statement_term
  289.             {
  290.               want_redirect = 0;
  291.               $$ = node ($3, Node_K_printf, $6);
  292.             }
  293.     ;
  294.  
  295.  
  296. optional_newlines
  297.     :    /* EMPTY */
  298.     |    optional_newlines NEWLINE
  299.             { $<nodetypeval>$ = Node_illegal; }
  300.     ;
  301.  
  302. statement_term
  303.     :    NEWLINE optional_newlines
  304.             { $<nodetypeval>$ = Node_illegal; }
  305.     |    ';' optional_newlines
  306.             { $<nodetypeval>$ = Node_illegal; }
  307.     ;
  308.  
  309. regex
  310.     :  '/'
  311.             { ++want_regexp; }
  312.         REGEXP '/'
  313.             {
  314.                 want_regexp = 0;
  315.                 $$ = make_regex($3);
  316.             }
  317.     ;
  318.  
  319. redirection
  320.     :    /* EMPTY */
  321.             { $$ = NULL; /* node (NULL, Node_redirect_nil, NULL); */ }
  322.     |    REDIRECT_OP expr
  323.             { $$ = node ($2, $1, (NODE *)NULL); }
  324.     ;
  325.  
  326.  
  327. /* optional expression, as in for loop */
  328. opt_exp
  329.     :    /* EMPTY */
  330.             { $$ = NULL; /* node(NULL, Node_builtin, NULL); */ }
  331.     |    expr
  332.             { $$ = $1; }
  333.     ;
  334.  
  335. opt_argument_expr_list
  336.     :    /* EMPTY */
  337.             { $$ = NULL; }
  338.     |    argument_expr_list
  339.             { $$ = $1; }
  340.     ;
  341.  
  342. primary_expr
  343.     :    NAME
  344.             { $$ = variable ($1); }
  345.     |    NUMBER
  346.             { $$ = make_number($1); }
  347.     |    YSTRING
  348.             { $$ = make_string ($1, -1); }
  349.     |    LEX_BUILTIN '(' opt_argument_expr_list ')'
  350.             { ++want_concat_token; $$ = snode ($3, Node_builtin, $1); }
  351.     |    LEX_BUILTIN
  352.             { ++want_concat_token; $$ = snode ((NODE *)NULL, Node_builtin, $1); }
  353.     |    LEX_SUB '(' regex ',' argument_expr_list ')'
  354.             { want_concat_token;
  355.             $$ = snode(node($3, Node_expression_list, $5), Node_builtin, $1); }
  356.     |    LEX_GETLINE
  357.             { ++want_redirect; }
  358.         opt_exp redirection
  359.             {
  360.                 want_redirect = 0;
  361.                 $$ = node($3, Node_K_getline, $4);
  362.             }
  363.     |    '(' expr ')'
  364.             { $$ = $2; }
  365.     ;
  366.  
  367. postfix_expr :
  368.         primary_expr
  369.             { $$ = $1; }
  370.     |    NAME '[' expr ']'
  371.             { $$ = node (variable($1), Node_subscript, $3); }
  372.     |    postfix_expr INCREMENT
  373.             { $$ = node ($1, Node_postincrement, (NODE *)NULL); }
  374.     |    postfix_expr DECREMENT
  375.             { $$ = node ($1, Node_postdecrement, (NODE *)NULL); }
  376.     ;
  377.  
  378. argument_expr_list
  379.     :    assign_expr
  380.             { $$ = node ($1, Node_expression_list, (NODE *)NULL); }
  381.     |    argument_expr_list ',' optional_newlines assign_expr
  382.             { $$ = append_right($1,
  383.                 node ($4, Node_expression_list, (NODE *)NULL)); }
  384.     ;
  385.  
  386. unary_expr
  387.     :    postfix_expr
  388.             { $$ = $1; }
  389.     |    INCREMENT unary_expr
  390.             { $$ = node ($2, Node_preincrement, (NODE *)NULL); }
  391.     |    DECREMENT unary_expr
  392.             { $$ = node ($2, Node_predecrement, (NODE *)NULL); }
  393.     |    '-' unary_expr     %prec UNARY
  394.             { $$ = node ($2, Node_unary_minus, (NODE *)NULL); }
  395.     |    '$' unary_expr     %prec UNARY
  396.             { $$ = node ($2, Node_field_spec, (NODE *)NULL); }
  397.     ;
  398.  
  399. mult_expr
  400.     :    unary_expr
  401.             { $$ = $1; }
  402.     |    unary_expr '^' mult_expr
  403.             { $$ = node ($1, Node_pow, $3); }
  404.     |    unary_expr '%' mult_expr
  405.             { $$ = node ($1, Node_mod, $3); }
  406.     |    unary_expr '*' mult_expr
  407.             { $$ = node ($1, Node_times, $3); }
  408.     |    unary_expr '/' mult_expr
  409.             { $$ = node ($1, Node_quotient, $3); }
  410.     ;
  411.  
  412. arith_expr
  413.     :    mult_expr
  414.             { $$ = $1; }
  415.     |    mult_expr '+' arith_expr
  416.             { $$ = node ($1, Node_plus, $3); }
  417.     |    mult_expr '-' arith_expr
  418.             { $$ = node ($1, Node_minus, $3); }
  419.     ;
  420.  
  421. concat_expr
  422.     :    arith_expr
  423.             { $$ = $1; }
  424.     |    arith_expr CONCAT_OP concat_expr
  425.             { $$ = node($1, Node_concat, $3); }
  426.     |    arith_expr RELOP concat_expr
  427.             { $$ = node($1, $2, $3); }
  428.     ;
  429.  
  430. and_expr
  431.     :    concat_expr
  432.             { $$ = $1; }
  433.     |    concat_expr LEX_AND concat_expr
  434.             { $$ = node ($1, Node_and, $3); }
  435.     ;
  436.  
  437. or_expr
  438.     :    and_expr
  439.             { $$ = $1; }
  440.     |    and_expr LEX_OR and_expr
  441.             { $$ = node ($1, Node_or, $3); }
  442.     ;
  443.  
  444. cond_expr
  445.     :    or_expr
  446.             { $$ = $1; }
  447.     |    or_expr '?' or_expr ':' or_expr
  448.             { $$ = node ($1, Node_cond_exp, node($3, Node_illegal, $5)); }
  449.     ;
  450.  
  451. assign_expr
  452.     :    cond_expr
  453.             { $$ = $1; }
  454.     |    concat_expr ASSIGNOP assign_expr
  455.             { $$ = node ($1, $2, $3); }
  456.     ;
  457.  
  458. expr
  459.     :  assign_expr
  460.             { $$ = $1; }
  461.     ;
  462.  
  463. whitespace
  464.     :    /* EMPTY */
  465.             { $$ = Node_illegal; }
  466.     |    CONCAT_OP
  467.     |    NEWLINE
  468.     |    whitespace CONCAT_OP
  469.     |    whitespace NEWLINE
  470.     ;
  471.  
  472. %%
  473.  
  474.  
  475. struct token {
  476.   char *operator;
  477.   NODETYPE value;
  478.   int class;
  479.   NODE *(*ptr)();
  480. };
  481.  
  482. #ifndef NULL
  483.  
  484. #define NULL 0
  485.  
  486. #endif
  487.  
  488. NODE    *do_atan2(),*do_close(), *do_cos(), *do_exp(),    *do_getline(),
  489.     *do_gsub(), *do_index(), *do_length(), *do_log(), *do_match(),
  490.     *do_rand(), *do_sin(), *do_sqrt(),
  491.     *do_srand(), *do_sprintf(), *do_sub(), *do_substr(),  *do_system(),
  492.     *do_split(), *do_int();
  493.  
  494.     /* Special functions for debugging */
  495. #ifndef FAST
  496. NODE    *do_prvars(),    *do_bp();
  497. #endif
  498.  
  499. /* Tokentab is sorted ascii ascending order, so it can be binary searched. */
  500. /* (later.  Right now its just sort of linear search (SLOW!!) */
  501.  
  502. #define END(s) (s-1 + sizeof(s)/sizeof(s[0]))
  503.  
  504. static struct token tokentab[] = {
  505.   {"BEGIN",    Node_illegal,        LEX_BEGIN,    0},
  506.   {"END",    Node_illegal,        LEX_END,    0},
  507.   {"atan2", Node_builtin,        LEX_BUILTIN,    do_atan2},
  508. #ifndef FAST
  509.   {"bp",    Node_builtin,        LEX_BUILTIN,    do_bp},
  510. #endif
  511.   {"break", Node_K_break,        LEX_BREAK,    0},
  512.   {"close", Node_builtin,        LEX_BUILTIN, do_close},
  513.   {"continue",    Node_K_continue,    LEX_CONTINUE,    0},
  514.   {"cos",    Node_builtin,        LEX_BUILTIN,    do_cos},
  515.   {"else",    Node_illegal,        LEX_ELSE,    0},
  516.   {"exit",    Node_K_exit,        LEX_EXIT,    0},
  517.   {"exp",    Node_builtin,        LEX_BUILTIN,    do_exp},
  518.   {"for",    Node_K_for,        LEX_FOR,    0},
  519.   {"getline",    Node_K_getline,   LEX_GETLINE,      do_getline},
  520.   {"gsub",    Node_builtin,        LEX_SUB,    do_gsub},
  521.   {"if",    Node_K_if,        LEX_IF,        0},
  522.   {"in",    Node_illegal,        LEX_IN,     0},
  523.   {"index",    Node_builtin,        LEX_BUILTIN,    do_index},
  524.   {"int",    Node_builtin,        LEX_BUILTIN,    do_int},
  525.   {"length",    Node_builtin,        LEX_BUILTIN,    do_length},
  526.   {"log",    Node_builtin,        LEX_BUILTIN,    do_log},
  527.   {"match", Node_builtin,        LEX_BUILTIN,    do_match},
  528.   {"next",    Node_K_next,        LEX_NEXT,    0},
  529.   {"print",    Node_K_print,        LEX_PRINT,    0},
  530.   {"printf",    Node_K_printf,        LEX_PRINTF,    0},
  531. #ifndef FAST
  532.   {"prvars",    Node_builtin,        LEX_BUILTIN,    do_prvars},
  533. #endif
  534.   {"rand", Node_builtin,        LEX_BUILTIN,    do_rand},
  535.   {"sin", Node_builtin,         LEX_BUILTIN,    do_sin},
  536.   {"split",    Node_builtin,        LEX_BUILTIN,    do_split},
  537.   {"sprintf",    Node_builtin,        LEX_BUILTIN,    do_sprintf},
  538.   {"srand", Node_builtin,        LEX_BUILTIN,    do_srand},
  539.   {"sqrt",    Node_builtin,        LEX_BUILTIN,    do_sqrt},
  540.   {"sub",    Node_builtin,        LEX_SUB,    do_sub},
  541.   {"substr",    Node_builtin,        LEX_BUILTIN,    do_substr},
  542.   {"system",    Node_builtin,    LEX_BUILTIN,    do_system},
  543.   {"while",    Node_K_while,        LEX_WHILE,    0},
  544.   {NULL,    Node_illegal,        ERROR,        0}
  545. };
  546.  
  547. /* Read one token, getting characters through lexptr.  */
  548.  
  549. static int
  550. yylex ()
  551. {
  552.   register int c;
  553.   register int namelen;
  554.   register char *tokstart;
  555.   register struct token *toktab, *low, *high, *mid;
  556.   int dif;
  557.   double atof();    /* JF know what happens if you forget this? */
  558.  
  559.   static did_newline = 0; /* JF the grammar insists that actions end
  560.             with newlines. This was easier than hacking
  561.             the grammar. */
  562.   int do_concat;
  563.  
  564.   int    seen_e = 0;        /* These are for numbers */
  565.   int    seen_point = 0;
  566.  
  567.   retry:
  568.  
  569.   if(!lexptr)
  570.     return 0;
  571.  
  572.   if (want_regexp) {
  573.     want_regexp = 0;
  574.     /* there is a potential bug if a regexp is followed by an equal sign:
  575.        "/foo/=bar" would result in assign_quotient being returned as the
  576.        next token.  Nothing is done about it since it is not valid awk,
  577.        but maybe something should be done anyway. */
  578.  
  579.     tokstart = lexptr;
  580.     while (c = *lexptr++) {
  581.       switch (c) {
  582.       case '\\':
  583.     if (*lexptr++ == '\0') {
  584.       yyerror ("unterminated regexp ends with \\");
  585.       return ERROR;
  586.     }
  587.     break;
  588.       case '/':            /* end of the regexp */
  589.     lexptr--;
  590.     yylval.sval = tokstart;
  591.     return REGEXP;
  592.       case '\n':
  593.       case '\0':
  594.     yyerror ("unterminated regexp");
  595.     return ERROR;
  596.       }
  597.     }
  598.   }
  599.   do_concat=want_concat_token;
  600.   want_concat_token=0;
  601.  
  602.   if(*lexptr=='\0') {
  603.     lexptr=0;
  604.     return NEWLINE;
  605.   }
  606.  
  607.   /* if lexptr is at white space between two terminal tokens or parens,
  608.      it is a concatenation operator. */
  609.   if(do_concat && (*lexptr==' ' || *lexptr=='\t')) {
  610.     while (*lexptr == ' ' || *lexptr == '\t')
  611.       lexptr++;
  612.     if (isalnum(*lexptr) || *lexptr == '\"' || *lexptr == '('
  613.         || *lexptr == '.' || *lexptr == '$') /* the '.' is for decimal pt */
  614.       return CONCAT_OP;
  615.   }
  616.  
  617.   while (*lexptr == ' ' || *lexptr == '\t')
  618.     lexptr++;
  619.  
  620.   tokstart = lexptr;    /* JF */
  621.  
  622.   switch (c = *lexptr++) {
  623.   case 0:
  624.     return 0;
  625.  
  626.   case '\n':
  627.     lineno++;
  628.     return NEWLINE;
  629.  
  630.   case '#':            /* it's a comment */
  631.     while (*lexptr != '\n' && *lexptr != '\0')
  632.       lexptr++;
  633.     goto retry;
  634.  
  635.   case '\\':
  636.     if(*lexptr=='\n') {
  637.       lexptr++;
  638.       goto retry;
  639.     } else break;
  640.   case ')':
  641.   case ']':
  642.     ++want_concat_token;
  643.     /* fall through */
  644.   case '(':    /* JF these were above, but I don't see why they should turn on concat. . . &*/
  645.   case '[':
  646.  
  647.   case '{':
  648.   case ',':        /* JF */
  649.   case '$':
  650.   case ';':
  651.   case ':':
  652.   case '?':
  653.     /* set node type to ILLEGAL because the action should set it to
  654.        the right thing */
  655.     yylval.nodetypeval = Node_illegal;
  656.     return c;
  657.  
  658.   case '^':
  659.     if (*lexptr=='=') {
  660.       yylval.nodetypeval=Node_assign_pow;
  661.       lexptr++;
  662.       return ASSIGNOP;
  663.     }
  664.     yylval.nodetypeval=Node_illegal;
  665.     return c;
  666.  
  667.   case '*':
  668.     if(*lexptr=='=') {
  669.       yylval.nodetypeval=Node_assign_times;
  670.       lexptr++;
  671.       return ASSIGNOP;
  672.     }
  673.     yylval.nodetypeval=Node_illegal;
  674.     return c;
  675.  
  676.   case '/':
  677.     if(*lexptr=='=') {
  678.       yylval.nodetypeval=Node_assign_quotient;
  679.       lexptr++;
  680.       return ASSIGNOP;
  681.     }
  682.     yylval.nodetypeval=Node_illegal;
  683.     return c;
  684.  
  685.   case '%':
  686.     if(*lexptr=='=') {
  687.       yylval.nodetypeval=Node_assign_mod;
  688.       lexptr++;
  689.       return ASSIGNOP;
  690.     }
  691.     yylval.nodetypeval=Node_illegal;
  692.     return c;
  693.  
  694.   case '+':
  695.     if(*lexptr=='=') {
  696.       yylval.nodetypeval=Node_assign_plus;
  697.       lexptr++;
  698.       return ASSIGNOP;
  699.     }
  700.     if(*lexptr=='+') {
  701.       yylval.nodetypeval=Node_illegal;
  702.       lexptr++;
  703.       return INCREMENT;
  704.     }
  705.     yylval.nodetypeval=Node_illegal;
  706.     return c;
  707.  
  708.   case '!':
  709.     if(*lexptr=='=') {
  710.       yylval.nodetypeval=Node_notequal;
  711.       lexptr++;
  712.       return RELOP;
  713.     }
  714.     if(*lexptr=='~') {
  715.       yylval.nodetypeval=Node_nomatch;
  716.       lexptr++;
  717.       return MATCHOP;
  718.     }
  719.     yylval.nodetypeval=Node_illegal;
  720.     return c;
  721.  
  722.   case '<':
  723.     if (want_redirect) {
  724.         yylval.nodetypeval = Node_redirect_input;
  725.         return REDIRECT_OP;
  726.         }
  727.     if(*lexptr=='=') {
  728.       yylval.nodetypeval=Node_leq;
  729.       lexptr++;
  730.       return RELOP;
  731.     }
  732.     yylval.nodetypeval=Node_less;
  733.     return RELOP;
  734.  
  735.   case '=':
  736.     if(*lexptr=='=') {
  737.       yylval.nodetypeval=Node_equal;
  738.       lexptr++;
  739.       return RELOP;
  740.     }
  741.     yylval.nodetypeval=Node_assign;
  742.     return ASSIGNOP;
  743.  
  744.   case '>':
  745.     if(want_redirect) {
  746.       if (*lexptr == '>') {
  747.     yylval.nodetypeval = Node_redirect_append;
  748.     lexptr++;
  749.       } else
  750.         yylval.nodetypeval = Node_redirect_output;
  751.       return REDIRECT_OP;
  752.     }
  753.     if(*lexptr=='=') {
  754.       yylval.nodetypeval=Node_geq;
  755.       lexptr++;
  756.       return RELOP;
  757.     }
  758.     yylval.nodetypeval=Node_greater;
  759.     return RELOP;
  760.  
  761.   case '~':
  762.     yylval.nodetypeval=Node_match;
  763.     return MATCHOP;
  764.  
  765.   case '}':
  766.     if (did_newline)
  767.         {
  768.         did_newline = 0;
  769.         return c;
  770.         }
  771.     did_newline++;
  772.     --lexptr;
  773.     return NEWLINE;
  774.  
  775.   case '"':
  776.     while (*lexptr != '\0') {
  777.       switch (*lexptr++) {
  778.           case '\\':
  779.             if (*lexptr++ != '\0')
  780.               break;
  781.         /* fall through */
  782.           case '\n':
  783.             yyerror ("unterminated string");
  784.             return ERROR;
  785.           case '\"':
  786.             yylval.sval = tokstart + 1; /* JF Skip the doublequote */
  787.             ++want_concat_token;
  788.             return YSTRING;
  789.       }
  790.     }
  791.     return ERROR;    /* JF this was one level up, wrong? */
  792.  
  793.   case '-':
  794.     if(*lexptr=='=') {
  795.       yylval.nodetypeval=Node_assign_minus;
  796.       lexptr++;
  797.       return ASSIGNOP;
  798.     }
  799.     if(*lexptr=='-') {
  800.       yylval.nodetypeval=Node_illegal;
  801.       lexptr++;
  802.       return DECREMENT;
  803.     }
  804.     /* JF I think space tab comma and newline are the legal places for
  805.        a UMINUS.  Have I missed any? */
  806.     if((!isdigit(*lexptr) && *lexptr!='.') || (lexptr>lexptr_begin+1 &&
  807.  !index(" \t,\n",lexptr[-2]))) {
  808.     /* set node type to ILLEGAL because the action should set it to
  809.        the right thing */
  810.       yylval.nodetypeval = Node_illegal;
  811.       return c;
  812.     }
  813.       /* FALL through into number code */
  814.   case '0':
  815.   case '1':
  816.   case '2':
  817.   case '3':
  818.   case '4':
  819.   case '5':
  820.   case '6':
  821.   case '7':
  822.   case '8':
  823.   case '9':
  824.   case '.':
  825.     /* It's a number */
  826.     if(c=='-') namelen=1;
  827.     else namelen=0;
  828.     for (; (c = tokstart[namelen]) != '\0'; namelen++) {
  829.       switch (c) {
  830.       case '.':
  831.     if (seen_point)
  832.       goto got_number;
  833.     ++seen_point;
  834.     break;
  835.       case 'e':
  836.       case 'E':
  837.     if (seen_e)
  838.       goto got_number;
  839.     ++seen_e;
  840.     if (tokstart[namelen+1] == '-' || tokstart[namelen+1] == '+')
  841.       namelen++;
  842.     break;
  843.       case '0': case '1': case '2': case '3': case '4':
  844.       case '5': case '6': case '7': case '8': case '9':
  845.     break;
  846.       default:
  847.     goto got_number;
  848.       }
  849.     }
  850.  
  851. /*
  852. ** There seems to be a bug (feature?) in the Microsoft Large Model
  853. ** atof function.  If the string to convert is too long, atof returns a
  854. ** zero without bothering to scan the string.  The following hack simply
  855. ** truncates tokstart for the duration of the call. -ADE-
  856. **/
  857.  
  858. got_number:
  859.     lexptr = tokstart + namelen;
  860.     *lexptr = '\0';
  861.     yylval.fval = atof(tokstart);
  862.     *lexptr = c;
  863.     ++want_concat_token;
  864.     return NUMBER;
  865.  
  866.   case '&':
  867.     if(*lexptr=='&') {
  868.       yylval.nodetypeval=Node_and;
  869.       lexptr++;
  870.       return LEX_AND;
  871.     }
  872.     return ERROR;
  873.  
  874.   case '|':
  875.     if(want_redirect) {
  876.       lexptr++;
  877.       yylval.nodetypeval = Node_redirect_pipe;
  878.       return REDIRECT_OP;
  879.     }
  880.     if(*lexptr=='|') {
  881.       yylval.nodetypeval=Node_or;
  882.       lexptr++;
  883.       return LEX_OR;
  884.     }
  885.     return ERROR;
  886.   }
  887.  
  888.   if (!(is_identchar(c))) {
  889.     yyerror ("Invalid char '%c' in expression\n", c);
  890.     return ERROR;
  891.   }
  892.  
  893.   /* its some type of name-type-thing.  Find its length */
  894.   for (namelen = 0; is_identchar(tokstart[namelen]); namelen++)
  895.     ;
  896.  
  897.  
  898.   /* See if it is a special token.    */
  899.  
  900.   low = tokentab;
  901.   high = END(tokentab);
  902.   while (low <= high)
  903.     {
  904.     mid = low + (high-low)/2;
  905.     if(!(dif = strncmp(tokstart,mid->operator,namelen)) &&
  906.        *tokstart==mid->operator[0] && mid->operator[namelen]=='\0')
  907.       {
  908.       lexptr=tokstart+namelen;
  909.       if(mid->class == LEX_BUILTIN || mid->class == LEX_SUB)
  910.         yylval.ptrval = mid->ptr;
  911.       else
  912.         yylval.nodetypeval = mid->value;
  913.       return mid->class;
  914.       }
  915.     else if (dif > 0)
  916.       low = mid+1;
  917.     else
  918.       high = mid-1;
  919.     }
  920.  
  921. /*    for (toktab = tokentab; toktab->operator != NULL; toktab++) {
  922. **      if(*tokstart==toktab->operator[0] &&
  923. **         !strncmp(tokstart,toktab->operator,namelen) &&
  924. **         toktab->operator[namelen]=='\0') {
  925. **        lexptr=tokstart+namelen;
  926. **        if(toktab->class == LEX_BUILTIN || toktab->class == LEX_SUB)
  927. **          yylval.ptrval = toktab->ptr;
  928. **        else
  929. **          lexptr=tokstart+namelen;
  930. **        if(toktab->class == LEX_BUILTIN || toktab->class == LEX_SUB)
  931. **          yylval.ptrval = toktab->ptr;
  932. **        else
  933. **          yylval.nodetypeval = toktab->value;
  934. **        return toktab->class;
  935. **      }
  936. **    }
  937. /*
  938.   /* It's a name.  See how long it is.  */
  939.   yylval.sval = tokstart;
  940.   lexptr = tokstart+namelen;
  941.   ++want_concat_token;
  942.   return NAME;
  943. }
  944.  
  945. /*VARARGS1*/
  946. void
  947. yyerror (mesg,a1,a2,a3,a4,a5,a6,a7,a8)
  948.      char *mesg;
  949. {
  950.   register char *ptr,*beg;
  951.  
  952.     /* Find the current line in the input file */
  953.   if(!lexptr) {
  954.     beg="(END OF FILE)";
  955.     ptr=beg+13;
  956.   } else {
  957.     if (*lexptr == '\n' && lexptr!=lexptr_begin)
  958.       --lexptr;
  959.     for (beg = lexptr;beg!=lexptr_begin && *beg != '\n';--beg)
  960.       ;
  961.     for (ptr = lexptr;*ptr && *ptr != '\n';ptr++) /*jfw: NL isn't guaranteed*/
  962.       ;
  963.     if(beg!=lexptr_begin)
  964.       beg++;
  965.   }
  966.   fprintf (stderr, "Error near line %d,  '%.*s'\n",lineno, ptr-beg, beg);
  967.   /* figure out line number, etc. later */
  968.   fprintf (stderr, mesg, a1, a2, a3, a4, a5, a6, a7, a8);
  969.   fprintf (stderr,"\n");
  970.   exit (1);
  971. }
  972.  
  973. /* Parse a C escape sequence.  STRING_PTR points to a variable
  974.    containing a pointer to the string to parse.  That pointer
  975.    is updated past the characters we use.  The value of the
  976.    escape sequence is returned.
  977.  
  978.    A negative value means the sequence \ newline was seen,
  979.    which is supposed to be equivalent to nothing at all.
  980.  
  981.    If \ is followed by a null character, we return a negative
  982.    value and leave the string pointer pointing at the null character.
  983.  
  984.    If \ is followed by 000, we return 0 and leave the string pointer
  985.    after the zeros.  A value of 0 does not mean end of string.  */
  986.  
  987. static int
  988. parse_escape (string_ptr)
  989.      char **string_ptr;
  990. {
  991.   register int c = *(*string_ptr)++;
  992.   switch (c)
  993.     {
  994.     case 'a':
  995.       return '\a';
  996.     case 'b':
  997.       return '\b';
  998.     case 'e':
  999.       return 033;
  1000.     case 'f':
  1001.       return '\f';
  1002.     case 'n':
  1003.       return '\n';
  1004.     case 'r':
  1005.       return '\r';
  1006.     case 't':
  1007.       return '\t';
  1008.     case 'v':
  1009.       return '\v';
  1010.     case '\n':
  1011.       return -2;
  1012.     case 0:
  1013.       (*string_ptr)--;
  1014.       return 0;
  1015.     case '^':
  1016.       c = *(*string_ptr)++;
  1017.       if (c == '\\')
  1018.     c = parse_escape (string_ptr);
  1019.       if (c == '?')
  1020.     return 0177;
  1021.       return (c & 0200) | (c & 037);
  1022.  
  1023.     case '0':
  1024.     case '1':
  1025.     case '2':
  1026.     case '3':
  1027.     case '4':
  1028.     case '5':
  1029.     case '6':
  1030.     case '7':
  1031.       {
  1032.     register int i = c - '0';
  1033.     register int count = 0;
  1034.     while (++count < 3)
  1035.       {
  1036.         if ((c = *(*string_ptr)++) >= '0' && c <= '7')
  1037.           {
  1038.         i *= 8;
  1039.         i += c - '0';
  1040.           }
  1041.         else
  1042.           {
  1043.         (*string_ptr)--;
  1044.         break;
  1045.           }
  1046.       }
  1047.     return i;
  1048.       }
  1049.     default:
  1050.       return c;
  1051.     }
  1052. }
  1053. 
  1054.