perly.y

   1 /* $RCSfile: perly.y,v $$Revision: 4.0.1.4 $$Date: 92/06/08 17:33:25 $
   2  *
   3  *    Copyright (c) 1991, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  * $Log:        perly.y,v $
   9  * Revision 4.0.1.4  92/06/08  17:33:25  lwall
  10  * patch20: one of the backdoors to expectterm was on the wrong reduction
  11  *
  12  * Revision 4.0.1.3  92/06/08  15:18:16  lwall
  13  * patch20: an expression may now start with a bareword
  14  * patch20: relaxed requirement for semicolon at the end of a block
  15  * patch20: added ... as variant on ..
  16  * patch20: fixed double debug break in foreach with implicit array assignment
  17  * patch20: if {block} {block} didn't work any more
  18  * patch20: deleted some minor memory leaks
  19  *
  20  * Revision 4.0.1.2  91/11/05  18:17:38  lwall
  21  * patch11: extra comma at end of list is now allowed in more places (Hi, Felix!)
  22  * patch11: once-thru blocks didn't display right in the debugger
  23  * patch11: debugger got confused over nested subroutine definitions
  24  *
  25  * Revision 4.0.1.1  91/06/07  11:42:34  lwall
  26  * patch4: new copyright notice
  27  *
  28  * Revision 4.0  91/03/20  01:38:40  lwall
  29  * 4.0 baseline.
  30  *
  31  */
  32
  33 %{
  34 #include "INTERN.h"
  35 #include "perl.h"
  36
  37 /*SUPPRESS 530*/
  38 /*SUPPRESS 593*/
  39 /*SUPPRESS 595*/
  40
  41 STAB *scrstab;
  42 ARG *arg4;      /* rarely used arguments to make_op() */
  43 ARG *arg5;
  44
  45 %}
  46
  47 %start prog
  48
  49 %union {
  50     int ival;
  51     char *cval;
  52     ARG *arg;
  53     CMD *cmdval;
  54     struct compcmd compval;
  55     STAB *stabval;
  56     FCMD *formval;
  57 }
  58
  59 %token <ival> '{' ')'
  60
  61 %token <cval> WORD LABEL
  62 %token <ival> APPEND OPEN SSELECT LOOPEX DOTDOT
  63 %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN
  64 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
  65 %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
  66 %token <ival> FUNC0 FUNC1 FUNC2 FUNC2x FUNC3 FUNC4 FUNC5 HSHFUN HSHFUN3
  67 %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
  68 %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER
  69 %token <formval> FORMLIST
  70 %token <stabval> REG ARYLEN ARY HSH STAR
  71 %token <arg> SUBST PATTERN
  72 %token <arg> RSTRING TRANS
  73
  74 %type <ival> prog decl format remember crp
  75 %type <cmdval> block lineseq line loop cond sideff nexpr else
  76 %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
  77 %type <arg> texpr listop bareword
  78 %type <cval> label
  79 %type <compval> compblock
  80
  81 %nonassoc <ival> LISTOP
  82 %left ','
  83 %right '='
  84 %right '?' ':'
  85 %nonassoc DOTDOT
  86 %left OROR
  87 %left ANDAND
  88 %left '|' '^'
  89 %left '&'
  90 %nonassoc EQOP
  91 %nonassoc RELOP
  92 %nonassoc <ival> UNIOP
  93 %nonassoc FILETEST
  94 %left LS RS
  95 %left ADDOP
  96 %left MULOP
  97 %left MATCH NMATCH
  98 %right '!' '~' UMINUS
  99 %right POW
 100 %nonassoc INC DEC
 101 %left '('
 102
 103 %% /* RULES */
 104
 105 prog    :       /* NULL */
 106                 {
 107 #if defined(YYDEBUG) && defined(DEBUGGING)
 108                     yydebug = (debug & 1);
 109                     expectterm = 2;
 110 #endif
 111                 }
 112         /*CONTINUED*/   lineseq
 113                         { if (in_eval)
 114                                 eval_root = block_head($2);
 115                             else
 116                                 main_root = block_head($2); }
 117         ;
 118
 119 compblock:      block CONTINUE block
 120                         { $$.comp_true = $1; $$.comp_alt = $3; }
 121         |       block else
 122                         { $$.comp_true = $1; $$.comp_alt = $2; }
 123         ;
 124
 125 else    :       /* NULL */
 126                         { $$ = Nullcmd; }
 127         |       ELSE block
 128                         { $$ = $2; }
 129         |       ELSIF '(' expr ')' compblock
 130                         { cmdline = $1;
 131                             $$ = make_ccmd(C_ELSIF,1,$3,$5); }
 132         ;
 133
 134 block   :       '{' remember lineseq '}'
 135                         { $$ = block_head($3);
 136                           if (cmdline > (line_t)$1)
 137                               cmdline = $1;
 138                           if (savestack->ary_fill > $2)
 139                             restorelist($2);
 140                           expectterm = 2; }
 141         ;
 142
 143 remember:       /* NULL */      /* in case they push a package name */
 144                         { $$ = savestack->ary_fill; }
 145         ;
 146
 147 lineseq :       /* NULL */
 148                         { $$ = Nullcmd; }
 149         |       lineseq line
 150                         { $$ = append_line($1,$2); }
 151         ;
 152
 153 line    :       decl
 154                         { $$ = Nullcmd; }
 155         |       label cond
 156                         { $$ = add_label($1,$2); }
 157         |       loop    /* loops add their own labels */
 158         |       label ';'
 159                         { if ($1 != Nullch) {
 160                               $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
 161                                   Nullarg, Nullarg) );
 162                             }
 163                             else {
 164                               $$ = Nullcmd;
 165                               cmdline = NOLINE;
 166                             }
 167                             expectterm = 2; }
 168         |       label sideff ';'
 169                         { $$ = add_label($1,$2);
 170                           expectterm = 2; }
 171         ;
 172
 173 sideff  :       error
 174                         { $$ = Nullcmd; }
 175         |       expr
 176                         { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
 177         |       expr IF expr
 178                         { $$ = addcond(
 179                                make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
 180         |       expr UNLESS expr
 181                         { $$ = addcond(invert(
 182                                make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
 183         |       expr WHILE expr
 184                         { $$ = addloop(
 185                                make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
 186         |       expr UNTIL expr
 187                         { $$ = addloop(invert(
 188                                make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
 189         ;
 190
 191 cond    :       IF '(' expr ')' compblock
 192                         { cmdline = $1;
 193                             $$ = make_icmd(C_IF,$3,$5); }
 194         |       UNLESS '(' expr ')' compblock
 195                         { cmdline = $1;
 196                             $$ = invert(make_icmd(C_IF,$3,$5)); }
 197         |       IF block compblock
 198                         { cmdline = $1;
 199                             $$ = make_icmd(C_IF,cmd_to_arg($2),$3); }
 200         |       UNLESS block compblock
 201                         { cmdline = $1;
 202                             $$ = invert(make_icmd(C_IF,cmd_to_arg($2),$3)); }
 203         ;
 204
 205 loop    :       label WHILE '(' texpr ')' compblock
 206                         { cmdline = $2;
 207                             $$ = wopt(add_label($1,
 208                             make_ccmd(C_WHILE,1,$4,$6) )); }
 209         |       label UNTIL '(' expr ')' compblock
 210                         { cmdline = $2;
 211                             $$ = wopt(add_label($1,
 212                             invert(make_ccmd(C_WHILE,1,$4,$6)) )); }
 213         |       label WHILE block compblock
 214                         { cmdline = $2;
 215                             $$ = wopt(add_label($1,
 216                             make_ccmd(C_WHILE, 1, cmd_to_arg($3),$4) )); }
 217         |       label UNTIL block compblock
 218                         { cmdline = $2;
 219                             $$ = wopt(add_label($1,
 220                             invert(make_ccmd(C_WHILE,1,cmd_to_arg($3),$4)) )); }
 221         |       label FOR REG '(' expr crp compblock
 222                         { cmdline = $2;
 223                             /*
 224                              * The following gobbledygook catches EXPRs that
 225                              * aren't explicit array refs and translates
 226                              *          foreach VAR (EXPR) {
 227                              * into
 228                              *          @ary = EXPR;
 229                              *          foreach VAR (@ary) {
 230                              * where @ary is a hidden array made by genstab().
 231                              * (Note that @ary may become a local array if
 232                              * it is determined that it might be called
 233                              * recursively.  See cmd_tosave().)
 234                              */
 235                             if ($5->arg_type != O_ARRAY) {
 236                                 scrstab = aadd(genstab());
 237                                 $$ = append_line(
 238                                     make_acmd(C_EXPR, Nullstab,
 239                                       l(make_op(O_ASSIGN,2,
 240                                         listish(make_op(O_ARRAY, 1,
 241                                           stab2arg(A_STAB,scrstab),
 242                                           Nullarg,Nullarg )),
 243                                         listish(make_list($5)),
 244                                         Nullarg)),
 245                                       Nullarg),
 246                                     wopt(over($3,add_label($1,
 247                                       make_ccmd(C_WHILE, 0,
 248                                         make_op(O_ARRAY, 1,
 249                                           stab2arg(A_STAB,scrstab),
 250                                           Nullarg,Nullarg ),
 251                                         $7)))));
 252                                 $$->c_line = $2;
 253                                 $$->c_head->c_line = $2;
 254                             }
 255                             else {
 256                                 $$ = wopt(over($3,add_label($1,
 257                                 make_ccmd(C_WHILE,1,$5,$7) )));
 258                             }
 259                         }
 260         |       label FOR '(' expr crp compblock
 261                         { cmdline = $2;
 262                             if ($4->arg_type != O_ARRAY) {
 263                                 scrstab = aadd(genstab());
 264                                 $$ = append_line(
 265                                     make_acmd(C_EXPR, Nullstab,
 266                                       l(make_op(O_ASSIGN,2,
 267                                         listish(make_op(O_ARRAY, 1,
 268                                           stab2arg(A_STAB,scrstab),
 269                                           Nullarg,Nullarg )),
 270                                         listish(make_list($4)),
 271                                         Nullarg)),
 272                                       Nullarg),
 273                                     wopt(over(defstab,add_label($1,
 274                                       make_ccmd(C_WHILE, 0,
 275                                         make_op(O_ARRAY, 1,
 276                                           stab2arg(A_STAB,scrstab),
 277                                           Nullarg,Nullarg ),
 278                                         $6)))));
 279                                 $$->c_line = $2;
 280                                 $$->c_head->c_line = $2;
 281                             }
 282                             else {      /* lisp, anyone? */
 283                                 $$ = wopt(over(defstab,add_label($1,
 284                                 make_ccmd(C_WHILE,1,$4,$6) )));
 285                             }
 286                         }
 287         |       label FOR '(' nexpr ';' texpr ';' nexpr ')' block
 288                         /* basically fake up an initialize-while lineseq */
 289                         {   yyval.compval.comp_true = $10;
 290                             yyval.compval.comp_alt = $8;
 291                             cmdline = $2;
 292                             $$ = append_line($4,wopt(add_label($1,
 293                                 make_ccmd(C_WHILE,1,$6,yyval.compval) ))); }
 294         |       label compblock /* a block is a loop that happens once */
 295                         { $$ = add_label($1,make_ccmd(C_BLOCK,1,Nullarg,$2)); }
 296         ;
 297
 298 nexpr   :       /* NULL */
 299                         { $$ = Nullcmd; }
 300         |       sideff
 301         ;
 302
 303 texpr   :       /* NULL means true */
 304                         { (void)scanstr("1",SCAN_DEF); $$ = yylval.arg; }
 305         |       expr
 306         ;
 307
 308 label   :       /* empty */
 309                         { $$ = Nullch; }
 310         |       LABEL
 311         ;
 312
 313 decl    :       format
 314                         { $$ = 0; }
 315         |       subrout
 316                         { $$ = 0; }
 317         |       package
 318                         { $$ = 0; }
 319         ;
 320
 321 format  :       FORMAT WORD '=' FORMLIST
 322                         { if (strEQ($2,"stdout"))
 323                             make_form(stabent("STDOUT",TRUE),$4);
 324                           else if (strEQ($2,"stderr"))
 325                             make_form(stabent("STDERR",TRUE),$4);
 326                           else
 327                             make_form(stabent($2,TRUE),$4);
 328                           Safefree($2); $2 = Nullch; }
 329         |       FORMAT '=' FORMLIST
 330                         { make_form(stabent("STDOUT",TRUE),$3); }
 331         ;
 332
 333 subrout :       SUB WORD block
 334                         { make_sub($2,$3);
 335                           cmdline = NOLINE;
 336                           if (savestack->ary_fill > $1)
 337                             restorelist($1); }
 338         ;
 339
 340 package :       PACKAGE WORD ';'
 341                         { char tmpbuf[256];
 342                           STAB *tmpstab;
 343
 344                           savehptr(&curstash);
 345                           saveitem(curstname);
 346                           str_set(curstname,$2);
 347                           sprintf(tmpbuf,"'_%s",$2);
 348                           tmpstab = stabent(tmpbuf,TRUE);
 349                           if (!stab_xhash(tmpstab))
 350                               stab_xhash(tmpstab) = hnew(0);
 351                           curstash = stab_xhash(tmpstab);
 352                           if (!curstash->tbl_name)
 353                               curstash->tbl_name = savestr($2);
 354                           curstash->tbl_coeffsize = 0;
 355                           Safefree($2); $2 = Nullch;
 356                           cmdline = NOLINE;
 357                           expectterm = 2;
 358                         }
 359         ;
 360
 361 cexpr   :       ',' expr
 362                         { $$ = $2; }
 363         ;
 364
 365 expr    :       expr ',' sexpr
 366                         { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
 367         |       sexpr
 368         ;
 369
 370 csexpr  :       ',' sexpr
 371                         { $$ = $2; }
 372         ;
 373
 374 sexpr   :       sexpr '=' sexpr
 375                         {   $1 = listish($1);
 376                             if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
 377                                 $1->arg_type = O_ITEM;  /* a local() */
 378                             if ($1->arg_type == O_LIST)
 379                                 $3 = listish($3);
 380                             $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
 381         |       sexpr POW '=' sexpr
 382                         { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
 383         |       sexpr MULOP '=' sexpr
 384                         { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
 385         |       sexpr ADDOP '=' sexpr
 386                         { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
 387         |       sexpr LS '=' sexpr
 388                         { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
 389         |       sexpr RS '=' sexpr
 390                         { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
 391         |       sexpr '&' '=' sexpr
 392                         { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
 393         |       sexpr '^' '=' sexpr
 394                         { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
 395         |       sexpr '|' '=' sexpr
 396                         { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
 397
 398
 399         |       sexpr POW sexpr
 400                         { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
 401         |       sexpr MULOP sexpr
 402                         { if ($2 == O_REPEAT)
 403                               $1 = listish($1);
 404                             $$ = make_op($2, 2, $1, $3, Nullarg);
 405                             if ($2 == O_REPEAT) {
 406                                 if ($$[1].arg_type != A_EXPR ||
 407                                   $$[1].arg_ptr.arg_arg->arg_type != O_LIST)
 408                                     $$[1].arg_flags &= ~AF_ARYOK;
 409                             } }
 410         |       sexpr ADDOP sexpr
 411                         { $$ = make_op($2, 2, $1, $3, Nullarg); }
 412         |       sexpr LS sexpr
 413                         { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
 414         |       sexpr RS sexpr
 415                         { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
 416         |       sexpr RELOP sexpr
 417                         { $$ = make_op($2, 2, $1, $3, Nullarg); }
 418         |       sexpr EQOP sexpr
 419                         { $$ = make_op($2, 2, $1, $3, Nullarg); }
 420         |       sexpr '&' sexpr
 421                         { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
 422         |       sexpr '^' sexpr
 423                         { $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
 424         |       sexpr '|' sexpr
 425                         { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
 426         |       sexpr DOTDOT sexpr
 427                         { arg4 = Nullarg;
 428                           $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg);
 429                           $$[0].arg_flags |= $2; }
 430         |       sexpr ANDAND sexpr
 431                         { $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
 432         |       sexpr OROR sexpr
 433                         { $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
 434         |       sexpr '?' sexpr ':' sexpr
 435                         { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
 436         |       sexpr MATCH sexpr
 437                         { $$ = mod_match(O_MATCH, $1, $3); }
 438         |       sexpr NMATCH sexpr
 439                         { $$ = mod_match(O_NMATCH, $1, $3); }
 440         |       term
 441                         { $$ = $1; }
 442         ;
 443
 444 term    :       '-' term %prec UMINUS
 445                         { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
 446         |       '+' term %prec UMINUS
 447                         { $$ = $2; }
 448         |       '!' term
 449                         { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
 450         |       '~' term
 451                         { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
 452         |       term INC
 453                         { $$ = addflags(1, AF_POST|AF_UP,
 454                             l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
 455         |       term DEC
 456                         { $$ = addflags(1, AF_POST,
 457                             l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
 458         |       INC term
 459                         { $$ = addflags(1, AF_PRE|AF_UP,
 460                             l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
 461         |       DEC term
 462                         { $$ = addflags(1, AF_PRE,
 463                             l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
 464         |       FILETEST WORD
 465                         { opargs[$1] = 0;       /* force it special */
 466                             $$ = make_op($1, 1,
 467                                 stab2arg(A_STAB,stabent($2,TRUE)),
 468                                 Nullarg, Nullarg);
 469                             Safefree($2); $2 = Nullch;
 470                         }
 471         |       FILETEST sexpr
 472                         { opargs[$1] = 1;
 473                             $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
 474         |       FILETEST
 475                         { opargs[$1] = ($1 != O_FTTTY);
 476                             $$ = make_op($1, 1,
 477                                 stab2arg(A_STAB,
 478                                   $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
 479                                 Nullarg, Nullarg); }
 480         |       LOCAL '(' expr crp
 481                         { $$ = l(localize(make_op(O_ASSIGN, 1,
 482                                 localize(listish(make_list($3))),
 483                                 Nullarg,Nullarg))); }
 484         |       '(' expr crp
 485                         { $$ = make_list($2); }
 486         |       '(' ')'
 487                         { $$ = make_list(Nullarg); }
 488         |       DO sexpr        %prec FILETEST
 489                         { $$ = make_op(O_DOFILE,2,$2,Nullarg,Nullarg);
 490                           allstabs = TRUE;}
 491         |       DO block        %prec '('
 492                         { $$ = cmd_to_arg($2); }
 493         |       REG     %prec '('
 494                         { $$ = stab2arg(A_STAB,$1); }
 495         |       STAR    %prec '('
 496                         { $$ = stab2arg(A_STAR,$1); }
 497         |       REG '[' expr ']'        %prec '('
 498                         { $$ = make_op(O_AELEM, 2,
 499                                 stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
 500         |       HSH     %prec '('
 501                         { $$ = make_op(O_HASH, 1,
 502                                 stab2arg(A_STAB,$1),
 503                                 Nullarg, Nullarg); }
 504         |       ARY     %prec '('
 505                         { $$ = make_op(O_ARRAY, 1,
 506                                 stab2arg(A_STAB,$1),
 507                                 Nullarg, Nullarg); }
 508         |       REG '{' expr ';' '}'    %prec '('
 509                         { $$ = make_op(O_HELEM, 2,
 510                                 stab2arg(A_STAB,hadd($1)),
 511                                 jmaybe($3),
 512                                 Nullarg);
 513                             expectterm = FALSE; }
 514         |       '(' expr crp '[' expr ']'       %prec '('
 515                         { $$ = make_op(O_LSLICE, 3,
 516                                 Nullarg,
 517                                 listish(make_list($5)),
 518                                 listish(make_list($2))); }
 519         |       '(' ')' '[' expr ']'    %prec '('
 520                         { $$ = make_op(O_LSLICE, 3,
 521                                 Nullarg,
 522                                 listish(make_list($4)),
 523                                 Nullarg); }
 524         |       ARY '[' expr ']'        %prec '('
 525                         { $$ = make_op(O_ASLICE, 2,
 526                                 stab2arg(A_STAB,aadd($1)),
 527                                 listish(make_list($3)),
 528                                 Nullarg); }
 529         |       ARY '{' expr ';' '}'    %prec '('
 530                         { $$ = make_op(O_HSLICE, 2,
 531                                 stab2arg(A_STAB,hadd($1)),
 532                                 listish(make_list($3)),
 533                                 Nullarg);
 534                             expectterm = FALSE; }
 535         |       DELETE REG '{' expr ';' '}'     %prec '('
 536                         { $$ = make_op(O_DELETE, 2,
 537                                 stab2arg(A_STAB,hadd($2)),
 538                                 jmaybe($4),
 539                                 Nullarg);
 540                             expectterm = FALSE; }
 541         |       DELETE '(' REG '{' expr ';' '}' ')'     %prec '('
 542                         { $$ = make_op(O_DELETE, 2,
 543                                 stab2arg(A_STAB,hadd($3)),
 544                                 jmaybe($4),
 545                                 Nullarg);
 546                             expectterm = FALSE; }
 547         |       ARYLEN  %prec '('
 548                         { $$ = stab2arg(A_ARYLEN,$1); }
 549         |       RSTRING %prec '('
 550                         { $$ = $1; }
 551         |       PATTERN %prec '('
 552                         { $$ = $1; }
 553         |       SUBST   %prec '('
 554                         { $$ = $1; }
 555         |       TRANS   %prec '('
 556                         { $$ = $1; }
 557         |       DO WORD '(' expr crp
 558                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 559                                 stab2arg(A_WORD,stabent($2,MULTI)),
 560                                 make_list($4),
 561                                 Nullarg); Safefree($2); $2 = Nullch;
 562                             $$->arg_flags |= AF_DEPR; }
 563         |       AMPER WORD '(' expr crp
 564                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 565                                 stab2arg(A_WORD,stabent($2,MULTI)),
 566                                 make_list($4),
 567                                 Nullarg); Safefree($2); $2 = Nullch; }
 568         |       DO WORD '(' ')'
 569                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 570                                 stab2arg(A_WORD,stabent($2,MULTI)),
 571                                 make_list(Nullarg),
 572                                 Nullarg);
 573                             Safefree($2); $2 = Nullch;
 574                             $$->arg_flags |= AF_DEPR; }
 575         |       AMPER WORD '(' ')'
 576                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 577                                 stab2arg(A_WORD,stabent($2,MULTI)),
 578                                 make_list(Nullarg),
 579                                 Nullarg);
 580                             Safefree($2); $2 = Nullch;
 581                         }
 582         |       AMPER WORD
 583                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 584                                 stab2arg(A_WORD,stabent($2,MULTI)),
 585                                 Nullarg,
 586                                 Nullarg);
 587                             Safefree($2); $2 = Nullch;
 588                         }
 589         |       DO REG '(' expr crp
 590                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 591                                 stab2arg(A_STAB,$2),
 592                                 make_list($4),
 593                                 Nullarg);
 594                             $$->arg_flags |= AF_DEPR; }
 595         |       AMPER REG '(' expr crp
 596                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 597                                 stab2arg(A_STAB,$2),
 598                                 make_list($4),
 599                                 Nullarg); }
 600         |       DO REG '(' ')'
 601                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 602                                 stab2arg(A_STAB,$2),
 603                                 make_list(Nullarg),
 604                                 Nullarg);
 605                             $$->arg_flags |= AF_DEPR; }
 606         |       AMPER REG '(' ')'
 607                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 608                                 stab2arg(A_STAB,$2),
 609                                 make_list(Nullarg),
 610                                 Nullarg); }
 611         |       AMPER REG
 612                         { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
 613                                 stab2arg(A_STAB,$2),
 614                                 Nullarg,
 615                                 Nullarg); }
 616         |       LOOPEX
 617                         { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
 618         |       LOOPEX WORD
 619                         { $$ = make_op($1,1,cval_to_arg($2),
 620                             Nullarg,Nullarg); }
 621         |       UNIOP
 622                         { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
 623         |       UNIOP block
 624                         { $$ = make_op($1,1,cmd_to_arg($2),Nullarg,Nullarg); }
 625         |       UNIOP sexpr
 626                         { $$ = make_op($1,1,$2,Nullarg,Nullarg); }
 627         |       SSELECT
 628                         { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
 629         |       SSELECT  WORD
 630                         { $$ = make_op(O_SELECT, 1,
 631                             stab2arg(A_WORD,stabent($2,TRUE)),
 632                             Nullarg,
 633                             Nullarg);
 634                             Safefree($2); $2 = Nullch; }
 635         |       SSELECT '(' handle ')'
 636                         { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
 637         |       SSELECT '(' sexpr csexpr csexpr csexpr ')'
 638                         { arg4 = $6;
 639                           $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
 640         |       OPEN WORD       %prec '('
 641                         { $$ = make_op(O_OPEN, 2,
 642                             stab2arg(A_WORD,stabent($2,TRUE)),
 643                             stab2arg(A_STAB,stabent($2,TRUE)),
 644                             Nullarg);
 645                             Safefree($2); $2 = Nullch;
 646                         }
 647         |       OPEN '(' WORD ')'
 648                         { $$ = make_op(O_OPEN, 2,
 649                             stab2arg(A_WORD,stabent($3,TRUE)),
 650                             stab2arg(A_STAB,stabent($3,TRUE)),
 651                             Nullarg);
 652                             Safefree($3); $3 = Nullch;
 653                         }
 654         |       OPEN '(' handle cexpr ')'
 655                         { $$ = make_op(O_OPEN, 2,
 656                             $3,
 657                             $4, Nullarg); }
 658         |       FILOP '(' handle ')'
 659                         { $$ = make_op($1, 1,
 660                             $3,
 661                             Nullarg, Nullarg); }
 662         |       FILOP WORD
 663                         { $$ = make_op($1, 1,
 664                             stab2arg(A_WORD,stabent($2,TRUE)),
 665                             Nullarg, Nullarg);
 666                           Safefree($2); $2 = Nullch; }
 667         |       FILOP REG
 668                         { $$ = make_op($1, 1,
 669                             stab2arg(A_STAB,$2),
 670                             Nullarg, Nullarg); }
 671         |       FILOP '(' ')'
 672                         { $$ = make_op($1, 1,
 673                             stab2arg(A_WORD,Nullstab),
 674                             Nullarg, Nullarg); }
 675         |       FILOP   %prec '('
 676                         { $$ = make_op($1, 0,
 677                             Nullarg, Nullarg, Nullarg); }
 678         |       FILOP2 '(' handle cexpr ')'
 679                         { $$ = make_op($1, 2, $3, $4, Nullarg); }
 680         |       FILOP3 '(' handle csexpr cexpr ')'
 681                         { $$ = make_op($1, 3, $3, $4, make_list($5)); }
 682         |       FILOP22 '(' handle ',' handle ')'
 683                         { $$ = make_op($1, 2, $3, $5, Nullarg); }
 684         |       FILOP4 '(' handle csexpr csexpr cexpr ')'
 685                         { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
 686         |       FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
 687                         { arg4 = $7; arg5 = $8;
 688                           $$ = make_op($1, 5, $3, $5, $6); }
 689         |       PUSH '(' aryword ',' expr crp
 690                         { $$ = make_op($1, 2,
 691                             $3,
 692                             make_list($5),
 693                             Nullarg); }
 694         |       POP aryword     %prec '('
 695                         { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
 696         |       POP '(' aryword ')'
 697                         { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
 698         |       SHIFT aryword   %prec '('
 699                         { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
 700         |       SHIFT '(' aryword ')'
 701                         { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
 702         |       SHIFT   %prec '('
 703                         { $$ = make_op(O_SHIFT, 1,
 704                             stab2arg(A_STAB,
 705                               aadd(stabent(subline ? "_" : "ARGV", TRUE))),
 706                             Nullarg, Nullarg); }
 707         |       SPLIT   %prec '('
 708                         {   static char p[]="/\\s+/";
 709                             char *oldend = bufend;
 710                             ARG *oldarg = yylval.arg;
 711
 712                             bufend=p+5;
 713                             (void)scanpat(p);
 714                             bufend=oldend;
 715                             $$ = make_split(defstab,yylval.arg,Nullarg);
 716                             yylval.arg = oldarg; }
 717         |       SPLIT '(' sexpr csexpr csexpr ')'
 718                         { $$ = mod_match(O_MATCH, $4,
 719                           make_split(defstab,$3,$5));}
 720         |       SPLIT '(' sexpr csexpr ')'
 721                         { $$ = mod_match(O_MATCH, $4,
 722                           make_split(defstab,$3,Nullarg) ); }
 723         |       SPLIT '(' sexpr ')'
 724                         { $$ = mod_match(O_MATCH,
 725                             stab2arg(A_STAB,defstab),
 726                             make_split(defstab,$3,Nullarg) ); }
 727         |       FLIST2 '(' sexpr cexpr ')'
 728                         { $$ = make_op($1, 2,
 729                             $3,
 730                             listish(make_list($4)),
 731                             Nullarg); }
 732         |       FLIST '(' expr crp
 733                         { $$ = make_op($1, 1,
 734                             make_list($3),
 735                             Nullarg,
 736                             Nullarg); }
 737         |       LVALFUN sexpr   %prec '('
 738                         { $$ = l(make_op($1, 1, fixl($1,$2),
 739                             Nullarg, Nullarg)); }
 740         |       LVALFUN
 741                         { $$ = l(make_op($1, 1,
 742                             stab2arg(A_STAB,defstab),
 743                             Nullarg, Nullarg)); }
 744         |       FUNC0
 745                         { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
 746         |       FUNC0 '(' ')'
 747                         { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
 748         |       FUNC1 '(' ')'
 749                         { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
 750         |       FUNC1 '(' expr ')'
 751                         { $$ = make_op($1, 1, $3, Nullarg, Nullarg); }
 752         |       FUNC2 '(' sexpr cexpr ')'
 753                         { $$ = make_op($1, 2, $3, $4, Nullarg);
 754                             if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
 755                                 fbmcompile($$[2].arg_ptr.arg_str,0); }
 756         |       FUNC2x '(' sexpr csexpr ')'
 757                         { $$ = make_op($1, 2, $3, $4, Nullarg);
 758                             if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
 759                                 fbmcompile($$[2].arg_ptr.arg_str,0); }
 760         |       FUNC2x '(' sexpr csexpr cexpr ')'
 761                         { $$ = make_op($1, 3, $3, $4, $5);
 762                             if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
 763                                 fbmcompile($$[2].arg_ptr.arg_str,0); }
 764         |       FUNC3 '(' sexpr csexpr cexpr ')'
 765                         { $$ = make_op($1, 3, $3, $4, $5); }
 766         |       FUNC4 '(' sexpr csexpr csexpr cexpr ')'
 767                         { arg4 = $6;
 768                           $$ = make_op($1, 4, $3, $4, $5); }
 769         |       FUNC5 '(' sexpr csexpr csexpr csexpr cexpr ')'
 770                         { arg4 = $6; arg5 = $7;
 771                           $$ = make_op($1, 5, $3, $4, $5); }
 772         |       HSHFUN '(' hshword ')'
 773                         { $$ = make_op($1, 1,
 774                                 $3,
 775                                 Nullarg,
 776                                 Nullarg); }
 777         |       HSHFUN hshword
 778                         { $$ = make_op($1, 1,
 779                                 $2,
 780                                 Nullarg,
 781                                 Nullarg); }
 782         |       HSHFUN3 '(' hshword csexpr cexpr ')'
 783                         { $$ = make_op($1, 3, $3, $4, $5); }
 784         |       bareword
 785         |       listop
 786         ;
 787
 788 listop  :       LISTOP
 789                         { $$ = make_op($1,2,
 790                                 stab2arg(A_WORD,Nullstab),
 791                                 stab2arg(A_STAB,defstab),
 792                                 Nullarg); }
 793         |       LISTOP expr
 794                         { $$ = make_op($1,2,
 795                                 stab2arg(A_WORD,Nullstab),
 796                                 maybelistish($1,make_list($2)),
 797                                 Nullarg); }
 798         |       LISTOP WORD
 799                         { $$ = make_op($1,2,
 800                                 stab2arg(A_WORD,stabent($2,TRUE)),
 801                                 stab2arg(A_STAB,defstab),
 802                                 Nullarg);
 803                             Safefree($2); $2 = Nullch;
 804                         }
 805         |       LISTOP WORD expr
 806                         { $$ = make_op($1,2,
 807                                 stab2arg(A_WORD,stabent($2,TRUE)),
 808                                 maybelistish($1,make_list($3)),
 809                                 Nullarg); Safefree($2); $2 = Nullch; }
 810         |       LISTOP REG expr
 811                         { $$ = make_op($1,2,
 812                                 stab2arg(A_STAB,$2),
 813                                 maybelistish($1,make_list($3)),
 814                                 Nullarg); }
 815         |       LISTOP block expr
 816                         { $$ = make_op($1,2,
 817                                 cmd_to_arg($2),
 818                                 maybelistish($1,make_list($3)),
 819                                 Nullarg); }
 820         ;
 821
 822 handle  :       WORD
 823                         { $$ = stab2arg(A_WORD,stabent($1,TRUE));
 824                           Safefree($1); $1 = Nullch;}
 825         |       sexpr
 826         ;
 827
 828 aryword :       WORD
 829                         { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
 830                             Safefree($1); $1 = Nullch; }
 831         |       ARY
 832                         { $$ = stab2arg(A_STAB,$1); }
 833         ;
 834
 835 hshword :       WORD
 836                         { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
 837                             Safefree($1); $1 = Nullch; }
 838         |       HSH
 839                         { $$ = stab2arg(A_STAB,$1); }
 840         ;
 841
 842 crp     :       ',' ')'
 843                         { $$ = 1; }
 844         |       ')'
 845                         { $$ = 0; }
 846         ;
 847
 848 /*
 849  * NOTE:  The following entry must stay at the end of the file so that
 850  * reduce/reduce conflicts resolve to it only if it's the only option.
 851  */
 852
 853 bareword:       WORD
 854                         { char *s;
 855                             $$ = op_new(1);
 856                             $$->arg_type = O_ITEM;
 857                             $$[1].arg_type = A_SINGLE;
 858                             $$[1].arg_ptr.arg_str = str_make($1,0);
 859                             for (s = $1; *s && isLOWER(*s); s++) ;
 860                             if (dowarn && !*s)
 861                                 warn(
 862                                   "\"%s\" may clash with future reserved word",
 863                                   $1 );
 864                             Safefree($1); $1 = Nullch;
 865                         }
 866                 ;
 867 %% /* PROGRAM */