home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / m / mawk11as.zip / PARSE.Y < prev    next >
Text File  |  1992-01-08  |  35KB  |  1,264 lines
  1.  
  2. /********************************************
  3. parse.y
  4. copyright 1991, Michael D. Brennan
  5.  
  6. This is a source file for mawk, an implementation of
  7. the AWK programming language.
  8.  
  9. Mawk is distributed without warranty under the terms of
  10. the GNU General Public License, version 2, 1991.
  11. ********************************************/
  12.  
  13. /* $Log:    parse.y,v $
  14.  * Revision 5.2  92/01/08  16:11:42  brennan
  15.  * code FE_PUSHA carefully for MSDOS large mode
  16.  * 
  17.  * Revision 5.1  91/12/05  07:50:22  brennan
  18.  * 1.1 pre-release
  19.  * 
  20. */
  21.  
  22.  
  23. %{
  24. #include <stdio.h>
  25. #include "mawk.h"
  26. #include "code.h"
  27. #include "symtype.h"
  28. #include "memory.h"
  29. #include "bi_funct.h"
  30. #include "bi_vars.h"
  31. #include "jmp.h"
  32. #include "field.h"
  33. #include "files.h"
  34.  
  35. #ifdef  YYXBYACC
  36. #define YYBYACC        1
  37. #endif
  38.  
  39. #define  YYMAXDEPTH    200
  40.  
  41. /* Bison's use of MSDOS and ours clashes */
  42. #undef   MSDOS
  43.  
  44. extern void  PROTO( eat_nl, (void) ) ;
  45. static void  PROTO( resize_fblock, (FBLOCK *, INST *) ) ;
  46. static void  PROTO( code_array, (SYMTAB *) ) ;
  47. static void  PROTO( code_call_id, (CA_REC *, SYMTAB *) ) ;
  48. static void  PROTO( field_A2I, (void)) ;
  49. static int   PROTO( current_offset, (void) ) ;
  50. static void  PROTO( check_var, (SYMTAB *) ) ;
  51. static void  PROTO( check_array, (SYMTAB *) ) ;
  52. static void  PROTO( RE_as_arg, (void)) ;
  53.  
  54. static int scope ;
  55. static FBLOCK *active_funct ;
  56.       /* when scope is SCOPE_FUNCT  */
  57.  
  58. #define  code_address(x)  if( is_local(x) )\
  59.                           { code1(L_PUSHA) ; code1((x)->offset) ; }\
  60.                           else  code2(_PUSHA, (x)->stval.cp) 
  61.  
  62. /* this nonsense caters to MSDOS large model */
  63. #define  CODE_FE_PUSHA()  code_ptr->ptr = (PTR) 0 ; code1(FE_PUSHA)
  64.  
  65. %}
  66.  
  67. %union{
  68. CELL *cp ;
  69. SYMTAB *stp ;
  70. INST  *start ; /* code starting address */
  71. PF_CP  fp ;  /* ptr to a (print/printf) or (sub/gsub) function */
  72. BI_REC *bip ; /* ptr to info about a builtin */
  73. FBLOCK  *fbp  ; /* ptr to a function block */
  74. ARG2_REC *arg2p ;
  75. CA_REC   *ca_p  ;
  76. int   ival ;
  77. PTR   ptr ;
  78. }
  79.  
  80. /*  two tokens to help with errors */
  81. %token   UNEXPECTED   /* unexpected character */
  82. %token   BAD_DECIMAL
  83.  
  84. %token   NL
  85. %token   SEMI_COLON
  86. %token   LBRACE  RBRACE
  87. %token   LBOX     RBOX
  88. %token   COMMA
  89. %token   <ival> IO_OUT    /* > or output pipe */
  90.  
  91. %right  ASSIGN  ADD_ASG SUB_ASG MUL_ASG DIV_ASG MOD_ASG POW_ASG
  92. %right  QMARK COLON
  93. %left   OR
  94. %left   AND
  95. %left   IN
  96. %left   <ival> MATCH   /* ~  or !~ */
  97. %left   EQ  NEQ  LT LTE  GT  GTE
  98. %left   CAT
  99. %left   GETLINE
  100. %left   PLUS      MINUS  
  101. %left   MUL      DIV    MOD
  102. %left   NOT   UMINUS
  103. %nonassoc   IO_IN PIPE
  104. %right  POW
  105. %left   <ival>   INC_or_DEC
  106. %left   DOLLAR    FIELD  /* last to remove a SR conflict
  107.                                 with getline */
  108. %right  LPAREN   RPAREN     /* removes some SR conflicts */
  109.  
  110. %token  <ptr> DOUBLE STRING_ RE  
  111. %token  <stp> ID   D_ID
  112. %token  <fbp> FUNCT_ID
  113. %token  <bip> BUILTIN 
  114. %token   <cp>  FIELD 
  115.  
  116. %token  PRINT PRINTF SPLIT MATCH_FUNC SUB GSUB 
  117. /* keywords */
  118. %token  DO WHILE FOR BREAK CONTINUE IF ELSE  IN
  119. %token  DELETE  BEGIN  END  EXIT NEXT RETURN  FUNCTION
  120.  
  121. %type <start>  block  block_or_separator
  122. %type <start>  statement_list statement mark
  123. %type <ival>   pr_args
  124. %type <arg2p>  arg2  
  125. %type <start>  builtin  
  126. %type <start>  getline_file
  127. %type <start>  lvalue field  fvalue
  128. %type <start>  expr cat_expr p_expr
  129. %type <start>  while_front  if_front 
  130. %type <start>  for1 for2
  131. %type <start>  array_loop_front
  132. %type <start>  return_statement
  133. %type <start>  split_front  re_arg sub_back
  134. %type <ival>   arglist args 
  135. %type <fp>     print   sub_or_gsub
  136. %type <fbp>    funct_start funct_head
  137. %type <ca_p>   call_args ca_front ca_back
  138. %type <ival>   f_arglist f_args
  139.  
  140. %%
  141. /*  productions  */
  142.  
  143. program :       program_block
  144.         |       program  program_block 
  145.         ;
  146.  
  147. program_block :  PA_block   /* pattern-action */
  148.               |  function_def
  149.               |  error block
  150.                  { if (scope == SCOPE_FUNCT)
  151.                    { restore_ids() ; scope = SCOPE_MAIN ; }
  152.                    code_ptr = main_code_ptr ;
  153.                  }
  154.               ;
  155.  
  156. PA_block  :  block 
  157.              { /* this do nothing action removes a vacuous warning
  158.                   from Bison */
  159.              }
  160.  
  161.           |  BEGIN  
  162.                 { 
  163.           be_expand(&begin_code) ;
  164.                   scope = SCOPE_BEGIN ;
  165.                 }
  166.  
  167.              block
  168.                 { be_shrink(&begin_code) ;
  169.                   scope = SCOPE_MAIN ;
  170.                 }
  171.  
  172.           |  END    
  173.                 { 
  174.           be_expand(&end_code) ;
  175.                   scope = SCOPE_END ;
  176.                 }
  177.  
  178.              block
  179.                 { be_shrink(&end_code) ;
  180.                   scope = SCOPE_MAIN ;
  181.                 }
  182.  
  183.           |  expr  /* this works just like an if statement */
  184.              { code_jmp(_JZ, (INST*)0) ; }
  185.  
  186.              block_or_separator
  187.              { patch_jmp( code_ptr ) ; }
  188.  
  189.     /* range pattern, see comment in execute.c near _RANGE */
  190.           |  expr COMMA 
  191.              { code_push($1, code_ptr - $1) ;
  192.                code_ptr = $1 ;
  193.                code1(_RANGE) ; code1(1) ;
  194.                code_ptr += 3 ;
  195.                code_ptr += code_pop(code_ptr) ;
  196.                code1(_STOP) ;
  197.                $1[2].op = code_ptr - ($1+1) ;
  198.              }
  199.              expr
  200.              { code1(_STOP) ; }
  201.  
  202.              block_or_separator
  203.              { $1[3].op = $6 - ($1+1) ;
  204.                $1[4].op = code_ptr - ($1+1) ;
  205.              }
  206.           ;
  207.  
  208.  
  209.  
  210. block   :  LBRACE   statement_list  RBRACE
  211.             { $$ = $2 ; }
  212.         |  LBRACE   error  RBRACE 
  213.             { $$ = code_ptr ; /* does nothing won't be executed */
  214.               print_flag = getline_flag = paren_cnt = 0 ;
  215.               yyerrok ; }
  216.         ;
  217.  
  218. block_or_separator  :  block
  219.                   |  separator     /* default print action */
  220.                      { $$ = code_ptr ;
  221.                        code1(_PUSHINT) ; code1(0) ;
  222.                        code2(_PRINT, bi_print) ;
  223.                      }
  224.  
  225. statement_list :  statement
  226.         |  statement_list   statement
  227.         ;
  228.  
  229.  
  230. statement :  block
  231.           |  expr   separator
  232.              { code1(_POP) ; }
  233.           |  /* empty */  separator
  234.              { $$ = code_ptr ; }
  235.           |  error  separator
  236.               { $$ = code_ptr ;
  237.                 print_flag = getline_flag = 0 ;
  238.                 paren_cnt = 0 ;
  239.                 yyerrok ;
  240.               }
  241.           |  BREAK  separator
  242.              { $$ = code_ptr ; BC_insert('B', code_ptr+1) ;
  243.                code2(_JMP, 0) /* don't use code_jmp ! */ ; }
  244.           |  CONTINUE  separator
  245.              { $$ = code_ptr ; BC_insert('C', code_ptr+1) ;
  246.                code2(_JMP, 0) ; }
  247.           |  return_statement
  248.              { if ( scope != SCOPE_FUNCT )
  249.                      compile_error("return outside function body") ;
  250.              }
  251.           |  NEXT  separator
  252.               { if ( scope != SCOPE_MAIN )
  253.                    compile_error( "improper use of next" ) ;
  254.                 $$ = code_ptr ; 
  255.                 code1(_NEXT) ;
  256.               }
  257.           ;
  258.  
  259. separator  :  NL | SEMI_COLON
  260.            ;
  261.  
  262. expr  :   cat_expr
  263.       |   lvalue   ASSIGN   expr { code1(_ASSIGN) ; }
  264.       |   lvalue   ADD_ASG  expr { code1(_ADD_ASG) ; }
  265.       |   lvalue   SUB_ASG  expr { code1(_SUB_ASG) ; }
  266.       |   lvalue   MUL_ASG  expr { code1(_MUL_ASG) ; }
  267.       |   lvalue   DIV_ASG  expr { code1(_DIV_ASG) ; }
  268.       |   lvalue   MOD_ASG  expr { code1(_MOD_ASG) ; }
  269.       |   lvalue   POW_ASG  expr { code1(_POW_ASG) ; }
  270.       |   expr EQ expr  { code1(_EQ) ; }
  271.       |   expr NEQ expr { code1(_NEQ) ; }
  272.       |   expr LT expr { code1(_LT) ; }
  273.       |   expr LTE expr { code1(_LTE) ; }
  274.       |   expr GT expr { code1(_GT) ; }
  275.       |   expr GTE expr { code1(_GTE) ; }
  276.  
  277.       |   expr MATCH expr
  278.           {
  279.             if ( $3 == code_ptr - 2 )
  280.             {
  281.                if ( $3->op == _MATCH0 )  $3->op = _MATCH1 ;
  282.  
  283.                else /* check for string */
  284.                if ( $3->op == _PUSHS )
  285.                { CELL *cp = ZMALLOC(CELL) ;
  286.  
  287.                  cp->type = C_STRING ; 
  288.                  cp->ptr = $3[1].ptr ;
  289.                  cast_to_RE(cp) ;
  290.                  code_ptr -= 2 ;
  291.                  code2(_MATCH1, cp->ptr) ;
  292.                  ZFREE(cp) ;
  293.                }
  294.                else  code1(_MATCH2) ;
  295.             }
  296.             else code1(_MATCH2) ;
  297.  
  298.             if ( !$2 ) code1(_NOT) ;
  299.           }
  300.  
  301. /* short circuit boolean evaluation */
  302.       |   expr  OR
  303.               { code1(_DUP) ;
  304.                 code_jmp(_JNZ, (INST*)0) ;
  305.                 code1(_POP) ;
  306.               }
  307.           expr
  308.           { patch_jmp(code_ptr) ; code1(_TEST) ; }
  309.  
  310.       |   expr AND
  311.               { code1(_DUP) ; code_jmp(_JZ, (INST*)0) ;
  312.                 code1(_POP) ; }
  313.           expr
  314.               { patch_jmp(code_ptr) ; code1(_TEST) ; }
  315.  
  316.       |  expr QMARK  { code_jmp(_JZ, (INST*)0) ; }
  317.          expr COLON  { code_jmp(_JMP, (INST*)0) ; }
  318.          expr
  319.          { patch_jmp(code_ptr) ; patch_jmp($7) ; }
  320.       ;
  321.  
  322. cat_expr :  p_expr             %prec CAT
  323.          |  cat_expr  p_expr   %prec CAT 
  324.             { code1(_CAT) ; }
  325.          ;
  326.  
  327. p_expr  :   DOUBLE
  328.           {  $$ = code_ptr ; code2(_PUSHD, $1) ; }
  329.       |   STRING_
  330.           { $$ = code_ptr ; code2(_PUSHS, $1) ; }
  331.       |   ID   %prec AND /* anything less than IN */
  332.           { check_var($1) ;
  333.             $$ = code_ptr ;
  334.             if ( is_local($1) )
  335.             { code1(L_PUSHI) ; code1($1->offset) ; }
  336.             else code2(_PUSHI, $1->stval.cp) ;
  337.           }
  338.                             
  339.       |   LPAREN   expr  RPAREN
  340.           { $$ = $2 ; }
  341.       ;
  342.  
  343. p_expr  :   RE     
  344.             { $$ = code_ptr ; code2(_MATCH0, $1) ; }
  345.         ;
  346.  
  347. p_expr  :   p_expr  PLUS   p_expr { code1(_ADD) ; } 
  348.       |   p_expr MINUS  p_expr { code1(_SUB) ; }
  349.       |   p_expr  MUL   p_expr { code1(_MUL) ; }
  350.       |   p_expr  DIV  p_expr { code1(_DIV) ; }
  351.       |   p_expr  MOD  p_expr { code1(_MOD) ; }
  352.       |   p_expr  POW  p_expr { code1(_POW) ; }
  353.       |   NOT  p_expr  
  354.                 { $$ = $2 ; code1(_NOT) ; }
  355.       |   PLUS p_expr  %prec  UMINUS
  356.                 { $$ = $2 ; code1(_UPLUS) ; }
  357.       |   MINUS p_expr %prec  UMINUS
  358.                 { $$ = $2 ; code1(_UMINUS) ; }
  359.       |   builtin
  360.       ;
  361.  
  362. p_expr  :  ID  INC_or_DEC
  363.            { check_var($1) ;
  364.              $$ = code_ptr ;
  365.              code_address($1) ;
  366.  
  367.              if ( $2 == '+' )  code1(_POST_INC) ;
  368.              else  code1(_POST_DEC) ;
  369.            }
  370.         |  INC_or_DEC  lvalue
  371.             { $$ = $2 ; 
  372.               if ( $1 == '+' ) code1(_PRE_INC) ;
  373.               else  code1(_PRE_DEC) ;
  374.             }
  375.         ;
  376.  
  377. p_expr  :  field  INC_or_DEC   
  378.            { if ($2 == '+' ) code1(F_POST_INC ) ; 
  379.              else  code1(F_POST_DEC) ;
  380.            }
  381.         |  INC_or_DEC  field
  382.            { $$ = $2 ; 
  383.              if ( $1 == '+' ) code1(F_PRE_INC) ;
  384.              else  code1( F_PRE_DEC) ; 
  385.            }
  386.         ;
  387.  
  388. lvalue :  ID
  389.         { $$ = code_ptr ; 
  390.           check_var($1) ;
  391.           code_address($1) ;
  392.         }
  393.        ;
  394.  
  395.  
  396. arglist :  /* empty */
  397.             { $$ = 0 ; }
  398.         |  args
  399.         ;
  400.  
  401. args    :  expr        %prec  LPAREN
  402.             { $$ = 1 ; }
  403.         |  args  COMMA  expr
  404.             { $$ = $1 + 1 ; }
  405.         ;
  406.  
  407. builtin :
  408.         BUILTIN mark  LPAREN  arglist RPAREN
  409.         { BI_REC *p = $1 ;
  410.           $$ = $2 ;
  411.           if ( p-> min_args > $4 || p->max_args < $4 )
  412.             compile_error(
  413.             "wrong number of arguments in call to %s" ,
  414.             p->name ) ;
  415.           if ( p->min_args != p->max_args ) /* variable args */
  416.               { code1(_PUSHINT) ;  code1($4) ; }
  417.           code2(_BUILTIN , p->fp) ;
  418.         }
  419.         ;
  420.  
  421. /* an empty production to store the code_ptr */
  422. mark : /* empty */
  423.          { $$ = code_ptr ; }
  424.  
  425. /* print_statement */
  426. statement :  print mark pr_args pr_direction separator
  427.             { code2(_PRINT, $1) ; $$ = $2 ;
  428.               if ( $1 == bi_printf && $3 == 0 )
  429.                     compile_error("no arguments in call to printf") ;
  430.               print_flag = 0 ;
  431.               $$ = $2 ;
  432.             }
  433.             ;
  434.  
  435. print   :  PRINT  { $$ = bi_print ; print_flag = 1 ;}
  436.         |  PRINTF { $$ = bi_printf ; print_flag = 1 ; }
  437.         ;
  438.  
  439. pr_args :  arglist { code1(_PUSHINT) ; code1($1) ; }
  440.         |  LPAREN  arg2 RPAREN
  441.            { $$ = $2->cnt ; zfree($2,sizeof(ARG2_REC)) ; 
  442.              code1(_PUSHINT) ; code1($$) ; 
  443.            }
  444.     |  LPAREN  RPAREN
  445.        { $$=0 ; code1(_PUSHINT) ; code1(0) ; }
  446.         ;
  447.  
  448. arg2   :   expr  COMMA  expr
  449.            { $$ = (ARG2_REC*) zmalloc(sizeof(ARG2_REC)) ;
  450.              $$->start = $1 ;
  451.              $$->cnt = 2 ;
  452.            }
  453.         |   arg2 COMMA  expr
  454.             { $$ = $1 ; $$->cnt++ ; }
  455.         ;
  456.  
  457. pr_direction : /* empty */
  458.              |  IO_OUT  expr
  459.                 { code1(_PUSHINT) ; code1($1) ; }
  460.              ;
  461.  
  462.  
  463. /*  IF and IF-ELSE */
  464.  
  465. if_front :  IF LPAREN expr RPAREN
  466.             {  $$ = $3 ; eat_nl() ; code_jmp(_JZ, (INST*)0) ; }
  467.          ;
  468.  
  469. /* if_statement */
  470. statement : if_front statement
  471.                 { patch_jmp( code_ptr ) ;  }
  472.               ;
  473.  
  474. else    :  ELSE { eat_nl() ; code_jmp(_JMP, (INST*)0) ; }
  475.         ;
  476.  
  477. /* if_else_statement */
  478. statement :  if_front statement else statement
  479.                 { patch_jmp(code_ptr) ; patch_jmp($4) ; }
  480.  
  481.  
  482. /*  LOOPS   */
  483.  
  484. do      :  DO
  485.         { eat_nl() ; BC_new() ; }
  486.         ;
  487.  
  488. /* do_statement */
  489. statement : do statement WHILE LPAREN expr RPAREN separator
  490.         { $$ = $2 ;
  491.           code_jmp(_JNZ, $2) ; 
  492.           BC_clear(code_ptr, $5) ; }
  493.         ;
  494.  
  495. while_front :  WHILE LPAREN expr RPAREN
  496.                 { eat_nl() ; BC_new() ;
  497.                   $$ = $3 ;
  498.  
  499.                   /* check if const expression */
  500.                   if ( code_ptr - 2 == $3 &&
  501.                        code_ptr[-2].op == _PUSHD &&
  502.                        *(double*)code_ptr[-1].ptr != 0.0 
  503.                      )
  504.                      code_ptr -= 2 ;
  505.                   else
  506.           {
  507.             code_push($3, code_ptr-$3) ;
  508.             code_ptr = $3 ;
  509.                     code2(_JMP, (INST*)0) ; /* code2() not code_jmp() */
  510.           }
  511.                 }
  512.             ;
  513.  
  514. /* while_statement */
  515. statement  :    while_front  statement
  516.                 { 
  517.           INST *c_addr ; int len ;
  518.  
  519.                   if ( $1 != $2 )  /* real test in loop */
  520.           {
  521.             $1[1].op = code_ptr-($1+1) ;
  522.             c_addr = code_ptr ;
  523.             len = code_pop(code_ptr) ;
  524.             code_ptr += len ;
  525.             code_jmp(_JNZ, $2) ;
  526.             BC_clear(code_ptr, c_addr) ;
  527.           }
  528.           else /* while(1) */
  529.           {
  530.             code_jmp(_JMP, $1) ;
  531.             BC_clear(code_ptr, $2) ;
  532.           }
  533.                 }
  534.                 ;
  535.  
  536.  
  537. /* for_statement */
  538. statement   :   for1 for2 for3 statement
  539.                 { 
  540.                   INST *cont_address = code_ptr ;
  541.                   unsigned len = code_pop(code_ptr) ;
  542.  
  543.                   code_ptr += len ;
  544.  
  545.           if ( $2 != $4 )  /* real test in for2 */
  546.           {
  547.                     $4[-1].op = code_ptr - $4 + 1 ;
  548.             len = code_pop(code_ptr) ;
  549.             code_ptr += len ;
  550.                     code_jmp(_JNZ, $4) ;
  551.           }
  552.           else /*  for(;;) */
  553.           code_jmp(_JMP, $4) ;
  554.  
  555.           BC_clear(code_ptr, cont_address) ;
  556.  
  557.                 }
  558.               ;
  559.  
  560. for1    :  FOR LPAREN  SEMI_COLON   { $$ = code_ptr ; }
  561.         |  FOR LPAREN  expr SEMI_COLON
  562.            { $$ = $3 ; code1(_POP) ; }
  563.         ;
  564.  
  565. for2    :  SEMI_COLON   { $$ = code_ptr ; }
  566.         |  expr  SEMI_COLON
  567.            { 
  568.              if ( code_ptr - 2 == $1 &&
  569.                   code_ptr[-2].op == _PUSHD &&
  570.                   * (double*) code_ptr[-1].ptr != 0.0
  571.                 )
  572.                     code_ptr -= 2 ;
  573.              else   
  574.          {
  575.            code_push($1, code_ptr-$1) ;
  576.            code_ptr = $1 ;
  577.            code2(_JMP, (INST*)0) ;
  578.          }
  579.            }
  580.         ;
  581.  
  582. for3    :  RPAREN 
  583.            { eat_nl() ; BC_new() ; code_push((INST*)0,0) ; }
  584.         |  expr RPAREN
  585.            { eat_nl() ; BC_new() ; 
  586.              code1(_POP) ;
  587.              code_push($1, code_ptr - $1) ;
  588.              code_ptr -= code_ptr - $1 ;
  589.            }
  590.         ;
  591.  
  592.  
  593. /* arrays  */
  594.  
  595. expr    :  expr IN  ID
  596.            { check_array($3) ;
  597.              code_array($3) ; 
  598.              code1(A_TEST) ; 
  599.             }
  600.         |  LPAREN arg2 RPAREN IN ID
  601.            { $$ = $2->start ;
  602.              code1(A_CAT) ; code1($2->cnt) ;
  603.              zfree($2, sizeof(ARG2_REC)) ;
  604.  
  605.              check_array($5) ;
  606.              code_array($5) ;
  607.              code1(A_TEST) ;
  608.            }
  609.         ;
  610.  
  611. lvalue  :  ID mark LBOX  args  RBOX
  612.            { 
  613.              if ( $4 > 1 )
  614.              { code1(A_CAT) ; code1($4) ; }
  615.  
  616.              check_array($1) ;
  617.              if( is_local($1) )
  618.              { code1(LAE_PUSHA) ; code1($1->offset) ; }
  619.              else code2(AE_PUSHA, $1->stval.array) ;
  620.              $$ = $2 ;
  621.            }
  622.         ;
  623.  
  624. p_expr  :  ID mark LBOX  args  RBOX   %prec  AND
  625.            { 
  626.              if ( $4 > 1 )
  627.              { code1(A_CAT) ; code1($4) ; }
  628.  
  629.              check_array($1) ;
  630.              if( is_local($1) )
  631.              { code1(LAE_PUSHI) ; code1($1->offset) ; }
  632.              else code2(AE_PUSHI, $1->stval.array) ;
  633.              $$ = $2 ;
  634.            }
  635.  
  636.         |  ID mark LBOX  args  RBOX  INC_or_DEC
  637.            { 
  638.              if ( $4 > 1 )
  639.              { code1(A_CAT) ; code1($4) ; }
  640.  
  641.              check_array($1) ;
  642.              if( is_local($1) )
  643.              { code1(LAE_PUSHA) ; code1($1->offset) ; }
  644.              else code2(AE_PUSHA, $1->stval.array) ;
  645.              if ( $6 == '+' )  code1(_POST_INC) ;
  646.              else  code1(_POST_DEC) ;
  647.  
  648.              $$ = $2 ;
  649.            }
  650.         ;
  651.  
  652. /* delete A[i] */
  653. statement :  DELETE  ID mark LBOX args RBOX separator
  654.              { 
  655.                $$ = $3 ;
  656.                if ( $5 > 1 ) { code1(A_CAT) ; code1($5) ; }
  657.                check_array($2) ;
  658.                code_array($2) ;
  659.                code1(A_DEL) ;
  660.              }
  661.  
  662.           ;
  663.  
  664. /*  for ( i in A )  statement */
  665.  
  666. array_loop_front :  FOR LPAREN ID IN ID RPAREN
  667.                     { eat_nl() ; BC_new() ;
  668.                       $$ = code_ptr ;
  669.  
  670.                       check_var($3) ;
  671.                       code_address($3) ;
  672.                       check_array($5) ;
  673.                       code_array($5) ;
  674.  
  675.                       code2(SET_ALOOP, (INST*)0) ;
  676.                     }
  677.                  ;
  678.  
  679. /* array_loop */
  680. statement  :  array_loop_front  statement
  681.               { 
  682.             $2[-1].op = code_ptr - $2 + 1 ;
  683.                 BC_clear( code_ptr+3 , code_ptr) ;
  684.         code_jmp(ALOOP, $2) ;
  685.         code_ptr++->ptr = (PTR) ZMALLOC(ALOOP_STATE) ;
  686.               }
  687.            ;
  688.  
  689. /*  fields   
  690.     D_ID is a special token , same as an ID, but yylex()
  691.     only returns it after a '$'.  In essense,
  692.     DOLLAR D_ID is really one token.
  693. */
  694.  
  695. field   :  FIELD
  696.            { $$ = code_ptr ; code2(F_PUSHA, $1) ; }
  697.         |  DOLLAR  D_ID
  698.            { check_var($2) ;
  699.              $$ = code_ptr ;
  700.              if ( is_local($2) )
  701.              { code1(L_PUSHI) ; code1($2->offset) ; }
  702.              else code2(_PUSHI, $2->stval.cp) ;
  703.  
  704.          CODE_FE_PUSHA() ;
  705.            }
  706.         |  DOLLAR  D_ID mark LBOX  args RBOX
  707.            { 
  708.              if ( $5 > 1 )
  709.              { code1(A_CAT) ; code1($5) ; }
  710.  
  711.              check_array($2) ;
  712.              if( is_local($2) )
  713.              { code1(LAE_PUSHI) ; code1($2->offset) ; }
  714.              else code2(AE_PUSHI, $2->stval.array) ;
  715.  
  716.          CODE_FE_PUSHA()  ;
  717.  
  718.              $$ = $3 ;
  719.            }
  720.         |  DOLLAR p_expr
  721.            { $$ = $2 ;  CODE_FE_PUSHA() ; }
  722.         |  LPAREN field RPAREN
  723.            { $$ = $2 ; }
  724.         ;
  725.  
  726. p_expr   :  field   %prec CAT /* removes field (++|--) sr conflict */
  727.             { field_A2I() ; }
  728.         ;
  729.  
  730. expr    :  field   ASSIGN   expr { code1(F_ASSIGN) ; }
  731.         |  field   ADD_ASG  expr { code1(F_ADD_ASG) ; }
  732.         |  field   SUB_ASG  expr { code1(F_SUB_ASG) ; }
  733.         |  field   MUL_ASG  expr { code1(F_MUL_ASG) ; }
  734.         |  field   DIV_ASG  expr { code1(F_DIV_ASG) ; }
  735.         |  field   MOD_ASG  expr { code1(F_MOD_ASG) ; }
  736.         |  field   POW_ASG  expr { code1(F_POW_ASG) ; }
  737.         ;
  738.  
  739. /* split is handled different than a builtin because
  740.    it takes an array and optionally a regular expression as args */
  741.  
  742. p_expr  :   split_front  split_back 
  743.             { code2(_BUILTIN, bi_split) ; }
  744.         ;
  745.  
  746. split_front : SPLIT LPAREN expr COMMA ID 
  747.             { $$ = $3 ;
  748.               check_array($5) ;
  749.               code_array($5)  ;
  750.             }
  751.             ;
  752.  
  753. split_back  :   RPAREN
  754.                 { code2(_PUSHI, &fs_shadow) ; }
  755.             |   COMMA expr  RPAREN
  756.                 { 
  757.                   if ( $2 == code_ptr - 2 )
  758.                   {
  759.                     if ( code_ptr[-2].op == _MATCH0 )
  760.                         RE_as_arg() ;
  761.                     else
  762.                     if ( code_ptr[-2].op == _PUSHS )
  763.                     { CELL *cp = ZMALLOC(CELL) ;
  764.  
  765.                       cp->type = C_STRING ;
  766.                       cp->ptr = code_ptr[-1].ptr ;
  767.                       cast_for_split(cp) ;
  768.                       code_ptr[-2].op = _PUSHC ;
  769.                       code_ptr[-1].ptr = (PTR) cp ;
  770.                     }
  771.                   }
  772.                 }
  773.             ;
  774.  
  775.  
  776.  
  777. /*  match(expr, RE) */
  778.  
  779. p_expr : MATCH_FUNC LPAREN expr COMMA re_arg RPAREN
  780.         { $$ = $3 ; 
  781.           code2(_BUILTIN, bi_match) ;
  782.         }
  783.      ;
  784.  
  785.  
  786. re_arg   :   expr
  787.              {
  788.                if ( $1 == code_ptr - 2 ) 
  789.                {
  790.                  if ( $1->op == _MATCH0 ) RE_as_arg() ;
  791.                  else
  792.                  if ( $1->op == _PUSHS )
  793.                  { CELL *cp = ZMALLOC(CELL) ;
  794.  
  795.                    cp->type = C_STRING ;
  796.                    cp->ptr = $1[1].ptr ;
  797.                    cast_to_RE(cp) ;
  798.                    $1->op = _PUSHC ;
  799.                    $1[1].ptr = (PTR) cp ;
  800.                  } 
  801.                }
  802.              }
  803.                 
  804.  
  805.  
  806. /* exit_statement */
  807. statement      :  EXIT   separator
  808.                     { $$ = code_ptr ;
  809.                       code1(_EXIT0) ; }
  810.                |  EXIT   expr  separator
  811.                     { $$ = $2 ; code1(_EXIT) ; }
  812.  
  813. return_statement :  RETURN   separator
  814.                     { $$ = code_ptr ;
  815.                       code1(_RET0) ; }
  816.                |  RETURN   expr  separator
  817.                     { $$ = $2 ; code1(_RET) ; }
  818.  
  819. /* getline */
  820.  
  821. p_expr :  getline      %prec  GETLINE
  822.           { $$ = code_ptr ;
  823.             code2(F_PUSHA, &field[0]) ;
  824.             code1(_PUSHINT) ; code1(0) ; 
  825.             code2(_BUILTIN, bi_getline) ;
  826.             getline_flag = 0 ;
  827.           }
  828.        |  getline  fvalue     %prec  GETLINE
  829.           { $$ = $2 ;
  830.             code1(_PUSHINT) ; code1(0) ;
  831.             code2(_BUILTIN, bi_getline) ;
  832.             getline_flag = 0 ;
  833.           }
  834.        |  getline_file  p_expr    %prec IO_IN
  835.           { code1(_PUSHINT) ; code1(F_IN) ;
  836.             code2(_BUILTIN, bi_getline) ;
  837.             /* getline_flag already off in yylex() */
  838.           }
  839.        |  p_expr PIPE GETLINE  
  840.           { code2(F_PUSHA, &field[0]) ;
  841.             code1(_PUSHINT) ; code1(PIPE_IN) ;
  842.             code2(_BUILTIN, bi_getline) ;
  843.           }
  844.        |  p_expr PIPE GETLINE   fvalue
  845.           { 
  846.             code1(_PUSHINT) ; code1(PIPE_IN) ;
  847.             code2(_BUILTIN, bi_getline) ;
  848.           }
  849.        ;
  850.  
  851. getline :   GETLINE  { getline_flag = 1 ; }
  852.  
  853. fvalue  :   lvalue  |  field  ;
  854.  
  855. getline_file  :  getline  IO_IN
  856.                  { $$ = code_ptr ;
  857.                    code2(F_PUSHA, field+0) ;
  858.                  }
  859.               |  getline fvalue IO_IN
  860.                  { $$ = $2 ; }
  861.               ;
  862.  
  863. /*==========================================
  864.     sub and gsub  
  865.   ==========================================*/
  866.  
  867. p_expr  :  sub_or_gsub LPAREN re_arg COMMA  expr  sub_back
  868.            {
  869.              if ( $6 - $5 == 2 && $5->op == _PUSHS  )
  870.              { /* cast from STRING to REPL at compile time */
  871.                CELL *cp = ZMALLOC(CELL) ;
  872.                cp->type = C_STRING ;
  873.                cp->ptr = $5[1].ptr ;
  874.                cast_to_REPL(cp) ;
  875.                $5->op = _PUSHC ;
  876.                $5[1].ptr = (PTR) cp ;
  877.              }
  878.              code2(_BUILTIN, $1) ;
  879.              $$ = $3 ;
  880.            }
  881.         ;
  882.  
  883. sub_or_gsub :  SUB  { $$ = bi_sub ; }
  884.             |  GSUB { $$ = bi_gsub ; }
  885.             ;
  886.  
  887.  
  888. sub_back    :   RPAREN    /* substitute into $0  */
  889.                 { $$ = code_ptr ;
  890.                   code2(F_PUSHA, &field[0]) ; 
  891.                 }
  892.  
  893.             |   COMMA fvalue  RPAREN
  894.                 { $$ = $2 ; }
  895.             ;
  896.  
  897. /*================================================
  898.     user defined functions
  899.  *=================================*/
  900.  
  901. function_def  :  funct_start  block
  902.                  { resize_fblock($1, code_ptr) ;
  903.                    code_ptr = main_code_ptr ;
  904.                    scope = SCOPE_MAIN ;
  905.                    active_funct = (FBLOCK *) 0 ;
  906.                    restore_ids() ;
  907.                  }
  908.               ;
  909.                    
  910.  
  911. funct_start   :  funct_head  LPAREN  f_arglist  RPAREN
  912.                  { eat_nl() ;
  913.                    scope = SCOPE_FUNCT ;
  914.                    active_funct = $1 ;
  915.                    main_code_ptr = code_ptr ;
  916.  
  917.                    if ( $1->nargs = $3 )
  918.                         $1->typev = (char *)
  919.             memset( zmalloc($3), ST_LOCAL_NONE, SIZE_T($3)) ;
  920.                    else $1->typev = (char *) 0 ;
  921.                    code_ptr = $1->code = 
  922.                        (INST *) zmalloc(PAGE_SZ*sizeof(INST)) ;
  923.                  }
  924.               ;
  925.                   
  926. funct_head    :  FUNCTION  ID
  927.                  { FBLOCK  *fbp ;
  928.  
  929.                    if ( $2->type == ST_NONE )
  930.                    {
  931.                          $2->type = ST_FUNCT ;
  932.                          fbp = $2->stval.fbp = 
  933.                              (FBLOCK *) zmalloc(sizeof(FBLOCK)) ;
  934.                          fbp->name = $2->name ;
  935.                    }
  936.                    else
  937.                    {
  938.                          type_error( $2 ) ;
  939.  
  940.                          /* this FBLOCK will not be put in
  941.                             the symbol table */
  942.                          fbp = (FBLOCK*) zmalloc(sizeof(FBLOCK)) ;
  943.                          fbp->name = "" ;
  944.                    }
  945.                    $$ = fbp ;
  946.                  }
  947.  
  948.               |  FUNCTION  FUNCT_ID
  949.                  { $$ = $2 ; 
  950.                    if ( $2->code ) 
  951.                        compile_error("redefinition of %s" , $2->name) ;
  952.                  }
  953.               ;
  954.                          
  955. f_arglist  :  /* empty */ { $$ = 0 ; }
  956.            |  f_args
  957.            ;
  958.  
  959. f_args     :  ID
  960.               { $1 = save_id($1->name) ;
  961.                 $1->type = ST_LOCAL_NONE ;
  962.                 $1->offset = 0 ;
  963.                 $$ = 1 ;
  964.               }
  965.            |  f_args  COMMA  ID
  966.               { if ( is_local($3) ) 
  967.                   compile_error("%s is duplicated in argument list",
  968.                     $3->name) ;
  969.                 else
  970.                 { $3 = save_id($3->name) ;
  971.                   $3->type = ST_LOCAL_NONE ;
  972.                   $3->offset = $1 ;
  973.                   $$ = $1 + 1 ;
  974.                 }
  975.               }
  976.            ;
  977.  
  978. /* a call to a user defined function */
  979.              
  980. p_expr  :  FUNCT_ID mark  call_args
  981.            { $$ = $2 ;
  982.              code2(_CALL, $1) ;
  983.  
  984.              if ( $3 )  code1($3->arg_num+1) ;
  985.              else  code1(0) ;
  986.                
  987.              check_fcall($1, scope, active_funct, 
  988.                          $3, token_lineno) ;
  989.            }
  990.         ;
  991.  
  992. call_args  :   LPAREN   RPAREN
  993.                { $$ = (CA_REC *) 0 ; }
  994.            |   ca_front  ca_back
  995.                { $$ = $2 ;
  996.                  $$->link = $1 ;
  997.                  $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
  998.                }
  999.            ;
  1000.  
  1001. /* The funny definition of ca_front with the COMMA bound to the ID is to
  1002.    force a shift to avoid a reduce/reduce conflict
  1003.    ID->id or ID->array
  1004.  
  1005.    Or to avoid a decision, if the type of the ID has not yet been
  1006.    determined
  1007. */
  1008.  
  1009. ca_front   :  LPAREN
  1010.               { $$ = (CA_REC *) 0 ; }
  1011.            |  ca_front  expr   COMMA
  1012.               { $$ = (CA_REC *) zmalloc(sizeof(CA_REC)) ;
  1013.                 $$->link = $1 ;
  1014.                 $$->type = CA_EXPR  ;
  1015.                 $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
  1016.               }
  1017.            |  ca_front  ID   COMMA
  1018.               { $$ = (CA_REC *) zmalloc(sizeof(CA_REC)) ;
  1019.                 $$->link = $1 ;
  1020.                 $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
  1021.  
  1022.                 code_call_id($$, $2) ;
  1023.               }
  1024.            ;
  1025.  
  1026. ca_back    :  expr   RPAREN
  1027.               { $$ = (CA_REC *) zmalloc(sizeof(CA_REC)) ;
  1028.                 $$->type = CA_EXPR ;
  1029.               }
  1030.  
  1031.            |  ID    RPAREN
  1032.               { $$ = (CA_REC *) zmalloc(sizeof(CA_REC)) ;
  1033.                 code_call_id($$, $1) ;
  1034.               }
  1035.            ;
  1036.  
  1037.  
  1038.     
  1039.  
  1040. %%
  1041.  
  1042. /* resize the code for a user function */
  1043.  
  1044. static void  resize_fblock( fbp, code_ptr )
  1045.   FBLOCK *fbp ;
  1046.   INST *code_ptr ;
  1047. { int size ;
  1048.  
  1049.   code1(_RET0) ; /* make sure there is always a return statement */
  1050.  
  1051. #if !SM_DOS
  1052.   if ( dump_code )  
  1053.   { code1(_HALT) ; /*stops da() */
  1054.     add_to_fdump_list(fbp) ;
  1055.   }
  1056. #endif
  1057.  
  1058.   if ( (size = code_ptr - fbp->code) > PAGE_SZ-1 )
  1059.         overflow("function code size", PAGE_SZ ) ;
  1060.  
  1061.   /* resize the code */
  1062.   fbp->code = (INST*) zrealloc(fbp->code, PAGE_SZ*sizeof(INST),
  1063.                        size * sizeof(INST) ) ;
  1064.  
  1065. }
  1066.  
  1067.  
  1068. /* convert FE_PUSHA  to  FE_PUSHI
  1069.    or F_PUSH to F_PUSHI
  1070. */
  1071.  
  1072. static void  field_A2I()
  1073. { CELL *cp ;
  1074.  
  1075.   if ( code_ptr[-1].op == FE_PUSHA &&
  1076.        code_ptr[-1].ptr == (PTR) 0)
  1077.   /* On most architectures, the two tests are the same; a good
  1078.      compiler might eliminate one.  On LM_DOS, and possibly other
  1079.      segmented architectures, they are not */
  1080.   { code_ptr[-1].op = FE_PUSHI ; }
  1081.   else
  1082.   {
  1083.     cp = (CELL *) code_ptr[-1].ptr ;
  1084.  
  1085.     if ( cp == field  ||
  1086.  
  1087. #if  LM_DOS
  1088.      SAMESEG(cp,field) &&
  1089. #endif
  1090.          cp > NF && cp <= LAST_PFIELD )
  1091.     {
  1092.          code_ptr[-2].op = _PUSHI  ;
  1093.     }
  1094.     else if ( cp == NF )
  1095.     { code_ptr[-2].op = NF_PUSHI ; code_ptr-- ; }
  1096.  
  1097.     else
  1098.     { 
  1099.       code_ptr[-2].op = F_PUSHI ;
  1100.       code_ptr -> op = field_addr_to_index( code_ptr[-1].ptr ) ;
  1101.       code_ptr++ ;
  1102.     }
  1103.   }
  1104. }
  1105.  
  1106. /* we've seen an ID in a context where it should be a VAR,
  1107.    check that's consistent with previous usage */
  1108.  
  1109. static void check_var( p )
  1110.   register SYMTAB *p ;
  1111. {
  1112.       switch(p->type)
  1113.       {
  1114.         case ST_NONE : /* new id */
  1115.             p->type = ST_VAR ;
  1116.             p->stval.cp = new_CELL() ;
  1117.             p->stval.cp->type = C_NOINIT ;
  1118.             break ;
  1119.  
  1120.         case ST_LOCAL_NONE :
  1121.             p->type = ST_LOCAL_VAR ;
  1122.             active_funct->typev[p->offset] = ST_LOCAL_VAR ;
  1123.             break ;
  1124.  
  1125.         case ST_VAR :
  1126.         case ST_LOCAL_VAR :  break ;
  1127.  
  1128.         default :
  1129.             type_error(p) ;
  1130.             break ;
  1131.       }
  1132. }
  1133.  
  1134. /* we've seen an ID in a context where it should be an ARRAY,
  1135.    check that's consistent with previous usage */
  1136. static  void  check_array(p)
  1137.   register SYMTAB *p ;
  1138. {
  1139.       switch(p->type)
  1140.       {
  1141.         case ST_NONE :  /* a new array */
  1142.             p->type = ST_ARRAY ;
  1143.             p->stval.array = new_ARRAY() ;
  1144.             break ;
  1145.  
  1146.         case  ST_ARRAY :
  1147.         case  ST_LOCAL_ARRAY :
  1148.             break ;
  1149.  
  1150.         case  ST_LOCAL_NONE  :
  1151.             p->type = ST_LOCAL_ARRAY ;
  1152.             active_funct->typev[p->offset] = ST_LOCAL_ARRAY ;
  1153.             break ;
  1154.  
  1155.         default : type_error(p) ; break ;
  1156.       }
  1157. }
  1158.  
  1159. static void code_array(p)
  1160.   register SYMTAB *p ;
  1161. { if ( is_local(p) )
  1162.   { code1(LA_PUSHA) ; code1(p->offset) ; }
  1163.   else  code2(A_PUSHA, p->stval.array) ;
  1164. }
  1165.  
  1166.  
  1167. static  int  current_offset()
  1168. {
  1169.   switch( scope )
  1170.   { 
  1171.     case  SCOPE_MAIN :  return code_ptr - main_start ;
  1172.     case  SCOPE_BEGIN :  return code_ptr - begin_code.start ;
  1173.     case  SCOPE_END   :  return code_ptr - end_code.start ;
  1174.     case  SCOPE_FUNCT :  return code_ptr - active_funct->code ;
  1175.   }
  1176.   /* can't get here */
  1177.   return 0 ;
  1178. }
  1179.  
  1180. /* we've seen an ID as an argument to a user defined function */
  1181.  
  1182. static void  code_call_id( p, ip )
  1183.   register CA_REC *p ;
  1184.   register SYMTAB *ip ;
  1185. { static CELL dummy ;
  1186.  
  1187.   switch( ip->type )
  1188.   {
  1189.     case  ST_VAR  :
  1190.             p->type = CA_EXPR ;
  1191.             code2(_PUSHI, ip->stval.cp) ;
  1192.             break ;
  1193.  
  1194.     case  ST_LOCAL_VAR  :
  1195.             p->type = CA_EXPR ;
  1196.             code1(L_PUSHI) ;
  1197.             code1(ip->offset) ;
  1198.             break ;
  1199.  
  1200.     case  ST_ARRAY  :
  1201.             p->type = CA_ARRAY ;
  1202.             code2(A_PUSHA, ip->stval.array) ;
  1203.             break ;
  1204.  
  1205.     case  ST_LOCAL_ARRAY :
  1206.             p->type = CA_ARRAY ;
  1207.             code1(LA_PUSHA) ;
  1208.             code1(ip->offset) ;
  1209.             break ;
  1210.  
  1211.     /* not enough info to code it now; it will have to
  1212.        be patched later */
  1213.  
  1214.     case  ST_NONE :
  1215.             p->type = ST_NONE ;
  1216.             p->call_offset = current_offset() ;
  1217.             p->sym_p = ip ;
  1218.             code2(_PUSHI, &dummy) ;
  1219.             break ;
  1220.  
  1221.     case  ST_LOCAL_NONE :
  1222.             p->type = ST_LOCAL_NONE ;
  1223.             p->call_offset = current_offset() ;
  1224.             p->type_p = & active_funct->typev[ip->offset] ;
  1225.             code1(L_PUSHI) ; 
  1226.             code1(ip->offset) ;
  1227.             break ;
  1228.  
  1229.   
  1230. #ifdef   DEBUG
  1231.     default :
  1232.             bozo("code_call_id") ;
  1233. #endif
  1234.  
  1235.   }
  1236. }
  1237.  
  1238. /* an RE by itself was coded as _MATCH0 , change to
  1239.    push as an expression */
  1240.  
  1241. static void RE_as_arg()
  1242. { CELL *cp = ZMALLOC(CELL) ;
  1243.  
  1244.   code_ptr -= 2 ;
  1245.   cp->type = C_RE ;
  1246.   cp->ptr = code_ptr[1].ptr ;
  1247.   code2(_PUSHC, cp) ;
  1248. }
  1249.  
  1250.  
  1251. int parse()
  1252. { int yy = yyparse() ;
  1253.  
  1254. #if  YYBYACC
  1255.   extern struct yacc_mem *yacc_memp ;
  1256.  
  1257.   yacc_memp++  ; /* puts parser tables in mem pool */
  1258. #endif
  1259.  
  1260.   if ( resolve_list )  resolve_fcalls() ;
  1261.   return yy ;
  1262. }
  1263.  
  1264.