home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / perl / perly.y < prev    next >
Text File  |  1991-06-11  |  22KB  |  796 lines
  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 */
  796.