perly.y

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