parse.y

   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
 279 statement_list :  statement
 280         |  statement_list   statement
 281         ;
 282
 283
 284 statement :  block
 285           |  expr   separator
 286              { code1(_POP) ; }
 287           |  /* empty */  separator
 288              { $$ = code_offset ; }
 289           |  error  separator
 290               { $$ = code_offset ;
 291                 print_flag = getline_flag = 0 ;
 292                 paren_cnt = 0 ;
 293                 yyerrok ;
 294               }
 295           |  BREAK  separator
 296              { $$ = code_offset ; BC_insert('B', code_ptr+1) ;
 297                code2(_JMP, 0) /* don't use code_jmp ! */ ; }
 298           |  CONTINUE  separator
 299              { $$ = code_offset ; BC_insert('C', code_ptr+1) ;
 300                code2(_JMP, 0) ; }
 301           |  return_statement
 302              { if ( scope != SCOPE_FUNCT )
 303                      compile_error("return outside function body") ;
 304              }
 305           |  NEXT  separator
 306               { if ( scope != SCOPE_MAIN )
 307                    compile_error( "improper use of next" ) ;
 308                 $$ = code_offset ;
 309                 code1(_NEXT) ;
 310               }
 311           ;
 312
 313 separator  :  NL | SEMI_COLON
 314            ;
 315
 316 expr  :   cat_expr
 317       |   lvalue   ASSIGN   expr { code1(_ASSIGN) ; }
 318       |   lvalue   ADD_ASG  expr { code1(_ADD_ASG) ; }
 319       |   lvalue   SUB_ASG  expr { code1(_SUB_ASG) ; }
 320       |   lvalue   MUL_ASG  expr { code1(_MUL_ASG) ; }
 321       |   lvalue   DIV_ASG  expr { code1(_DIV_ASG) ; }
 322       |   lvalue   MOD_ASG  expr { code1(_MOD_ASG) ; }
 323       |   lvalue   POW_ASG  expr { code1(_POW_ASG) ; }
 324       |   expr EQ expr  { code1(_EQ) ; }
 325       |   expr NEQ expr { code1(_NEQ) ; }
 326       |   expr LT expr { code1(_LT) ; }
 327       |   expr LTE expr { code1(_LTE) ; }
 328       |   expr GT expr { code1(_GT) ; }
 329       |   expr GTE expr { code1(_GTE) ; }
 330
 331       |   expr MATCH expr
 332           {
 333             INST *p3 = CDP($3) ;
 334
 335             if ( p3 == code_ptr - 2 )
 336             {
 337                if ( p3->op == _MATCH0 )  p3->op = _MATCH1 ;
 338
 339                else /* check for string */
 340                if ( p3->op == _PUSHS )
 341                { CELL *cp = ZMALLOC(CELL) ;
 342
 343                  cp->type = C_STRING ;
 344                  cp->ptr = p3[1].ptr ;
 345                  cast_to_RE(cp) ;
 346                  code_ptr -= 2 ;
 347                  code2(_MATCH1, cp->ptr) ;
 348                  ZFREE(cp) ;
 349                }
 350                else  code1(_MATCH2) ;
 351             }
 352             else code1(_MATCH2) ;
 353
 354             if ( !$2 ) code1(_NOT) ;
 355           }
 356
 357 /* short circuit boolean evaluation */
 358       |   expr  OR
 359               { code1(_TEST) ;
 360                 code_jmp(_LJNZ, (INST*)0) ;
 361               }
 362           expr
 363           { code1(_TEST) ; patch_jmp(code_ptr) ; }
 364
 365       |   expr AND
 366               { code1(_TEST) ;
 367                 code_jmp(_LJZ, (INST*)0) ;
 368               }
 369           expr
 370               { code1(_TEST) ; patch_jmp(code_ptr) ; }
 371
 372       |  expr QMARK  { code_jmp(_JZ, (INST*)0) ; }
 373          expr COLON  { code_jmp(_JMP, (INST*)0) ; }
 374          expr
 375          { patch_jmp(code_ptr) ; patch_jmp(CDP($7)) ; }
 376       ;
 377
 378 cat_expr :  p_expr             %prec CAT
 379          |  cat_expr  p_expr   %prec CAT
 380             { code1(_CAT) ; }
 381          ;
 382
 383 p_expr  :   DOUBLE
 384           {  $$ = code_offset ; code2(_PUSHD, $1) ; }
 385       |   STRING_
 386           { $$ = code_offset ; code2(_PUSHS, $1) ; }
 387       |   ID   %prec AND /* anything less than IN */
 388           { check_var($1) ;
 389             $$ = code_offset ;
 390             if ( is_local($1) )
 391             { code2op(L_PUSHI, $1->offset) ; }
 392             else code2(_PUSHI, $1->stval.cp) ;
 393           }
 394
 395       |   LPAREN   expr  RPAREN
 396           { $$ = $2 ; }
 397       ;
 398
 399 p_expr  :   RE
 400             { $$ = code_offset ; code2(_MATCH0, $1) ; }
 401         ;
 402
 403 p_expr  :   p_expr  PLUS   p_expr { code1(_ADD) ; }
 404       |   p_expr MINUS  p_expr { code1(_SUB) ; }
 405       |   p_expr  MUL   p_expr { code1(_MUL) ; }
 406       |   p_expr  DIV  p_expr { code1(_DIV) ; }
 407       |   p_expr  MOD  p_expr { code1(_MOD) ; }
 408       |   p_expr  POW  p_expr { code1(_POW) ; }
 409       |   NOT  p_expr
 410                 { $$ = $2 ; code1(_NOT) ; }
 411       |   PLUS p_expr  %prec  UMINUS
 412                 { $$ = $2 ; code1(_UPLUS) ; }
 413       |   MINUS p_expr %prec  UMINUS
 414                 { $$ = $2 ; code1(_UMINUS) ; }
 415       |   builtin
 416       ;
 417
 418 p_expr  :  ID  INC_or_DEC
 419            { check_var($1) ;
 420              $$ = code_offset ;
 421              code_address($1) ;
 422
 423              if ( $2 == '+' )  code1(_POST_INC) ;
 424              else  code1(_POST_DEC) ;
 425            }
 426         |  INC_or_DEC  lvalue
 427             { $$ = $2 ;
 428               if ( $1 == '+' ) code1(_PRE_INC) ;
 429               else  code1(_PRE_DEC) ;
 430             }
 431         ;
 432
 433 p_expr  :  field  INC_or_DEC
 434            { if ($2 == '+' ) code1(F_POST_INC ) ;
 435              else  code1(F_POST_DEC) ;
 436            }
 437         |  INC_or_DEC  field
 438            { $$ = $2 ;
 439              if ( $1 == '+' ) code1(F_PRE_INC) ;
 440              else  code1( F_PRE_DEC) ;
 441            }
 442         ;
 443
 444 lvalue :  ID
 445         { $$ = code_offset ;
 446           check_var($1) ;
 447           code_address($1) ;
 448         }
 449        ;
 450
 451
 452 arglist :  /* empty */
 453             { $$ = 0 ; }
 454         |  args
 455         ;
 456
 457 args    :  expr        %prec  LPAREN
 458             { $$ = 1 ; }
 459         |  args  COMMA  expr
 460             { $$ = $1 + 1 ; }
 461         ;
 462
 463 builtin :
 464         BUILTIN mark  LPAREN  arglist RPAREN
 465         { BI_REC *p = $1 ;
 466           $$ = $2 ;
 467           if ( (int)p->min_args > $4 || (int)p->max_args < $4 )
 468             compile_error(
 469             "wrong number of arguments in call to %s" ,
 470             p->name ) ;
 471           if ( p->min_args != p->max_args ) /* variable args */
 472               { code1(_PUSHINT) ;  code1($4) ; }
 473           code2(_BUILTIN , p->fp) ;
 474         }
 475         | LENGTH   /* this is an irritation */
 476           {
 477             $$ = code_offset ;
 478             code1(_PUSHINT) ; code1(0) ;
 479             code2(_BUILTIN, $1->fp) ;
 480           }
 481         ;
 482
 483 /* an empty production to store the code_ptr */
 484 mark : /* empty */
 485          { $$ = code_offset ; }
 486         ;
 487
 488 /* print_statement */
 489 statement :  print mark pr_args pr_direction separator
 490             { code2(_PRINT, $1) ;
 491               if ( $1 == bi_printf && $3 == 0 )
 492                     compile_error("no arguments in call to printf") ;
 493               print_flag = 0 ;
 494               $$ = $2 ;
 495             }
 496             ;
 497
 498 print   :  PRINT  { $$ = bi_print ; print_flag = 1 ;}
 499         |  PRINTF { $$ = bi_printf ; print_flag = 1 ; }
 500         ;
 501
 502 pr_args :  arglist { code2op(_PUSHINT, $1) ; }
 503         |  LPAREN  arg2 RPAREN
 504            { $$ = $2->cnt ; zfree($2,sizeof(ARG2_REC)) ;
 505              code2op(_PUSHINT, $$) ;
 506            }
 507         |  LPAREN  RPAREN
 508            { $$=0 ; code2op(_PUSHINT, 0) ; }
 509         ;
 510
 511 arg2   :   expr  COMMA  expr
 512            { $$ = (ARG2_REC*) zmalloc(sizeof(ARG2_REC)) ;
 513              $$->start = $1 ;
 514              $$->cnt = 2 ;
 515            }
 516         |   arg2 COMMA  expr
 517             { $$ = $1 ; $$->cnt++ ; }
 518         ;
 519
 520 pr_direction : /* empty */
 521              |  IO_OUT  expr
 522                 { code2op(_PUSHINT, $1) ; }
 523              ;
 524
 525
 526 /*  IF and IF-ELSE */
 527
 528 if_front :  IF LPAREN expr RPAREN
 529             {  $$ = $3 ; eat_nl() ; code_jmp(_JZ, (INST*)0) ; }
 530          ;
 531
 532 /* if_statement */
 533 statement : if_front statement
 534                 { patch_jmp( code_ptr ) ;  }
 535               ;
 536
 537 else    :  ELSE { eat_nl() ; code_jmp(_JMP, (INST*)0) ; }
 538         ;
 539
 540 /* if_else_statement */
 541 statement :  if_front statement else statement
 542                 { patch_jmp(code_ptr) ;
 543                   patch_jmp(CDP($4)) ;
 544                 }
 545         ;
 546
 547
 548 /*  LOOPS   */
 549
 550 do      :  DO
 551         { eat_nl() ; BC_new() ; }
 552         ;
 553
 554 /* do_statement */
 555 statement : do statement WHILE LPAREN expr RPAREN separator
 556         { $$ = $2 ;
 557           code_jmp(_JNZ, CDP($2)) ;
 558           BC_clear(code_ptr, CDP($5)) ; }
 559         ;
 560
 561 while_front :  WHILE LPAREN expr RPAREN
 562                 { eat_nl() ; BC_new() ;
 563                   $$ = $3 ;
 564
 565                   /* check if const expression */
 566                   if ( code_ptr - 2 == CDP($3) &&
 567                        code_ptr[-2].op == _PUSHD &&
 568                        *(double*)code_ptr[-1].ptr != 0.0
 569                      )
 570                      code_ptr -= 2 ;
 571                   else
 572                   { INST *p3 = CDP($3) ;
 573                     code_push(p3, code_ptr-p3, scope, active_funct) ;
 574                     code_ptr = p3 ;
 575                     code2(_JMP, (INST*)0) ; /* code2() not code_jmp() */
 576                   }
 577                 }
 578             ;
 579
 580 /* while_statement */
 581 statement  :    while_front  statement
 582                 {
 583                   int  saved_offset ;
 584                   int len ;
 585                   INST *p1 = CDP($1) ;
 586                   INST *p2 = CDP($2) ;
 587
 588                   if ( p1 != p2 )  /* real test in loop */
 589                   {
 590                     p1[1].op = code_ptr-(p1+1) ;
 591                     saved_offset = code_offset ;
 592                     len = code_pop(code_ptr) ;
 593                     code_ptr += len ;
 594                     code_jmp(_JNZ, CDP($2)) ;
 595                     BC_clear(code_ptr, CDP(saved_offset)) ;
 596                   }
 597                   else /* while(1) */
 598                   {
 599                     code_jmp(_JMP, p1) ;
 600                     BC_clear(code_ptr, CDP($2)) ;
 601                   }
 602                 }
 603                 ;
 604
 605
 606 /* for_statement */
 607 statement   :   for1 for2 for3 statement
 608                 {
 609                   int cont_offset = code_offset ;
 610                   unsigned len = code_pop(code_ptr) ;
 611                   INST *p2 = CDP($2) ;
 612                   INST *p4 = CDP($4) ;
 613
 614                   code_ptr += len ;
 615
 616                   if ( p2 != p4 )  /* real test in for2 */
 617                   {
 618                     p4[-1].op = code_ptr - p4 + 1 ;
 619                     len = code_pop(code_ptr) ;
 620                     code_ptr += len ;
 621                     code_jmp(_JNZ, CDP($4)) ;
 622                   }
 623                   else /*  for(;;) */
 624                   code_jmp(_JMP, p4) ;
 625
 626                   BC_clear(code_ptr, CDP(cont_offset)) ;
 627
 628                 }
 629               ;
 630
 631 for1    :  FOR LPAREN  SEMI_COLON   { $$ = code_offset ; }
 632         |  FOR LPAREN  expr SEMI_COLON
 633            { $$ = $3 ; code1(_POP) ; }
 634         ;
 635
 636 for2    :  SEMI_COLON   { $$ = code_offset ; }
 637         |  expr  SEMI_COLON
 638            {
 639              if ( code_ptr - 2 == CDP($1) &&
 640                   code_ptr[-2].op == _PUSHD &&
 641                   * (double*) code_ptr[-1].ptr != 0.0
 642                 )
 643                     code_ptr -= 2 ;
 644              else
 645              {
 646                INST *p1 = CDP($1) ;
 647                code_push(p1, code_ptr-p1, scope, active_funct) ;
 648                code_ptr = p1 ;
 649                code2(_JMP, (INST*)0) ;
 650              }
 651            }
 652         ;
 653
 654 for3    :  RPAREN
 655            { eat_nl() ; BC_new() ;
 656              code_push((INST*)0,0, scope, active_funct) ;
 657            }
 658         |  expr RPAREN
 659            { INST *p1 = CDP($1) ;
 660
 661              eat_nl() ; BC_new() ;
 662              code1(_POP) ;
 663              code_push(p1, code_ptr - p1, scope, active_funct) ;
 664              code_ptr -= code_ptr - p1 ;
 665            }
 666         ;
 667
 668
 669 /* arrays  */
 670
 671 expr    :  expr IN  ID
 672            { check_array($3) ;
 673              code_array($3) ;
 674              code1(A_TEST) ;
 675             }
 676         |  LPAREN arg2 RPAREN IN ID
 677            { $$ = $2->start ;
 678              code2op(A_CAT, $2->cnt) ;
 679              zfree($2, sizeof(ARG2_REC)) ;
 680
 681              check_array($5) ;
 682              code_array($5) ;
 683              code1(A_TEST) ;
 684            }
 685         ;
 686
 687 lvalue  :  ID mark LBOX  args  RBOX
 688            {
 689              if ( $4 > 1 )
 690              { code2op(A_CAT, $4) ; }
 691
 692              check_array($1) ;
 693              if( is_local($1) )
 694              { code2op(LAE_PUSHA, $1->offset) ; }
 695              else code2(AE_PUSHA, $1->stval.array) ;
 696              $$ = $2 ;
 697            }
 698         ;
 699
 700 p_expr  :  ID mark LBOX  args  RBOX   %prec  AND
 701            {
 702              if ( $4 > 1 )
 703              { code2op(A_CAT, $4) ; }
 704
 705              check_array($1) ;
 706              if( is_local($1) )
 707              { code2op(LAE_PUSHI, $1->offset) ; }
 708              else code2(AE_PUSHI, $1->stval.array) ;
 709              $$ = $2 ;
 710            }
 711
 712         |  ID mark LBOX  args  RBOX  INC_or_DEC
 713            {
 714              if ( $4 > 1 )
 715              { code2op(A_CAT,$4) ; }
 716
 717              check_array($1) ;
 718              if( is_local($1) )
 719              { code2op(LAE_PUSHA, $1->offset) ; }
 720              else code2(AE_PUSHA, $1->stval.array) ;
 721              if ( $6 == '+' )  code1(_POST_INC) ;
 722              else  code1(_POST_DEC) ;
 723
 724              $$ = $2 ;
 725            }
 726         ;
 727
 728 /* delete A[i] or delete A */
 729 statement :  DELETE  ID mark LBOX args RBOX separator
 730              {
 731                $$ = $3 ;
 732                if ( $5 > 1 ) { code2op(A_CAT, $5) ; }
 733                check_array($2) ;
 734                code_array($2) ;
 735                code1(A_DEL) ;
 736              }
 737           |  DELETE ID separator
 738              {
 739                 $$ = code_offset ;
 740                 check_array($2) ;
 741                 code_array($2) ;
 742                 code1(DEL_A) ;
 743              }
 744           ;
 745
 746 /*  for ( i in A )  statement */
 747
 748 array_loop_front :  FOR LPAREN ID IN ID RPAREN
 749                     { eat_nl() ; BC_new() ;
 750                       $$ = code_offset ;
 751
 752                       check_var($3) ;
 753                       code_address($3) ;
 754                       check_array($5) ;
 755                       code_array($5) ;
 756
 757                       code2(SET_ALOOP, (INST*)0) ;
 758                     }
 759                  ;
 760
 761 /* array_loop */
 762 statement  :  array_loop_front  statement
 763               {
 764                 INST *p2 = CDP($2) ;
 765
 766                 p2[-1].op = code_ptr - p2 + 1 ;
 767                 BC_clear( code_ptr+2 , code_ptr) ;
 768                 code_jmp(ALOOP, p2) ;
 769                 code1(POP_AL) ;
 770               }
 771            ;
 772
 773 /*  fields
 774     D_ID is a special token , same as an ID, but yylex()
 775     only returns it after a '$'.  In essense,
 776     DOLLAR D_ID is really one token.
 777 */
 778
 779 field   :  FIELD
 780            { $$ = code_offset ; code2(F_PUSHA, $1) ; }
 781         |  DOLLAR  D_ID
 782            { check_var($2) ;
 783              $$ = code_offset ;
 784              if ( is_local($2) )
 785              { code2op(L_PUSHI, $2->offset) ; }
 786              else code2(_PUSHI, $2->stval.cp) ;
 787
 788              CODE_FE_PUSHA() ;
 789            }
 790         |  DOLLAR  D_ID mark LBOX  args RBOX
 791            {
 792              if ( $5 > 1 )
 793              { code2op(A_CAT, $5) ; }
 794
 795              check_array($2) ;
 796              if( is_local($2) )
 797              { code2op(LAE_PUSHI, $2->offset) ; }
 798              else code2(AE_PUSHI, $2->stval.array) ;
 799
 800              CODE_FE_PUSHA()  ;
 801
 802              $$ = $3 ;
 803            }
 804         |  DOLLAR p_expr
 805            { $$ = $2 ;  CODE_FE_PUSHA() ; }
 806         |  LPAREN field RPAREN
 807            { $$ = $2 ; }
 808         ;
 809
 810 p_expr   :  field   %prec CAT /* removes field (++|--) sr conflict */
 811             { field_A2I() ; }
 812         ;
 813
 814 expr    :  field   ASSIGN   expr { code1(F_ASSIGN) ; }
 815         |  field   ADD_ASG  expr { code1(F_ADD_ASG) ; }
 816         |  field   SUB_ASG  expr { code1(F_SUB_ASG) ; }
 817         |  field   MUL_ASG  expr { code1(F_MUL_ASG) ; }
 818         |  field   DIV_ASG  expr { code1(F_DIV_ASG) ; }
 819         |  field   MOD_ASG  expr { code1(F_MOD_ASG) ; }
 820         |  field   POW_ASG  expr { code1(F_POW_ASG) ; }
 821         ;
 822
 823 /* split is handled different than a builtin because
 824    it takes an array and optionally a regular expression as args */
 825
 826 p_expr  :   split_front  split_back
 827             { code2(_BUILTIN, bi_split) ; }
 828         ;
 829
 830 split_front : SPLIT LPAREN expr COMMA ID
 831             { $$ = $3 ;
 832               check_array($5) ;
 833               code_array($5)  ;
 834             }
 835             ;
 836
 837 split_back  :   RPAREN
 838                 { code2(_PUSHI, &fs_shadow) ; }
 839             |   COMMA expr  RPAREN
 840                 {
 841                   if ( CDP($2) == code_ptr - 2 )
 842                   {
 843                     if ( code_ptr[-2].op == _MATCH0 )
 844                         RE_as_arg() ;
 845                     else
 846                     if ( code_ptr[-2].op == _PUSHS )
 847                     { CELL *cp = ZMALLOC(CELL) ;
 848
 849                       cp->type = C_STRING ;
 850                       cp->ptr = code_ptr[-1].ptr ;
 851                       cast_for_split(cp) ;
 852                       code_ptr[-2].op = _PUSHC ;
 853                       code_ptr[-1].ptr = (PTR) cp ;
 854                     }
 855                   }
 856                 }
 857             ;
 858
 859
 860
 861 /*  match(expr, RE) */
 862
 863 p_expr : MATCH_FUNC LPAREN expr COMMA re_arg RPAREN
 864         { $$ = $3 ;
 865           code2(_BUILTIN, bi_match) ;
 866         }
 867      ;
 868
 869
 870 re_arg   :   expr
 871              {
 872                INST *p1 = CDP($1) ;
 873
 874                if ( p1 == code_ptr - 2 )
 875                {
 876                  if ( p1->op == _MATCH0 ) RE_as_arg() ;
 877                  else
 878                  if ( p1->op == _PUSHS )
 879                  { CELL *cp = ZMALLOC(CELL) ;
 880
 881                    cp->type = C_STRING ;
 882                    cp->ptr = p1[1].ptr ;
 883                    cast_to_RE(cp) ;
 884                    p1->op = _PUSHC ;
 885                    p1[1].ptr = (PTR) cp ;
 886                  }
 887                }
 888              }
 889         ;
 890
 891
 892 /* exit_statement */
 893 statement      :  EXIT   separator
 894                     { $$ = code_offset ;
 895                       code1(_EXIT0) ; }
 896                |  EXIT   expr  separator
 897                     { $$ = $2 ; code1(_EXIT) ; }
 898         ;
 899
 900 return_statement :  RETURN   separator
 901                     { $$ = code_offset ;
 902                       code1(_RET0) ; }
 903                |  RETURN   expr  separator
 904                     { $$ = $2 ; code1(_RET) ; }
 905         ;
 906
 907 /* getline */
 908
 909 p_expr :  getline      %prec  GETLINE
 910           { $$ = code_offset ;
 911             code2(F_PUSHA, &field[0]) ;
 912             code1(_PUSHINT) ; code1(0) ;
 913             code2(_BUILTIN, bi_getline) ;
 914             getline_flag = 0 ;
 915           }
 916        |  getline  fvalue     %prec  GETLINE
 917           { $$ = $2 ;
 918             code1(_PUSHINT) ; code1(0) ;
 919             code2(_BUILTIN, bi_getline) ;
 920             getline_flag = 0 ;
 921           }
 922        |  getline_file  p_expr    %prec IO_IN
 923           { code1(_PUSHINT) ; code1(F_IN) ;
 924             code2(_BUILTIN, bi_getline) ;
 925             /* getline_flag already off in yylex() */
 926           }
 927        |  p_expr PIPE GETLINE
 928           { code2(F_PUSHA, &field[0]) ;
 929             code1(_PUSHINT) ; code1(PIPE_IN) ;
 930             code2(_BUILTIN, bi_getline) ;
 931           }
 932        |  p_expr PIPE GETLINE   fvalue
 933           {
 934             code1(_PUSHINT) ; code1(PIPE_IN) ;
 935             code2(_BUILTIN, bi_getline) ;
 936           }
 937        ;
 938
 939 getline :   GETLINE  { getline_flag = 1 ; } ;
 940
 941 fvalue  :   lvalue  |  field  ;
 942
 943 getline_file  :  getline  IO_IN
 944                  { $$ = code_offset ;
 945                    code2(F_PUSHA, field+0) ;
 946                  }
 947               |  getline fvalue IO_IN
 948                  { $$ = $2 ; }
 949               ;
 950
 951 /*==========================================
 952     sub and gsub
 953   ==========================================*/
 954
 955 p_expr  :  sub_or_gsub LPAREN re_arg COMMA  expr  sub_back
 956            {
 957              INST *p5 = CDP($5) ;
 958              INST *p6 = CDP($6) ;
 959
 960              if ( p6 - p5 == 2 && p5->op == _PUSHS  )
 961              { /* cast from STRING to REPL at compile time */
 962                CELL *cp = ZMALLOC(CELL) ;
 963                cp->type = C_STRING ;
 964                cp->ptr = p5[1].ptr ;
 965                cast_to_REPL(cp) ;
 966                p5->op = _PUSHC ;
 967                p5[1].ptr = (PTR) cp ;
 968              }
 969              code2(_BUILTIN, $1) ;
 970              $$ = $3 ;
 971            }
 972         ;
 973
 974 sub_or_gsub :  SUB  { $$ = bi_sub ; }
 975             |  GSUB { $$ = bi_gsub ; }
 976             ;
 977
 978
 979 sub_back    :   RPAREN    /* substitute into $0  */
 980                 { $$ = code_offset ;
 981                   code2(F_PUSHA, &field[0]) ;
 982                 }
 983
 984             |   COMMA fvalue  RPAREN
 985                 { $$ = $2 ; }
 986             ;
 987
 988 /*================================================
 989     user defined functions
 990  *=================================*/
 991
 992 function_def  :  funct_start  block
 993                  {
 994                    resize_fblock($1) ;
 995                    restore_ids() ;
 996                    switch_code_to_main() ;
 997                  }
 998               ;
 999
1000
1001 funct_start   :  funct_head  LPAREN  f_arglist  RPAREN
1002                  { eat_nl() ;
1003                    scope = SCOPE_FUNCT ;
1004                    active_funct = $1 ;
1005                    *main_code_p = active_code ;
1006
1007                    $1->nargs = $3 ;
1008                    if ( $3 )
1009                         $1->typev = (char *)
1010                         memset( zmalloc($3), ST_LOCAL_NONE, $3) ;
1011                    else $1->typev = (char *) 0 ;
1012
1013                    code_ptr = code_base =
1014                        (INST *) zmalloc(INST_BYTES(PAGESZ));
1015                    code_limit = code_base + PAGESZ ;
1016                    code_warn = code_limit - CODEWARN ;
1017                  }
1018               ;
1019
1020 funct_head    :  FUNCTION  ID
1021                  { FBLOCK  *fbp ;
1022
1023                    if ( $2->type == ST_NONE )
1024                    {
1025                          $2->type = ST_FUNCT ;
1026                          fbp = $2->stval.fbp =
1027                              (FBLOCK *) zmalloc(sizeof(FBLOCK)) ;
1028                          fbp->name = $2->name ;
1029                          fbp->code = (INST*) 0 ;
1030                    }
1031                    else
1032                    {
1033                          type_error( $2 ) ;
1034
1035                          /* this FBLOCK will not be put in
1036                             the symbol table */
1037                          fbp = (FBLOCK*) zmalloc(sizeof(FBLOCK)) ;
1038                          fbp->name = "" ;
1039                    }
1040                    $$ = fbp ;
1041                  }
1042
1043               |  FUNCTION  FUNCT_ID
1044                  { $$ = $2 ;
1045                    if ( $2->code )
1046                        compile_error("redefinition of %s" , $2->name) ;
1047                  }
1048               ;
1049
1050 f_arglist  :  /* empty */ { $$ = 0 ; }
1051            |  f_args
1052            ;
1053
1054 f_args     :  ID
1055               { $1 = save_id($1->name) ;
1056                 $1->type = ST_LOCAL_NONE ;
1057                 $1->offset = 0 ;
1058                 $$ = 1 ;
1059               }
1060            |  f_args  COMMA  ID
1061               { if ( is_local($3) )
1062                   compile_error("%s is duplicated in argument list",
1063                     $3->name) ;
1064                 else
1065                 { $3 = save_id($3->name) ;
1066                   $3->type = ST_LOCAL_NONE ;
1067                   $3->offset = $1 ;
1068                   $$ = $1 + 1 ;
1069                 }
1070               }
1071            ;
1072
1073 outside_error :  error
1074                  {  /* we may have to recover from a bungled function
1075                        definition */
1076                    /* can have local ids, before code scope
1077                       changes  */
1078                     restore_ids() ;
1079
1080                     switch_code_to_main() ;
1081                  }
1082              ;
1083
1084 /* a call to a user defined function */
1085
1086 p_expr  :  FUNCT_ID mark  call_args
1087            { $$ = $2 ;
1088              code2(_CALL, $1) ;
1089
1090              if ( $3 )  code1($3->arg_num+1) ;
1091              else  code1(0) ;
1092
1093              check_fcall($1, scope, code_move_level, active_funct,
1094                          $3, token_lineno) ;
1095            }
1096         ;
1097
1098 call_args  :   LPAREN   RPAREN
1099                { $$ = (CA_REC *) 0 ; }
1100            |   ca_front  ca_back
1101                { $$ = $2 ;
1102                  $$->link = $1 ;
1103                  $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
1104                }
1105            ;
1106
1107 /* The funny definition of ca_front with the COMMA bound to the ID is to
1108    force a shift to avoid a reduce/reduce conflict
1109    ID->id or ID->array
1110
1111    Or to avoid a decision, if the type of the ID has not yet been
1112    determined
1113 */
1114
1115 ca_front   :  LPAREN
1116               { $$ = (CA_REC *) 0 ; }
1117            |  ca_front  expr   COMMA
1118               { $$ = ZMALLOC(CA_REC) ;
1119                 $$->link = $1 ;
1120                 $$->type = CA_EXPR  ;
1121                 $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
1122                 $$->call_offset = code_offset ;
1123               }
1124            |  ca_front  ID   COMMA
1125               { $$ = ZMALLOC(CA_REC) ;
1126                 $$->link = $1 ;
1127                 $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
1128
1129                 code_call_id($$, $2) ;
1130               }
1131            ;
1132
1133 ca_back    :  expr   RPAREN
1134               { $$ = ZMALLOC(CA_REC) ;
1135                 $$->type = CA_EXPR ;
1136                 $$->call_offset = code_offset ;
1137               }
1138
1139            |  ID    RPAREN
1140               { $$ = ZMALLOC(CA_REC) ;
1141                 code_call_id($$, $1) ;
1142               }
1143            ;
1144
1145
1146
1147
1148 %%
1149
1150 /* resize the code for a user function */
1151
1152 static void  resize_fblock( fbp )
1153   FBLOCK *fbp ;
1154 {
1155   CODEBLOCK *p = ZMALLOC(CODEBLOCK) ;
1156   unsigned dummy ;
1157
1158   code2op(_RET0, _HALT) ;
1159         /* make sure there is always a return */
1160
1161   *p = active_code ;
1162   fbp->code = code_shrink(p, &dummy) ;
1163       /* code_shrink() zfrees p */
1164
1165   if ( dump_code_flag ) add_to_fdump_list(fbp) ;
1166 }
1167
1168
1169 /* convert FE_PUSHA  to  FE_PUSHI
1170    or F_PUSH to F_PUSHI
1171 */
1172
1173 static void  field_A2I()
1174 { CELL *cp ;
1175
1176   if ( code_ptr[-1].op == FE_PUSHA &&
1177        code_ptr[-1].ptr == (PTR) 0)
1178   /* On most architectures, the two tests are the same; a good
1179      compiler might eliminate one.  On LM_DOS, and possibly other
1180      segmented architectures, they are not */
1181   { code_ptr[-1].op = FE_PUSHI ; }
1182   else
1183   {
1184     cp = (CELL *) code_ptr[-1].ptr ;
1185
1186     if ( cp == field  ||
1187
1188 #ifdef  MSDOS
1189          SAMESEG(cp,field) &&
1190 #endif
1191          cp > NF && cp <= LAST_PFIELD )
1192     {
1193          code_ptr[-2].op = _PUSHI  ;
1194     }
1195     else if ( cp == NF )
1196     { code_ptr[-2].op = NF_PUSHI ; code_ptr-- ; }
1197
1198     else
1199     {
1200       code_ptr[-2].op = F_PUSHI ;
1201       code_ptr -> op = field_addr_to_index( code_ptr[-1].ptr ) ;
1202       code_ptr++ ;
1203     }
1204   }
1205 }
1206
1207 /* we've seen an ID in a context where it should be a VAR,
1208    check that's consistent with previous usage */
1209
1210 static void check_var( p )
1211   register SYMTAB *p ;
1212 {
1213       switch(p->type)
1214       {
1215         case ST_NONE : /* new id */
1216             p->type = ST_VAR ;
1217             p->stval.cp = ZMALLOC(CELL) ;
1218             p->stval.cp->type = C_NOINIT ;
1219             break ;
1220
1221         case ST_LOCAL_NONE :
1222             p->type = ST_LOCAL_VAR ;
1223             active_funct->typev[p->offset] = ST_LOCAL_VAR ;
1224             break ;
1225
1226         case ST_VAR :
1227         case ST_LOCAL_VAR :  break ;
1228
1229         default :
1230             type_error(p) ;
1231             break ;
1232       }
1233 }
1234
1235 /* we've seen an ID in a context where it should be an ARRAY,
1236    check that's consistent with previous usage */
1237 static  void  check_array(p)
1238   register SYMTAB *p ;
1239 {
1240       switch(p->type)
1241       {
1242         case ST_NONE :  /* a new array */
1243             p->type = ST_ARRAY ;
1244             p->stval.array = new_ARRAY() ;
1245             break ;
1246
1247         case  ST_ARRAY :
1248         case  ST_LOCAL_ARRAY :
1249             break ;
1250
1251         case  ST_LOCAL_NONE  :
1252             p->type = ST_LOCAL_ARRAY ;
1253             active_funct->typev[p->offset] = ST_LOCAL_ARRAY ;
1254             break ;
1255
1256         default : type_error(p) ; break ;
1257       }
1258 }
1259
1260 static void code_array(p)
1261   register SYMTAB *p ;
1262 {
1263   if ( is_local(p) ) code2op(LA_PUSHA, p->offset) ;
1264   else  code2(A_PUSHA, p->stval.array) ;
1265 }
1266
1267
1268 /* we've seen an ID as an argument to a user defined function */
1269
1270 static void  code_call_id( p, ip )
1271   register CA_REC *p ;
1272   register SYMTAB *ip ;
1273 { static CELL dummy ;
1274
1275   p->call_offset = code_offset ;
1276      /* This always get set now.  So that fcall:relocate_arglist
1277         works. */
1278
1279   switch( ip->type )
1280   {
1281     case  ST_VAR  :
1282             p->type = CA_EXPR ;
1283             code2(_PUSHI, ip->stval.cp) ;
1284             break ;
1285
1286     case  ST_LOCAL_VAR  :
1287             p->type = CA_EXPR ;
1288             code2op(L_PUSHI, ip->offset) ;
1289             break ;
1290
1291     case  ST_ARRAY  :
1292             p->type = CA_ARRAY ;
1293             code2(A_PUSHA, ip->stval.array) ;
1294             break ;
1295
1296     case  ST_LOCAL_ARRAY :
1297             p->type = CA_ARRAY ;
1298             code2op(LA_PUSHA, ip->offset) ;
1299             break ;
1300
1301     /* not enough info to code it now; it will have to
1302        be patched later */
1303
1304     case  ST_NONE :
1305             p->type = ST_NONE ;
1306             p->sym_p = ip ;
1307             code2(_PUSHI, &dummy) ;
1308             break ;
1309
1310     case  ST_LOCAL_NONE :
1311             p->type = ST_LOCAL_NONE ;
1312             p->type_p = & active_funct->typev[ip->offset] ;
1313             code2op(L_PUSHI, ip->offset) ;
1314             break ;
1315
1316
1317 #ifdef   DEBUG
1318     default :
1319             bozo("code_call_id") ;
1320 #endif
1321
1322   }
1323 }
1324
1325 /* an RE by itself was coded as _MATCH0 , change to
1326    push as an expression */
1327
1328 static void RE_as_arg()
1329 { CELL *cp = ZMALLOC(CELL) ;
1330
1331   code_ptr -= 2 ;
1332   cp->type = C_RE ;
1333   cp->ptr = code_ptr[1].ptr ;
1334   code2(_PUSHC, cp) ;
1335 }
1336
1337 /* reset the active_code back to the MAIN block */
1338 static void
1339 switch_code_to_main()
1340 {
1341    switch(scope)
1342    {
1343      case SCOPE_BEGIN :
1344         *begin_code_p = active_code ;
1345         active_code = *main_code_p ;
1346         break ;
1347
1348      case SCOPE_END :
1349         *end_code_p = active_code ;
1350         active_code = *main_code_p ;
1351         break ;
1352
1353      case SCOPE_FUNCT :
1354         active_code = *main_code_p ;
1355         break ;
1356
1357      case SCOPE_MAIN :
1358         break ;
1359    }
1360    active_funct = (FBLOCK*) 0 ;
1361    scope = SCOPE_MAIN ;
1362 }
1363
1364
1365 void
1366 parse()
1367 {
1368    if ( yyparse() || compile_error_count != 0 ) mawk_exit(2) ;
1369
1370    scan_cleanup() ;
1371    set_code() ;
1372    /* code must be set before call to resolve_fcalls() */
1373    if ( resolve_list )  resolve_fcalls() ;
1374
1375    if ( compile_error_count != 0 ) mawk_exit(2) ;
1376    if ( dump_code_flag ) { dump_code() ; mawk_exit(0) ; }
1377 }
1378