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