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