home *** CD-ROM | disk | FTP | other *** search
/ ftp.muug.mb.ca / 2014.06.ftp.muug.mb.ca.tar / ftp.muug.mb.ca / pub / src / perl / toke.c < prev    next >
C/C++ Source or Header  |  1992-04-11  |  58KB  |  2,574 lines

  1. /* $RCSfile: toke.c,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:45:51 $
  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:    toke.c,v $
  9.  * Revision 4.0.1.5  91/11/11  16:45:51  lwall
  10.  * patch19: default arg for shift was wrong after first subroutine definition
  11.  * 
  12.  * Revision 4.0.1.4  91/11/05  19:02:48  lwall
  13.  * patch11: \x and \c were subject to double interpretation in regexps
  14.  * patch11: prepared for ctype implementations that don't define isascii()
  15.  * patch11: nested list operators could miscount parens
  16.  * patch11: once-thru blocks didn't display right in the debugger
  17.  * patch11: sort eval "whatever" didn't work
  18.  * patch11: underscore is now allowed within literal octal and hex numbers
  19.  * 
  20.  * Revision 4.0.1.3  91/06/10  01:32:26  lwall
  21.  * patch10: m'$foo' now treats string as single quoted
  22.  * patch10: certain pattern optimizations were botched
  23.  * 
  24.  * Revision 4.0.1.2  91/06/07  12:05:56  lwall
  25.  * patch4: new copyright notice
  26.  * patch4: debugger lost track of lines in eval
  27.  * patch4: //o and s///o now optimize themselves fully at runtime
  28.  * patch4: added global modifier for pattern matches
  29.  * 
  30.  * Revision 4.0.1.1  91/04/12  09:18:18  lwall
  31.  * patch1: perl -de "print" wouldn't stop at the first statement
  32.  * 
  33.  * Revision 4.0  91/03/20  01:42:14  lwall
  34.  * 4.0 baseline.
  35.  * 
  36.  */
  37.  
  38. #include "EXTERN.h"
  39. #include "perl.h"
  40. #include "perly.h"
  41.  
  42. #ifdef I_FCNTL
  43. #include <fcntl.h>
  44. #endif
  45. #ifdef I_SYS_FILE
  46. #include <sys/file.h>
  47. #endif
  48.  
  49. #ifdef f_next
  50. #undef f_next
  51. #endif
  52.  
  53. /* which backslash sequences to keep in m// or s// */
  54.  
  55. static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}";
  56.  
  57. char *reparse;        /* if non-null, scanident found ${foo[$bar]} */
  58.  
  59. void checkcomma();
  60.  
  61. #ifdef CLINE
  62. #undef CLINE
  63. #endif
  64. #define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_line : cmdline))
  65.  
  66. #define META(c) ((c) | 128)
  67.  
  68. #define RETURN(retval) return (bufptr = s,(int)retval)
  69. #define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
  70. #define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
  71. #define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
  72. #define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
  73. #define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
  74. #define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
  75. #define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
  76. #define FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x)
  77. #define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
  78. #define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4)
  79. #define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5)
  80. #define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
  81. #define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
  82. #define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
  83. #define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
  84. #define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
  85. #define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
  86. #define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
  87. #define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
  88. #define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
  89. #define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
  90. #define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
  91. #define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
  92. #define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
  93. #define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
  94. #define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
  95.  
  96. /* This bit of chicanery makes a unary function followed by
  97.  * a parenthesis into a function with one argument, highest precedence.
  98.  */
  99. #define UNI(f) return(yylval.ival = f,expectterm = TRUE,bufptr = s, \
  100.     (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
  101.  
  102. /* This does similarly for list operators, merely by pretending that the
  103.  * paren came before the listop rather than after.
  104.  */
  105. #define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
  106.     (*s = (char) META('('), bufptr = oldbufptr, '(') : \
  107.     (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
  108. /* grandfather return to old style */
  109. #define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
  110.  
  111. char *
  112. skipspace(s)
  113. register char *s;
  114. {
  115.     while (s < bufend && isSPACE(*s))
  116.     s++;
  117.     return s;
  118. }
  119.  
  120. #ifdef CRIPPLED_CC
  121.  
  122. #undef UNI
  123. #undef LOP
  124. #define UNI(f) return uni(f,s)
  125. #define LOP(f) return lop(f,s)
  126.  
  127. int
  128. uni(f,s)
  129. int f;
  130. char *s;
  131. {
  132.     yylval.ival = f;
  133.     expectterm = TRUE;
  134.     bufptr = s;
  135.     if (*s == '(')
  136.     return FUNC1;
  137.     s = skipspace(s);
  138.     if (*s == '(')
  139.     return FUNC1;
  140.     else
  141.     return UNIOP;
  142. }
  143.  
  144. int
  145. lop(f,s)
  146. int f;
  147. char *s;
  148. {
  149.     CLINE;
  150.     if (*s != '(')
  151.     s = skipspace(s);
  152.     if (*s == '(') {
  153.     *s = META('(');
  154.     bufptr = oldbufptr;
  155.     return '(';
  156.     }
  157.     else {
  158.     yylval.ival=f;
  159.     expectterm = TRUE;
  160.     bufptr = s;
  161.     return LISTOP;
  162.     }
  163. }
  164.  
  165. #endif /* CRIPPLED_CC */
  166.  
  167. yylex()
  168. {
  169.     register char *s = bufptr;
  170.     register char *d;
  171.     register int tmp;
  172.     static bool in_format = FALSE;
  173.     static bool firstline = TRUE;
  174.     extern int yychar;        /* last token */
  175.  
  176.     oldoldbufptr = oldbufptr;
  177.     oldbufptr = s;
  178.  
  179.   retry:
  180. #ifdef YYDEBUG
  181.     if (debug & 1)
  182.     if (index(s,'\n'))
  183.         fprintf(stderr,"Tokener at %s",s);
  184.     else
  185.         fprintf(stderr,"Tokener at %s\n",s);
  186. #endif
  187. #ifdef BADSWITCH
  188.     if (*s & 128) {
  189.     if ((*s & 127) == '(') {
  190.         *s++ = '(';
  191.         oldbufptr = s;
  192.     }
  193.     else
  194.         warn("Unrecognized character \\%03o ignored", *s++ & 255);
  195.     goto retry;
  196.     }
  197. #endif
  198.     switch (*s) {
  199.     default:
  200.     if ((*s & 127) == '(') {
  201.         *s++ = '(';
  202.         oldbufptr = s;
  203.     }
  204.     else
  205.         warn("Unrecognized character \\%03o ignored", *s++ & 255);
  206.     goto retry;
  207.     case 4:
  208.     case 26:
  209.     goto fake_eof;            /* emulate EOF on ^D or ^Z */
  210.     case 0:
  211.     if (!rsfp)
  212.         RETURN(0);
  213.     if (s++ < bufend)
  214.         goto retry;            /* ignore stray nulls */
  215.     if (firstline) {
  216.         firstline = FALSE;
  217.         if (minus_n || minus_p || perldb) {
  218.         str_set(linestr,"");
  219.         if (perldb) {
  220.             char *getenv();
  221.             char *pdb = getenv("PERLDB");
  222.  
  223.             str_cat(linestr, pdb ? pdb : "require 'perldb.pl'");
  224.             str_cat(linestr, ";");
  225.         }
  226.         if (minus_n || minus_p) {
  227.             str_cat(linestr,"line: while (<>) {");
  228.             if (minus_l)
  229.             str_cat(linestr,"chop;");
  230.             if (minus_a)
  231.             str_cat(linestr,"@F=split(' ');");
  232.         }
  233.         oldoldbufptr = oldbufptr = s = str_get(linestr);
  234.         bufend = linestr->str_ptr + linestr->str_cur;
  235.         goto retry;
  236.         }
  237.     }
  238.     if (in_format) {
  239.         bufptr = bufend;
  240.         yylval.formval = load_format();
  241.         in_format = FALSE;
  242.         oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
  243.         bufend = linestr->str_ptr + linestr->str_cur;
  244.         OPERATOR(FORMLIST);
  245.     }
  246.     curcmd->c_line++;
  247. #ifdef CRYPTSCRIPT
  248.     cryptswitch();
  249. #endif /* CRYPTSCRIPT */
  250.     do {
  251.         if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
  252.           fake_eof:
  253.         if (rsfp) {
  254.             if (preprocess)
  255.             (void)mypclose(rsfp);
  256.             else if ((FILE*)rsfp == stdin)
  257.             clearerr(stdin);
  258.             else
  259.             (void)fclose(rsfp);
  260.             rsfp = Nullfp;
  261.         }
  262.         if (minus_n || minus_p) {
  263.             str_set(linestr,minus_p ? ";}continue{print" : "");
  264.             str_cat(linestr,";}");
  265.             oldoldbufptr = oldbufptr = s = str_get(linestr);
  266.             bufend = linestr->str_ptr + linestr->str_cur;
  267.             minus_n = minus_p = 0;
  268.             goto retry;
  269.         }
  270.         oldoldbufptr = oldbufptr = s = str_get(linestr);
  271.         str_set(linestr,"");
  272.         RETURN(';');    /* not infinite loop because rsfp is NULL now */
  273.         }
  274.         if (doextract && *linestr->str_ptr == '#')
  275.         doextract = FALSE;
  276.     } while (doextract);
  277.     oldoldbufptr = oldbufptr = bufptr = s;
  278.     if (perldb) {
  279.         STR *str = Str_new(85,0);
  280.  
  281.         str_sset(str,linestr);
  282.         astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
  283.     }
  284. #ifdef DEBUG
  285.     if (firstline) {
  286.         char *showinput();
  287.         s = showinput();
  288.     }
  289. #endif
  290.     bufend = linestr->str_ptr + linestr->str_cur;
  291.     if (curcmd->c_line == 1) {
  292.         if (*s == '#' && s[1] == '!') {
  293.         if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
  294.             char **newargv;
  295.             char *cmd;
  296.  
  297.             s += 2;
  298.             if (*s == ' ')
  299.             s++;
  300.             cmd = s;
  301.             while (s < bufend && !isSPACE(*s))
  302.             s++;
  303.             *s++ = '\0';
  304.             while (s < bufend && isSPACE(*s))
  305.             s++;
  306.             if (s < bufend) {
  307.             Newz(899,newargv,origargc+3,char*);
  308.             newargv[1] = s;
  309.             while (s < bufend && !isSPACE(*s))
  310.                 s++;
  311.             *s = '\0';
  312.             Copy(origargv+1, newargv+2, origargc+1, char*);
  313.             }
  314.             else
  315.             newargv = origargv;
  316.             newargv[0] = cmd;
  317.             execv(cmd,newargv);
  318.             fatal("Can't exec %s", cmd);
  319.         }
  320.         }
  321.         else {
  322.         while (s < bufend && isSPACE(*s))
  323.             s++;
  324.         if (*s == ':')    /* for csh's that have to exec sh scripts */
  325.             s++;
  326.         }
  327.     }
  328.     goto retry;
  329.     case ' ': case '\t': case '\f': case '\r': case 013:
  330.     s++;
  331.     goto retry;
  332.     case '#':
  333.     if (preprocess && s == str_get(linestr) &&
  334.            s[1] == ' ' && (isDIGIT(s[2]) || strnEQ(s+2,"line ",5)) ) {
  335.         while (*s && !isDIGIT(*s))
  336.         s++;
  337.         curcmd->c_line = atoi(s)-1;
  338.         while (isDIGIT(*s))
  339.         s++;
  340.         d = bufend;
  341.         while (s < d && isSPACE(*s)) s++;
  342.         s[strlen(s)-1] = '\0';    /* wipe out newline */
  343.         if (*s == '"') {
  344.         s++;
  345.         s[strlen(s)-1] = '\0';    /* wipe out trailing quote */
  346.         }
  347.         if (*s)
  348.         curcmd->c_filestab = fstab(s);
  349.         else
  350.         curcmd->c_filestab = fstab(origfilename);
  351.         oldoldbufptr = oldbufptr = s = str_get(linestr);
  352.     }
  353.     /* FALL THROUGH */
  354.     case '\n':
  355.     if (in_eval && !rsfp) {
  356.         d = bufend;
  357.         while (s < d && *s != '\n')
  358.         s++;
  359.         if (s < d)
  360.         s++;
  361.         if (in_format) {
  362.         bufptr = s;
  363.         yylval.formval = load_format();
  364.         in_format = FALSE;
  365.         oldoldbufptr = oldbufptr = s = bufptr + 1;
  366.         TERM(FORMLIST);
  367.         }
  368.         curcmd->c_line++;
  369.     }
  370.     else {
  371.         *s = '\0';
  372.         bufend = s;
  373.     }
  374.     goto retry;
  375.     case '-':
  376.     if (s[1] && isALPHA(s[1]) && !isALPHA(s[2])) {
  377.         s++;
  378.         switch (*s++) {
  379.         case 'r': FTST(O_FTEREAD);
  380.         case 'w': FTST(O_FTEWRITE);
  381.         case 'x': FTST(O_FTEEXEC);
  382.         case 'o': FTST(O_FTEOWNED);
  383.         case 'R': FTST(O_FTRREAD);
  384.         case 'W': FTST(O_FTRWRITE);
  385.         case 'X': FTST(O_FTREXEC);
  386.         case 'O': FTST(O_FTROWNED);
  387.         case 'e': FTST(O_FTIS);
  388.         case 'z': FTST(O_FTZERO);
  389.         case 's': FTST(O_FTSIZE);
  390.         case 'f': FTST(O_FTFILE);
  391.         case 'd': FTST(O_FTDIR);
  392.         case 'l': FTST(O_FTLINK);
  393.         case 'p': FTST(O_FTPIPE);
  394.         case 'S': FTST(O_FTSOCK);
  395.         case 'u': FTST(O_FTSUID);
  396.         case 'g': FTST(O_FTSGID);
  397.         case 'k': FTST(O_FTSVTX);
  398.         case 'b': FTST(O_FTBLK);
  399.         case 'c': FTST(O_FTCHR);
  400.         case 't': FTST(O_FTTTY);
  401.         case 'T': FTST(O_FTTEXT);
  402.         case 'B': FTST(O_FTBINARY);
  403.         case 'M': stabent("\024",TRUE); FTST(O_FTMTIME);
  404.         case 'A': stabent("\024",TRUE); FTST(O_FTATIME);
  405.         case 'C': stabent("\024",TRUE); FTST(O_FTCTIME);
  406.         default:
  407.         s -= 2;
  408.         break;
  409.         }
  410.     }
  411.     tmp = *s++;
  412.     if (*s == tmp) {
  413.         s++;
  414.         RETURN(DEC);
  415.     }
  416.     if (expectterm)
  417.         OPERATOR('-');
  418.     else
  419.         AOP(O_SUBTRACT);
  420.     case '+':
  421.     tmp = *s++;
  422.     if (*s == tmp) {
  423.         s++;
  424.         RETURN(INC);
  425.     }
  426.     if (expectterm)
  427.         OPERATOR('+');
  428.     else
  429.         AOP(O_ADD);
  430.  
  431.     case '*':
  432.     if (expectterm) {
  433.         s = scanident(s,bufend,tokenbuf);
  434.         yylval.stabval = stabent(tokenbuf,TRUE);
  435.         TERM(STAR);
  436.     }
  437.     tmp = *s++;
  438.     if (*s == tmp) {
  439.         s++;
  440.         OPERATOR(POW);
  441.     }
  442.     MOP(O_MULTIPLY);
  443.     case '%':
  444.     if (expectterm) {
  445.         s = scanident(s,bufend,tokenbuf);
  446.         yylval.stabval = hadd(stabent(tokenbuf,TRUE));
  447.         TERM(HSH);
  448.     }
  449.     s++;
  450.     MOP(O_MODULO);
  451.  
  452.     case '^':
  453.     case '~':
  454.     case '(':
  455.     case ',':
  456.     case ':':
  457.     case '[':
  458.     tmp = *s++;
  459.     OPERATOR(tmp);
  460.     case '{':
  461.     tmp = *s++;
  462.     yylval.ival = curcmd->c_line;
  463.     if (isSPACE(*s) || *s == '#')
  464.         cmdline = NOLINE;   /* invalidate current command line number */
  465.     OPERATOR(tmp);
  466.     case ';':
  467.     if (curcmd->c_line < cmdline)
  468.         cmdline = curcmd->c_line;
  469.     tmp = *s++;
  470.     OPERATOR(tmp);
  471.     case ')':
  472.     case ']':
  473.     tmp = *s++;
  474.     TERM(tmp);
  475.     case '}':
  476.     tmp = *s++;
  477.     RETURN(tmp);
  478.     case '&':
  479.     s++;
  480.     tmp = *s++;
  481.     if (tmp == '&')
  482.         OPERATOR(ANDAND);
  483.     s--;
  484.     if (expectterm) {
  485.         d = bufend;
  486.         while (s < d && isSPACE(*s))
  487.         s++;
  488.         if (isALPHA(*s) || *s == '_' || *s == '\'')
  489.         *(--s) = '\\';    /* force next ident to WORD */
  490.         OPERATOR(AMPER);
  491.     }
  492.     OPERATOR('&');
  493.     case '|':
  494.     s++;
  495.     tmp = *s++;
  496.     if (tmp == '|')
  497.         OPERATOR(OROR);
  498.     s--;
  499.     OPERATOR('|');
  500.     case '=':
  501.     s++;
  502.     tmp = *s++;
  503.     if (tmp == '=')
  504.         EOP(O_EQ);
  505.     if (tmp == '~')
  506.         OPERATOR(MATCH);
  507.     s--;
  508.     OPERATOR('=');
  509.     case '!':
  510.     s++;
  511.     tmp = *s++;
  512.     if (tmp == '=')
  513.         EOP(O_NE);
  514.     if (tmp == '~')
  515.         OPERATOR(NMATCH);
  516.     s--;
  517.     OPERATOR('!');
  518.     case '<':
  519.     if (expectterm) {
  520.         s = scanstr(s);
  521.         TERM(RSTRING);
  522.     }
  523.     s++;
  524.     tmp = *s++;
  525.     if (tmp == '<')
  526.         OPERATOR(LS);
  527.     if (tmp == '=') {
  528.         tmp = *s++;
  529.         if (tmp == '>')
  530.         EOP(O_NCMP);
  531.         s--;
  532.         ROP(O_LE);
  533.     }
  534.     s--;
  535.     ROP(O_LT);
  536.     case '>':
  537.     s++;
  538.     tmp = *s++;
  539.     if (tmp == '>')
  540.         OPERATOR(RS);
  541.     if (tmp == '=')
  542.         ROP(O_GE);
  543.     s--;
  544.     ROP(O_GT);
  545.  
  546. #define SNARFWORD \
  547.     d = tokenbuf; \
  548.     while (isALNUM(*s) || *s == '\'') \
  549.         *d++ = *s++; \
  550.     while (d[-1] == '\'') \
  551.         d--,s--; \
  552.     *d = '\0'; \
  553.     d = tokenbuf;
  554.  
  555.     case '$':
  556.     if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) {
  557.         s++;
  558.         s = scanident(s,bufend,tokenbuf);
  559.         yylval.stabval = aadd(stabent(tokenbuf,TRUE));
  560.         TERM(ARYLEN);
  561.     }
  562.     d = s;
  563.     s = scanident(s,bufend,tokenbuf);
  564.     if (reparse) {        /* turn ${foo[bar]} into ($foo[bar]) */
  565.       do_reparse:
  566.         s[-1] = ')';
  567.         s = d;
  568.         s[1] = s[0];
  569.         s[0] = '(';
  570.         goto retry;
  571.     }
  572.     yylval.stabval = stabent(tokenbuf,TRUE);
  573.     TERM(REG);
  574.  
  575.     case '@':
  576.     d = s;
  577.     s = scanident(s,bufend,tokenbuf);
  578.     if (reparse)
  579.         goto do_reparse;
  580.     yylval.stabval = aadd(stabent(tokenbuf,TRUE));
  581.     TERM(ARY);
  582.  
  583.     case '/':            /* may either be division or pattern */
  584.     case '?':            /* may either be conditional or pattern */
  585.     if (expectterm) {
  586.         s = scanpat(s);
  587.         TERM(PATTERN);
  588.     }
  589.     tmp = *s++;
  590.     if (tmp == '/')
  591.         MOP(O_DIVIDE);
  592.     OPERATOR(tmp);
  593.  
  594.     case '.':
  595.     if (!expectterm || !isDIGIT(s[1])) {
  596.         tmp = *s++;
  597.         if (*s == tmp) {
  598.         s++;
  599.         OPERATOR(DOTDOT);
  600.         }
  601.         AOP(O_CONCAT);
  602.     }
  603.     /* FALL THROUGH */
  604.     case '0': case '1': case '2': case '3': case '4':
  605.     case '5': case '6': case '7': case '8': case '9':
  606.     case '\'': case '"': case '`':
  607.     s = scanstr(s);
  608.     TERM(RSTRING);
  609.  
  610.     case '\\':    /* some magic to force next word to be a WORD */
  611.     s++;    /* used by do and sub to force a separate namespace */
  612.     /* FALL THROUGH */
  613.     case '_':
  614.     SNARFWORD;
  615.     if (d[1] == '_') {
  616.         if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) {
  617.         ARG *arg = op_new(1);
  618.  
  619.         yylval.arg = arg;
  620.         arg->arg_type = O_ITEM;
  621.         if (d[2] == 'L')
  622.             (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line);
  623.         else
  624.             strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr);
  625.         arg[1].arg_type = A_SINGLE;
  626.         arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
  627.         TERM(RSTRING);
  628.         }
  629.         else if (strEQ(d,"__END__")) {
  630. #ifndef TAINT
  631.         STAB *stab;
  632.         int fd;
  633.  
  634.         /*SUPPRESS 560*/
  635.         if (stab = stabent("DATA",FALSE)) {
  636.             stab->str_pok |= SP_MULTI;
  637.             stab_io(stab) = stio_new();
  638.             stab_io(stab)->ifp = rsfp;
  639. #if defined(HAS_FCNTL) && defined(F_SETFD)
  640.             fd = fileno(rsfp);
  641.             fcntl(fd,F_SETFD,fd >= 3);
  642. #endif
  643.             if (preprocess)
  644.             stab_io(stab)->type = '|';
  645.             else if ((FILE*)rsfp == stdin)
  646.             stab_io(stab)->type = '-';
  647.             else
  648.             stab_io(stab)->type = '<';
  649.             rsfp = Nullfp;
  650.         }
  651. #endif
  652.         goto fake_eof;
  653.         }
  654.     }
  655.     break;
  656.     case 'a': case 'A':
  657.     SNARFWORD;
  658.     if (strEQ(d,"alarm"))
  659.         UNI(O_ALARM);
  660.     if (strEQ(d,"accept"))
  661.         FOP22(O_ACCEPT);
  662.     if (strEQ(d,"atan2"))
  663.         FUN2(O_ATAN2);
  664.     break;
  665.     case 'b': case 'B':
  666.     SNARFWORD;
  667.     if (strEQ(d,"bind"))
  668.         FOP2(O_BIND);
  669.     if (strEQ(d,"binmode"))
  670.         FOP(O_BINMODE);
  671.     break;
  672.     case 'c': case 'C':
  673.     SNARFWORD;
  674.     if (strEQ(d,"chop"))
  675.         LFUN(O_CHOP);
  676.     if (strEQ(d,"continue"))
  677.         OPERATOR(CONTINUE);
  678.     if (strEQ(d,"chdir")) {
  679.         (void)stabent("ENV",TRUE);    /* may use HOME */
  680.         UNI(O_CHDIR);
  681.     }
  682.     if (strEQ(d,"close"))
  683.         FOP(O_CLOSE);
  684.     if (strEQ(d,"closedir"))
  685.         FOP(O_CLOSEDIR);
  686.     if (strEQ(d,"cmp"))
  687.         EOP(O_SCMP);
  688.     if (strEQ(d,"caller"))
  689.         UNI(O_CALLER);
  690.     if (strEQ(d,"crypt")) {
  691. #ifdef FCRYPT
  692.         static int cryptseen = 0;
  693.  
  694.         if (!cryptseen++)
  695.         init_des();
  696. #endif
  697.         FUN2(O_CRYPT);
  698.     }
  699.     if (strEQ(d,"chmod"))
  700.         LOP(O_CHMOD);
  701.     if (strEQ(d,"chown"))
  702.         LOP(O_CHOWN);
  703.     if (strEQ(d,"connect"))
  704.         FOP2(O_CONNECT);
  705.     if (strEQ(d,"cos"))
  706.         UNI(O_COS);
  707.     if (strEQ(d,"chroot"))
  708.         UNI(O_CHROOT);
  709.     break;
  710.     case 'd': case 'D':
  711.     SNARFWORD;
  712.     if (strEQ(d,"do")) {
  713.         d = bufend;
  714.         while (s < d && isSPACE(*s))
  715.         s++;
  716.         if (isALPHA(*s) || *s == '_')
  717.         *(--s) = '\\';    /* force next ident to WORD */
  718.         OPERATOR(DO);
  719.     }
  720.     if (strEQ(d,"die"))
  721.         LOP(O_DIE);
  722.     if (strEQ(d,"defined"))
  723.         LFUN(O_DEFINED);
  724.     if (strEQ(d,"delete"))
  725.         OPERATOR(DELETE);
  726.     if (strEQ(d,"dbmopen"))
  727.         HFUN3(O_DBMOPEN);
  728.     if (strEQ(d,"dbmclose"))
  729.         HFUN(O_DBMCLOSE);
  730.     if (strEQ(d,"dump"))
  731.         LOOPX(O_DUMP);
  732.     break;
  733.     case 'e': case 'E':
  734.     SNARFWORD;
  735.     if (strEQ(d,"else"))
  736.         OPERATOR(ELSE);
  737.     if (strEQ(d,"elsif")) {
  738.         yylval.ival = curcmd->c_line;
  739.         OPERATOR(ELSIF);
  740.     }
  741.     if (strEQ(d,"eq") || strEQ(d,"EQ"))
  742.         EOP(O_SEQ);
  743.     if (strEQ(d,"exit"))
  744.         UNI(O_EXIT);
  745.     if (strEQ(d,"eval")) {
  746.         allstabs = TRUE;        /* must initialize everything since */
  747.         UNI(O_EVAL);        /* we don't know what will be used */
  748.     }
  749.     if (strEQ(d,"eof"))
  750.         FOP(O_EOF);
  751.     if (strEQ(d,"exp"))
  752.         UNI(O_EXP);
  753.     if (strEQ(d,"each"))
  754.         HFUN(O_EACH);
  755.     if (strEQ(d,"exec")) {
  756.         set_csh();
  757.         LOP(O_EXEC_OP);
  758.     }
  759.     if (strEQ(d,"endhostent"))
  760.         FUN0(O_EHOSTENT);
  761.     if (strEQ(d,"endnetent"))
  762.         FUN0(O_ENETENT);
  763.     if (strEQ(d,"endservent"))
  764.         FUN0(O_ESERVENT);
  765.     if (strEQ(d,"endprotoent"))
  766.         FUN0(O_EPROTOENT);
  767.     if (strEQ(d,"endpwent"))
  768.         FUN0(O_EPWENT);
  769.     if (strEQ(d,"endgrent"))
  770.         FUN0(O_EGRENT);
  771.     break;
  772.     case 'f': case 'F':
  773.     SNARFWORD;
  774.     if (strEQ(d,"for") || strEQ(d,"foreach")) {
  775.         yylval.ival = curcmd->c_line;
  776.         OPERATOR(FOR);
  777.     }
  778.     if (strEQ(d,"format")) {
  779.         d = bufend;
  780.         while (s < d && isSPACE(*s))
  781.         s++;
  782.         if (isALPHA(*s) || *s == '_')
  783.         *(--s) = '\\';    /* force next ident to WORD */
  784.         in_format = TRUE;
  785.         allstabs = TRUE;        /* must initialize everything since */
  786.         OPERATOR(FORMAT);        /* we don't know what will be used */
  787.     }
  788.     if (strEQ(d,"fork"))
  789.         FUN0(O_FORK);
  790.     if (strEQ(d,"fcntl"))
  791.         FOP3(O_FCNTL);
  792.     if (strEQ(d,"fileno"))
  793.         FOP(O_FILENO);
  794.     if (strEQ(d,"flock"))
  795.         FOP2(O_FLOCK);
  796.     break;
  797.     case 'g': case 'G':
  798.     SNARFWORD;
  799.     if (strEQ(d,"gt") || strEQ(d,"GT"))
  800.         ROP(O_SGT);
  801.     if (strEQ(d,"ge") || strEQ(d,"GE"))
  802.         ROP(O_SGE);
  803.     if (strEQ(d,"grep"))
  804.         FL2(O_GREP);
  805.     if (strEQ(d,"goto"))
  806.         LOOPX(O_GOTO);
  807.     if (strEQ(d,"gmtime"))
  808.         UNI(O_GMTIME);
  809.     if (strEQ(d,"getc"))
  810.         FOP(O_GETC);
  811.     if (strnEQ(d,"get",3)) {
  812.         d += 3;
  813.         if (*d == 'p') {
  814.         if (strEQ(d,"ppid"))
  815.             FUN0(O_GETPPID);
  816.         if (strEQ(d,"pgrp"))
  817.             UNI(O_GETPGRP);
  818.         if (strEQ(d,"priority"))
  819.             FUN2(O_GETPRIORITY);
  820.         if (strEQ(d,"protobyname"))
  821.             UNI(O_GPBYNAME);
  822.         if (strEQ(d,"protobynumber"))
  823.             FUN1(O_GPBYNUMBER);
  824.         if (strEQ(d,"protoent"))
  825.             FUN0(O_GPROTOENT);
  826.         if (strEQ(d,"pwent"))
  827.             FUN0(O_GPWENT);
  828.         if (strEQ(d,"pwnam"))
  829.             FUN1(O_GPWNAM);
  830.         if (strEQ(d,"pwuid"))
  831.             FUN1(O_GPWUID);
  832.         if (strEQ(d,"peername"))
  833.             FOP(O_GETPEERNAME);
  834.         }
  835.         else if (*d == 'h') {
  836.         if (strEQ(d,"hostbyname"))
  837.             UNI(O_GHBYNAME);
  838.         if (strEQ(d,"hostbyaddr"))
  839.             FUN2(O_GHBYADDR);
  840.         if (strEQ(d,"hostent"))
  841.             FUN0(O_GHOSTENT);
  842.         }
  843.         else if (*d == 'n') {
  844.         if (strEQ(d,"netbyname"))
  845.             UNI(O_GNBYNAME);
  846.         if (strEQ(d,"netbyaddr"))
  847.             FUN2(O_GNBYADDR);
  848.         if (strEQ(d,"netent"))
  849.             FUN0(O_GNETENT);
  850.         }
  851.         else if (*d == 's') {
  852.         if (strEQ(d,"servbyname"))
  853.             FUN2(O_GSBYNAME);
  854.         if (strEQ(d,"servbyport"))
  855.             FUN2(O_GSBYPORT);
  856.         if (strEQ(d,"servent"))
  857.             FUN0(O_GSERVENT);
  858.         if (strEQ(d,"sockname"))
  859.             FOP(O_GETSOCKNAME);
  860.         if (strEQ(d,"sockopt"))
  861.             FOP3(O_GSOCKOPT);
  862.         }
  863.         else if (*d == 'g') {
  864.         if (strEQ(d,"grent"))
  865.             FUN0(O_GGRENT);
  866.         if (strEQ(d,"grnam"))
  867.             FUN1(O_GGRNAM);
  868.         if (strEQ(d,"grgid"))
  869.             FUN1(O_GGRGID);
  870.         }
  871.         else if (*d == 'l') {
  872.         if (strEQ(d,"login"))
  873.             FUN0(O_GETLOGIN);
  874.         }
  875.         d -= 3;
  876.     }
  877.     break;
  878.     case 'h': case 'H':
  879.     SNARFWORD;
  880.     if (strEQ(d,"hex"))
  881.         UNI(O_HEX);
  882.     break;
  883.     case 'i': case 'I':
  884.     SNARFWORD;
  885.     if (strEQ(d,"if")) {
  886.         yylval.ival = curcmd->c_line;
  887.         OPERATOR(IF);
  888.     }
  889.     if (strEQ(d,"index"))
  890.         FUN2x(O_INDEX);
  891.     if (strEQ(d,"int"))
  892.         UNI(O_INT);
  893.     if (strEQ(d,"ioctl"))
  894.         FOP3(O_IOCTL);
  895.     break;
  896.     case 'j': case 'J':
  897.     SNARFWORD;
  898.     if (strEQ(d,"join"))
  899.         FL2(O_JOIN);
  900.     break;
  901.     case 'k': case 'K':
  902.     SNARFWORD;
  903.     if (strEQ(d,"keys"))
  904.         HFUN(O_KEYS);
  905.     if (strEQ(d,"kill"))
  906.         LOP(O_KILL);
  907.     break;
  908.     case 'l': case 'L':
  909.     SNARFWORD;
  910.     if (strEQ(d,"last"))
  911.         LOOPX(O_LAST);
  912.     if (strEQ(d,"local"))
  913.         OPERATOR(LOCAL);
  914.     if (strEQ(d,"length"))
  915.         UNI(O_LENGTH);
  916.     if (strEQ(d,"lt") || strEQ(d,"LT"))
  917.         ROP(O_SLT);
  918.     if (strEQ(d,"le") || strEQ(d,"LE"))
  919.         ROP(O_SLE);
  920.     if (strEQ(d,"localtime"))
  921.         UNI(O_LOCALTIME);
  922.     if (strEQ(d,"log"))
  923.         UNI(O_LOG);
  924.     if (strEQ(d,"link"))
  925.         FUN2(O_LINK);
  926.     if (strEQ(d,"listen"))
  927.         FOP2(O_LISTEN);
  928.     if (strEQ(d,"lstat"))
  929.         FOP(O_LSTAT);
  930.     break;
  931.     case 'm': case 'M':
  932.     if (s[1] == '\'') {
  933.         d = "m";
  934.         s++;
  935.     }
  936.     else {
  937.         SNARFWORD;
  938.     }
  939.     if (strEQ(d,"m")) {
  940.         s = scanpat(s-1);
  941.         if (yylval.arg)
  942.         TERM(PATTERN);
  943.         else
  944.         RETURN(1);    /* force error */
  945.     }
  946.     switch (d[1]) {
  947.     case 'k':
  948.         if (strEQ(d,"mkdir"))
  949.         FUN2(O_MKDIR);
  950.         break;
  951.     case 's':
  952.         if (strEQ(d,"msgctl"))
  953.         FUN3(O_MSGCTL);
  954.         if (strEQ(d,"msgget"))
  955.         FUN2(O_MSGGET);
  956.         if (strEQ(d,"msgrcv"))
  957.         FUN5(O_MSGRCV);
  958.         if (strEQ(d,"msgsnd"))
  959.         FUN3(O_MSGSND);
  960.         break;
  961.     }
  962.     break;
  963.     case 'n': case 'N':
  964.     SNARFWORD;
  965.     if (strEQ(d,"next"))
  966.         LOOPX(O_NEXT);
  967.     if (strEQ(d,"ne") || strEQ(d,"NE"))
  968.         EOP(O_SNE);
  969.     break;
  970.     case 'o': case 'O':
  971.     SNARFWORD;
  972.     if (strEQ(d,"open"))
  973.         OPERATOR(OPEN);
  974.     if (strEQ(d,"ord"))
  975.         UNI(O_ORD);
  976.     if (strEQ(d,"oct"))
  977.         UNI(O_OCT);
  978.     if (strEQ(d,"opendir"))
  979.         FOP2(O_OPEN_DIR);
  980.     break;
  981.     case 'p': case 'P':
  982.     SNARFWORD;
  983.     if (strEQ(d,"print")) {
  984.         checkcomma(s,"filehandle");
  985.         LOP(O_PRINT);
  986.     }
  987.     if (strEQ(d,"printf")) {
  988.         checkcomma(s,"filehandle");
  989.         LOP(O_PRTF);
  990.     }
  991.     if (strEQ(d,"push")) {
  992.         yylval.ival = O_PUSH;
  993.         OPERATOR(PUSH);
  994.     }
  995.     if (strEQ(d,"pop"))
  996.         OPERATOR(POP);
  997.     if (strEQ(d,"pack"))
  998.         FL2(O_PACK);
  999.     if (strEQ(d,"package"))
  1000.         OPERATOR(PACKAGE);
  1001.     if (strEQ(d,"pipe"))
  1002.         FOP22(O_PIPE);
  1003.     break;
  1004.     case 'q': case 'Q':
  1005.     SNARFWORD;
  1006.     if (strEQ(d,"q")) {
  1007.         s = scanstr(s-1);
  1008.         TERM(RSTRING);
  1009.     }
  1010.     if (strEQ(d,"qq")) {
  1011.         s = scanstr(s-2);
  1012.         TERM(RSTRING);
  1013.     }
  1014.     if (strEQ(d,"qx")) {
  1015.         s = scanstr(s-2);
  1016.         TERM(RSTRING);
  1017.     }
  1018.     break;
  1019.     case 'r': case 'R':
  1020.     SNARFWORD;
  1021.     if (strEQ(d,"return"))
  1022.         OLDLOP(O_RETURN);
  1023.     if (strEQ(d,"require")) {
  1024.         allstabs = TRUE;        /* must initialize everything since */
  1025.         UNI(O_REQUIRE);        /* we don't know what will be used */
  1026.     }
  1027.     if (strEQ(d,"reset"))
  1028.         UNI(O_RESET);
  1029.     if (strEQ(d,"redo"))
  1030.         LOOPX(O_REDO);
  1031.     if (strEQ(d,"rename"))
  1032.         FUN2(O_RENAME);
  1033.     if (strEQ(d,"rand"))
  1034.         UNI(O_RAND);
  1035.     if (strEQ(d,"rmdir"))
  1036.         UNI(O_RMDIR);
  1037.     if (strEQ(d,"rindex"))
  1038.         FUN2x(O_RINDEX);
  1039.     if (strEQ(d,"read"))
  1040.         FOP3(O_READ);
  1041.     if (strEQ(d,"readdir"))
  1042.         FOP(O_READDIR);
  1043.     if (strEQ(d,"rewinddir"))
  1044.         FOP(O_REWINDDIR);
  1045.     if (strEQ(d,"recv"))
  1046.         FOP4(O_RECV);
  1047.     if (strEQ(d,"reverse"))
  1048.         LOP(O_REVERSE);
  1049.     if (strEQ(d,"readlink"))
  1050.         UNI(O_READLINK);
  1051.     break;
  1052.     case 's': case 'S':
  1053.     if (s[1] == '\'') {
  1054.         d = "s";
  1055.         s++;
  1056.     }
  1057.     else {
  1058.         SNARFWORD;
  1059.     }
  1060.     if (strEQ(d,"s")) {
  1061.         s = scansubst(s);
  1062.         if (yylval.arg)
  1063.         TERM(SUBST);
  1064.         else
  1065.         RETURN(1);    /* force error */
  1066.     }
  1067.     switch (d[1]) {
  1068.     case 'a':
  1069.     case 'b':
  1070.         break;
  1071.     case 'c':
  1072.         if (strEQ(d,"scalar"))
  1073.         UNI(O_SCALAR);
  1074.         break;
  1075.     case 'd':
  1076.         break;
  1077.     case 'e':
  1078.         if (strEQ(d,"select"))
  1079.         OPERATOR(SSELECT);
  1080.         if (strEQ(d,"seek"))
  1081.         FOP3(O_SEEK);
  1082.         if (strEQ(d,"semctl"))
  1083.         FUN4(O_SEMCTL);
  1084.         if (strEQ(d,"semget"))
  1085.         FUN3(O_SEMGET);
  1086.         if (strEQ(d,"semop"))
  1087.         FUN2(O_SEMOP);
  1088.         if (strEQ(d,"send"))
  1089.         FOP3(O_SEND);
  1090.         if (strEQ(d,"setpgrp"))
  1091.         FUN2(O_SETPGRP);
  1092.         if (strEQ(d,"setpriority"))
  1093.         FUN3(O_SETPRIORITY);
  1094.         if (strEQ(d,"sethostent"))
  1095.         FUN1(O_SHOSTENT);
  1096.         if (strEQ(d,"setnetent"))
  1097.         FUN1(O_SNETENT);
  1098.         if (strEQ(d,"setservent"))
  1099.         FUN1(O_SSERVENT);
  1100.         if (strEQ(d,"setprotoent"))
  1101.         FUN1(O_SPROTOENT);
  1102.         if (strEQ(d,"setpwent"))
  1103.         FUN0(O_SPWENT);
  1104.         if (strEQ(d,"setgrent"))
  1105.         FUN0(O_SGRENT);
  1106.         if (strEQ(d,"seekdir"))
  1107.         FOP2(O_SEEKDIR);
  1108.         if (strEQ(d,"setsockopt"))
  1109.         FOP4(O_SSOCKOPT);
  1110.         break;
  1111.     case 'f':
  1112.     case 'g':
  1113.         break;
  1114.     case 'h':
  1115.         if (strEQ(d,"shift"))
  1116.         TERM(SHIFT);
  1117.         if (strEQ(d,"shmctl"))
  1118.         FUN3(O_SHMCTL);
  1119.         if (strEQ(d,"shmget"))
  1120.         FUN3(O_SHMGET);
  1121.         if (strEQ(d,"shmread"))
  1122.         FUN4(O_SHMREAD);
  1123.         if (strEQ(d,"shmwrite"))
  1124.         FUN4(O_SHMWRITE);
  1125.         if (strEQ(d,"shutdown"))
  1126.         FOP2(O_SHUTDOWN);
  1127.         break;
  1128.     case 'i':
  1129.         if (strEQ(d,"sin"))
  1130.         UNI(O_SIN);
  1131.         break;
  1132.     case 'j':
  1133.     case 'k':
  1134.         break;
  1135.     case 'l':
  1136.         if (strEQ(d,"sleep"))
  1137.         UNI(O_SLEEP);
  1138.         break;
  1139.     case 'm':
  1140.     case 'n':
  1141.         break;
  1142.     case 'o':
  1143.         if (strEQ(d,"socket"))
  1144.         FOP4(O_SOCKET);
  1145.         if (strEQ(d,"socketpair"))
  1146.         FOP25(O_SOCKPAIR);
  1147.         if (strEQ(d,"sort")) {
  1148.         checkcomma(s,"subroutine name");
  1149.         d = bufend;
  1150.         while (s < d && isSPACE(*s)) s++;
  1151.         if (*s == ';' || *s == ')')        /* probably a close */
  1152.             fatal("sort is now a reserved word");
  1153.         if (isALPHA(*s) || *s == '_') {
  1154.             /*SUPPRESS 530*/
  1155.             for (d = s; isALNUM(*d); d++) ;
  1156.             strncpy(tokenbuf,s,d-s);
  1157.             if (strNE(tokenbuf,"keys") &&
  1158.             strNE(tokenbuf,"values") &&
  1159.             strNE(tokenbuf,"split") &&
  1160.             strNE(tokenbuf,"grep") &&
  1161.             strNE(tokenbuf,"readdir") &&
  1162.             strNE(tokenbuf,"unpack") &&
  1163.             strNE(tokenbuf,"do") &&
  1164.             strNE(tokenbuf,"eval") &&
  1165.             (d >= bufend || isSPACE(*d)) )
  1166.             *(--s) = '\\';    /* force next ident to WORD */
  1167.         }
  1168.         LOP(O_SORT);
  1169.         }
  1170.         break;
  1171.     case 'p':
  1172.         if (strEQ(d,"split"))
  1173.         TERM(SPLIT);
  1174.         if (strEQ(d,"sprintf"))
  1175.         FL(O_SPRINTF);
  1176.         if (strEQ(d,"splice")) {
  1177.         yylval.ival = O_SPLICE;
  1178.         OPERATOR(PUSH);
  1179.         }
  1180.         break;
  1181.     case 'q':
  1182.         if (strEQ(d,"sqrt"))
  1183.         UNI(O_SQRT);
  1184.         break;
  1185.     case 'r':
  1186.         if (strEQ(d,"srand"))
  1187.         UNI(O_SRAND);
  1188.         break;
  1189.     case 's':
  1190.         break;
  1191.     case 't':
  1192.         if (strEQ(d,"stat"))
  1193.         FOP(O_STAT);
  1194.         if (strEQ(d,"study")) {
  1195.         sawstudy++;
  1196.         LFUN(O_STUDY);
  1197.         }
  1198.         break;
  1199.     case 'u':
  1200.         if (strEQ(d,"substr"))
  1201.         FUN2x(O_SUBSTR);
  1202.         if (strEQ(d,"sub")) {
  1203.         yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
  1204.         savelong(&subline);
  1205.         saveitem(subname);
  1206.  
  1207.         subline = curcmd->c_line;
  1208.         d = bufend;
  1209.         while (s < d && isSPACE(*s))
  1210.             s++;
  1211.         if (isALPHA(*s) || *s == '_' || *s == '\'') {
  1212.             str_sset(subname,curstname);
  1213.             str_ncat(subname,"'",1);
  1214.             for (d = s+1; isALNUM(*d) || *d == '\''; d++)
  1215.             /*SUPPRESS 530*/
  1216.             ;
  1217.             if (d[-1] == '\'')
  1218.             d--;
  1219.             str_ncat(subname,s,d-s);
  1220.             *(--s) = '\\';    /* force next ident to WORD */
  1221.         }
  1222.         else
  1223.             str_set(subname,"?");
  1224.         OPERATOR(SUB);
  1225.         }
  1226.         break;
  1227.     case 'v':
  1228.     case 'w':
  1229.     case 'x':
  1230.         break;
  1231.     case 'y':
  1232.         if (strEQ(d,"system")) {
  1233.         set_csh();
  1234.         LOP(O_SYSTEM);
  1235.         }
  1236.         if (strEQ(d,"symlink"))
  1237.         FUN2(O_SYMLINK);
  1238.         if (strEQ(d,"syscall"))
  1239.         LOP(O_SYSCALL);
  1240.         if (strEQ(d,"sysread"))
  1241.         FOP3(O_SYSREAD);
  1242.         if (strEQ(d,"syswrite"))
  1243.         FOP3(O_SYSWRITE);
  1244.         break;
  1245.     case 'z':
  1246.         break;
  1247.     }
  1248.     break;
  1249.     case 't': case 'T':
  1250.     SNARFWORD;
  1251.     if (strEQ(d,"tr")) {
  1252.         s = scantrans(s);
  1253.         if (yylval.arg)
  1254.         TERM(TRANS);
  1255.         else
  1256.         RETURN(1);    /* force error */
  1257.     }
  1258.     if (strEQ(d,"tell"))
  1259.         FOP(O_TELL);
  1260.     if (strEQ(d,"telldir"))
  1261.         FOP(O_TELLDIR);
  1262.     if (strEQ(d,"time"))
  1263.         FUN0(O_TIME);
  1264.     if (strEQ(d,"times"))
  1265.         FUN0(O_TMS);
  1266.     if (strEQ(d,"truncate"))
  1267.         FOP2(O_TRUNCATE);
  1268.     break;
  1269.     case 'u': case 'U':
  1270.     SNARFWORD;
  1271.     if (strEQ(d,"using"))
  1272.         OPERATOR(USING);
  1273.     if (strEQ(d,"until")) {
  1274.         yylval.ival = curcmd->c_line;
  1275.         OPERATOR(UNTIL);
  1276.     }
  1277.     if (strEQ(d,"unless")) {
  1278.         yylval.ival = curcmd->c_line;
  1279.         OPERATOR(UNLESS);
  1280.     }
  1281.     if (strEQ(d,"unlink"))
  1282.         LOP(O_UNLINK);
  1283.     if (strEQ(d,"undef"))
  1284.         LFUN(O_UNDEF);
  1285.     if (strEQ(d,"unpack"))
  1286.         FUN2(O_UNPACK);
  1287.     if (strEQ(d,"utime"))
  1288.         LOP(O_UTIME);
  1289.     if (strEQ(d,"umask"))
  1290.         UNI(O_UMASK);
  1291.     if (strEQ(d,"unshift")) {
  1292.         yylval.ival = O_UNSHIFT;
  1293.         OPERATOR(PUSH);
  1294.     }
  1295.     break;
  1296.     case 'v': case 'V':
  1297.     SNARFWORD;
  1298.     if (strEQ(d,"values"))
  1299.         HFUN(O_VALUES);
  1300.     if (strEQ(d,"vec")) {
  1301.         sawvec = TRUE;
  1302.         FUN3(O_VEC);
  1303.     }
  1304.     break;
  1305.     case 'w': case 'W':
  1306.     SNARFWORD;
  1307.     if (strEQ(d,"while")) {
  1308.         yylval.ival = curcmd->c_line;
  1309.         OPERATOR(WHILE);
  1310.     }
  1311.     if (strEQ(d,"warn"))
  1312.         LOP(O_WARN);
  1313.     if (strEQ(d,"wait"))
  1314.         FUN0(O_WAIT);
  1315.     if (strEQ(d,"waitpid"))
  1316.         FUN2(O_WAITPID);
  1317.     if (strEQ(d,"wantarray")) {
  1318.         yylval.arg = op_new(1);
  1319.         yylval.arg->arg_type = O_ITEM;
  1320.         yylval.arg[1].arg_type = A_WANTARRAY;
  1321.         TERM(RSTRING);
  1322.     }
  1323.     if (strEQ(d,"write"))
  1324.         FOP(O_WRITE);
  1325.     break;
  1326.     case 'x': case 'X':
  1327.     SNARFWORD;
  1328.     if (!expectterm && strEQ(d,"x"))
  1329.         MOP(O_REPEAT);
  1330.     break;
  1331.     case 'y': case 'Y':
  1332.     if (s[1] == '\'') {
  1333.         d = "y";
  1334.         s++;
  1335.     }
  1336.     else {
  1337.         SNARFWORD;
  1338.     }
  1339.     if (strEQ(d,"y")) {
  1340.         s = scantrans(s);
  1341.         TERM(TRANS);
  1342.     }
  1343.     break;
  1344.     case 'z': case 'Z':
  1345.     SNARFWORD;
  1346.     break;
  1347.     }
  1348.     yylval.cval = savestr(d);
  1349.     expectterm = FALSE;
  1350.     if (oldoldbufptr && oldoldbufptr < bufptr) {
  1351.     while (isSPACE(*oldoldbufptr))
  1352.         oldoldbufptr++;
  1353.     if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
  1354.         expectterm = TRUE;
  1355.     else if (*oldoldbufptr == 's' && strnEQ(oldoldbufptr,"sort",4))
  1356.         expectterm = TRUE;
  1357.     }
  1358.     return (CLINE, bufptr = s, (int)WORD);
  1359. }
  1360.  
  1361. void
  1362. checkcomma(s,what)
  1363. register char *s;
  1364. char *what;
  1365. {
  1366.     char *someword;
  1367.  
  1368.     if (*s == '(')
  1369.     s++;
  1370.     while (s < bufend && isSPACE(*s))
  1371.     s++;
  1372.     if (isALPHA(*s) || *s == '_') {
  1373.     someword = s++;
  1374.     while (isALNUM(*s))
  1375.         s++;
  1376.     while (s < bufend && isSPACE(*s))
  1377.         s++;
  1378.     if (*s == ',') {
  1379.         *s = '\0';
  1380.         someword = instr(
  1381.           "tell eof times getlogin wait length shift umask getppid \
  1382.           cos exp int log rand sin sqrt ord wantarray",
  1383.           someword);
  1384.         *s = ',';
  1385.         if (someword)
  1386.         return;
  1387.         fatal("No comma allowed after %s", what);
  1388.     }
  1389.     }
  1390. }
  1391.  
  1392. char *
  1393. scanident(s,send,dest)
  1394. register char *s;
  1395. register char *send;
  1396. char *dest;
  1397. {
  1398.     register char *d;
  1399.     int brackets = 0;
  1400.  
  1401.     reparse = Nullch;
  1402.     s++;
  1403.     d = dest;
  1404.     if (isDIGIT(*s)) {
  1405.     while (isDIGIT(*s))
  1406.         *d++ = *s++;
  1407.     }
  1408.     else {
  1409.     while (isALNUM(*s) || *s == '\'')
  1410.         *d++ = *s++;
  1411.     }
  1412.     while (d > dest+1 && d[-1] == '\'')
  1413.     d--,s--;
  1414.     *d = '\0';
  1415.     d = dest;
  1416.     if (!*d) {
  1417.     *d = *s++;
  1418.     if (*d == '{' /* } */ ) {
  1419.         d = dest;
  1420.         brackets++;
  1421.         while (s < send && brackets) {
  1422.         if (!reparse && (d == dest || (*s && isALNUM(*s) ))) {
  1423.             *d++ = *s++;
  1424.             continue;
  1425.         }
  1426.         else if (!reparse)
  1427.             reparse = s;
  1428.         switch (*s++) {
  1429.         /* { */
  1430.         case '}':
  1431.             brackets--;
  1432.             if (reparse && reparse == s - 1)
  1433.             reparse = Nullch;
  1434.             break;
  1435.         case '{':   /* } */
  1436.             brackets++;
  1437.             break;
  1438.         }
  1439.         }
  1440.         *d = '\0';
  1441.         d = dest;
  1442.     }
  1443.     else
  1444.         d[1] = '\0';
  1445.     }
  1446.     if (*d == '^' && (isUPPER(*s) || index("[\\]^_?", *s))) {
  1447. #ifdef DEBUGGING
  1448.     if (*s == 'D')
  1449.         debug |= 32768;
  1450. #endif
  1451.     *d = *s++ ^ 64;
  1452.     }
  1453.     return s;
  1454. }
  1455.  
  1456. void
  1457. scanconst(spat,string,len)
  1458. SPAT *spat;
  1459. char *string;
  1460. int len;
  1461. {
  1462.     register STR *tmpstr;
  1463.     register char *t;
  1464.     register char *d;
  1465.     register char *e;
  1466.     char *origstring = string;
  1467.     static char *vert = "|";
  1468.  
  1469.     if (ninstr(string, string+len, vert, vert+1))
  1470.     return;
  1471.     if (*string == '^')
  1472.     string++, len--;
  1473.     tmpstr = Str_new(86,len);
  1474.     str_nset(tmpstr,string,len);
  1475.     t = str_get(tmpstr);
  1476.     e = t + len;
  1477.     tmpstr->str_u.str_useful = 100;
  1478.     for (d=t; d < e; ) {
  1479.     switch (*d) {
  1480.     case '{':
  1481.         if (isDIGIT(d[1]))
  1482.         e = d;
  1483.         else
  1484.         goto defchar;
  1485.         break;
  1486.     case '.': case '[': case '$': case '(': case ')': case '|': case '+':
  1487.     case '^':
  1488.         e = d;
  1489.         break;
  1490.     case '\\':
  1491.         if (d[1] && index("wWbB0123456789sSdDlLuUExc",d[1])) {
  1492.         e = d;
  1493.         break;
  1494.         }
  1495.         (void)bcopy(d+1,d,e-d);
  1496.         e--;
  1497.         switch(*d) {
  1498.         case 'n':
  1499.         *d = '\n';
  1500.         break;
  1501.         case 't':
  1502.         *d = '\t';
  1503.         break;
  1504.         case 'f':
  1505.         *d = '\f';
  1506.         break;
  1507.         case 'r':
  1508.         *d = '\r';
  1509.         break;
  1510.         case 'e':
  1511.         *d = '\033';
  1512.         break;
  1513.         case 'a':
  1514.         *d = '\007';
  1515.         break;
  1516.         }
  1517.         /* FALL THROUGH */
  1518.     default:
  1519.       defchar:
  1520.         if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
  1521.         e = d;
  1522.         break;
  1523.         }
  1524.         d++;
  1525.     }
  1526.     }
  1527.     if (d == t) {
  1528.     str_free(tmpstr);
  1529.     return;
  1530.     }
  1531.     *d = '\0';
  1532.     tmpstr->str_cur = d - t;
  1533.     if (d == t+len)
  1534.     spat->spat_flags |= SPAT_ALL;
  1535.     if (*origstring != '^')
  1536.     spat->spat_flags |= SPAT_SCANFIRST;
  1537.     spat->spat_short = tmpstr;
  1538.     spat->spat_slen = d - t;
  1539. }
  1540.  
  1541. char *
  1542. scanpat(s)
  1543. register char *s;
  1544. {
  1545.     register SPAT *spat;
  1546.     register char *d;
  1547.     register char *e;
  1548.     int len;
  1549.     SPAT savespat;
  1550.     STR *str = Str_new(93,0);
  1551.     char delim;
  1552.  
  1553.     Newz(801,spat,1,SPAT);
  1554.     spat->spat_next = curstash->tbl_spatroot;    /* link into spat list */
  1555.     curstash->tbl_spatroot = spat;
  1556.  
  1557.     switch (*s++) {
  1558.     case 'm':
  1559.     s++;
  1560.     break;
  1561.     case '/':
  1562.     break;
  1563.     case '?':
  1564.     spat->spat_flags |= SPAT_ONCE;
  1565.     break;
  1566.     default:
  1567.     fatal("panic: scanpat");
  1568.     }
  1569.     s = str_append_till(str,s,bufend,s[-1],patleave);
  1570.     if (s >= bufend) {
  1571.     str_free(str);
  1572.     yyerror("Search pattern not terminated");
  1573.     yylval.arg = Nullarg;
  1574.     return s;
  1575.     }
  1576.     delim = *s++;
  1577.     while (*s == 'i' || *s == 'o' || *s == 'g') {
  1578.     if (*s == 'i') {
  1579.         s++;
  1580.         sawi = TRUE;
  1581.         spat->spat_flags |= SPAT_FOLD;
  1582.     }
  1583.     if (*s == 'o') {
  1584.         s++;
  1585.         spat->spat_flags |= SPAT_KEEP;
  1586.     }
  1587.     if (*s == 'g') {
  1588.         s++;
  1589.         spat->spat_flags |= SPAT_GLOBAL;
  1590.     }
  1591.     }
  1592.     len = str->str_cur;
  1593.     e = str->str_ptr + len;
  1594.     if (delim == '\'')
  1595.     d = e;
  1596.     else
  1597.     d = str->str_ptr;
  1598.     for (; d < e; d++) {
  1599.     if (*d == '\\')
  1600.         d++;
  1601.     else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
  1602.          (*d == '@')) {
  1603.         register ARG *arg;
  1604.  
  1605.         spat->spat_runtime = arg = op_new(1);
  1606.         arg->arg_type = O_ITEM;
  1607.         arg[1].arg_type = A_DOUBLE;
  1608.         arg[1].arg_ptr.arg_str = str_smake(str);
  1609.         d = scanident(d,bufend,buf);
  1610.         (void)stabent(buf,TRUE);        /* make sure it's created */
  1611.         for (; d < e; d++) {
  1612.         if (*d == '\\')
  1613.             d++;
  1614.         else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') {
  1615.             d = scanident(d,bufend,buf);
  1616.             (void)stabent(buf,TRUE);
  1617.         }
  1618.         else if (*d == '@') {
  1619.             d = scanident(d,bufend,buf);
  1620.             if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
  1621.               strEQ(buf,"SIG") || strEQ(buf,"INC"))
  1622.             (void)stabent(buf,TRUE);
  1623.         }
  1624.         }
  1625.         goto got_pat;        /* skip compiling for now */
  1626.     }
  1627.     }
  1628.     if (spat->spat_flags & SPAT_FOLD)
  1629. #ifdef STRUCTCOPY
  1630.     savespat = *spat;
  1631. #else
  1632.     (void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT));
  1633. #endif
  1634.     scanconst(spat,str->str_ptr,len);
  1635.     if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
  1636.     fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
  1637.     spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
  1638.         spat->spat_flags & SPAT_FOLD);
  1639.         /* Note that this regexp can still be used if someone says
  1640.          * something like /a/ && s//b/;  so we can't delete it.
  1641.          */
  1642.     }
  1643.     else {
  1644.     if (spat->spat_flags & SPAT_FOLD)
  1645. #ifdef STRUCTCOPY
  1646.         *spat = savespat;
  1647. #else
  1648.         (void)bcopy((char *)&savespat, (char *)spat, sizeof(SPAT));
  1649. #endif
  1650.     if (spat->spat_short)
  1651.         fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
  1652.     spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
  1653.         spat->spat_flags & SPAT_FOLD);
  1654.     hoistmust(spat);
  1655.     }
  1656.   got_pat:
  1657.     str_free(str);
  1658.     yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
  1659.     return s;
  1660. }
  1661.  
  1662. char *
  1663. scansubst(s)
  1664. register char *s;
  1665. {
  1666.     register SPAT *spat;
  1667.     register char *d;
  1668.     register char *e;
  1669.     int len;
  1670.     STR *str = Str_new(93,0);
  1671.  
  1672.     Newz(802,spat,1,SPAT);
  1673.     spat->spat_next = curstash->tbl_spatroot;    /* link into spat list */
  1674.     curstash->tbl_spatroot = spat;
  1675.  
  1676.     s = str_append_till(str,s+1,bufend,*s,patleave);
  1677.     if (s >= bufend) {
  1678.     str_free(str);
  1679.     yyerror("Substitution pattern not terminated");
  1680.     yylval.arg = Nullarg;
  1681.     return s;
  1682.     }
  1683.     len = str->str_cur;
  1684.     e = str->str_ptr + len;
  1685.     for (d = str->str_ptr; d < e; d++) {
  1686.     if (*d == '\\')
  1687.         d++;
  1688.     else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') ||
  1689.         *d == '@' ) {
  1690.         register ARG *arg;
  1691.  
  1692.         spat->spat_runtime = arg = op_new(1);
  1693.         arg->arg_type = O_ITEM;
  1694.         arg[1].arg_type = A_DOUBLE;
  1695.         arg[1].arg_ptr.arg_str = str_smake(str);
  1696.         d = scanident(d,e,buf);
  1697.         (void)stabent(buf,TRUE);        /* make sure it's created */
  1698.         for (; *d; d++) {
  1699.         if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
  1700.             d = scanident(d,e,buf);
  1701.             (void)stabent(buf,TRUE);
  1702.         }
  1703.         else if (*d == '@' && d[-1] != '\\') {
  1704.             d = scanident(d,e,buf);
  1705.             if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
  1706.               strEQ(buf,"SIG") || strEQ(buf,"INC"))
  1707.             (void)stabent(buf,TRUE);
  1708.         }
  1709.         }
  1710.         goto get_repl;        /* skip compiling for now */
  1711.     }
  1712.     }
  1713.     scanconst(spat,str->str_ptr,len);
  1714. get_repl:
  1715.     s = scanstr(s);
  1716.     if (s >= bufend) {
  1717.     str_free(str);
  1718.     yyerror("Substitution replacement not terminated");
  1719.     yylval.arg = Nullarg;
  1720.     return s;
  1721.     }
  1722.     spat->spat_repl = yylval.arg;
  1723.     if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
  1724.     spat->spat_flags |= SPAT_CONST;
  1725.     else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
  1726.     STR *tmpstr;
  1727.     register char *t;
  1728.  
  1729.     spat->spat_flags |= SPAT_CONST;
  1730.     tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
  1731.     e = tmpstr->str_ptr + tmpstr->str_cur;
  1732.     for (t = tmpstr->str_ptr; t < e; t++) {
  1733.         if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
  1734.           (t[1] == '{' /*}*/ && isDIGIT(t[2])) ))
  1735.         spat->spat_flags &= ~SPAT_CONST;
  1736.     }
  1737.     }
  1738.     while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
  1739.     if (*s == 'e') {
  1740.         s++;
  1741.         if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
  1742.         spat->spat_repl[1].arg_type = A_SINGLE;
  1743.         spat->spat_repl = make_op(
  1744.         (spat->spat_repl[1].arg_type == A_SINGLE ? O_EVALONCE : O_EVAL),
  1745.         2,
  1746.         spat->spat_repl,
  1747.         Nullarg,
  1748.         Nullarg);
  1749.         spat->spat_flags &= ~SPAT_CONST;
  1750.     }
  1751.     if (*s == 'g') {
  1752.         s++;
  1753.         spat->spat_flags |= SPAT_GLOBAL;
  1754.     }
  1755.     if (*s == 'i') {
  1756.         s++;
  1757.         sawi = TRUE;
  1758.         spat->spat_flags |= SPAT_FOLD;
  1759.         if (!(spat->spat_flags & SPAT_SCANFIRST)) {
  1760.         str_free(spat->spat_short);    /* anchored opt doesn't do */
  1761.         spat->spat_short = Nullstr;    /* case insensitive match */
  1762.         spat->spat_slen = 0;
  1763.         }
  1764.     }
  1765.     if (*s == 'o') {
  1766.         s++;
  1767.         spat->spat_flags |= SPAT_KEEP;
  1768.     }
  1769.     }
  1770.     if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
  1771.     fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
  1772.     if (!spat->spat_runtime) {
  1773.     spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
  1774.       spat->spat_flags & SPAT_FOLD);
  1775.     hoistmust(spat);
  1776.     }
  1777.     yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
  1778.     str_free(str);
  1779.     return s;
  1780. }
  1781.  
  1782. void
  1783. hoistmust(spat)
  1784. register SPAT *spat;
  1785. {
  1786.     if (!spat->spat_short && spat->spat_regexp->regstart &&
  1787.     (!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH)
  1788.        ) {
  1789.     if (!(spat->spat_regexp->reganch & ROPT_ANCH))
  1790.         spat->spat_flags |= SPAT_SCANFIRST;
  1791.     else if (spat->spat_flags & SPAT_FOLD)
  1792.         return;
  1793.     spat->spat_short = str_smake(spat->spat_regexp->regstart);
  1794.     }
  1795.     else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */
  1796.     if (spat->spat_short &&
  1797.       str_eq(spat->spat_short,spat->spat_regexp->regmust))
  1798.     {
  1799.         if (spat->spat_flags & SPAT_SCANFIRST) {
  1800.         str_free(spat->spat_short);
  1801.         spat->spat_short = Nullstr;
  1802.         }
  1803.         else {
  1804.         str_free(spat->spat_regexp->regmust);
  1805.         spat->spat_regexp->regmust = Nullstr;
  1806.         return;
  1807.         }
  1808.     }
  1809.     if (!spat->spat_short ||    /* promote the better string */
  1810.       ((spat->spat_flags & SPAT_SCANFIRST) &&
  1811.        (spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
  1812.         str_free(spat->spat_short);        /* ok if null */
  1813.         spat->spat_short = spat->spat_regexp->regmust;
  1814.         spat->spat_regexp->regmust = Nullstr;
  1815.         spat->spat_flags |= SPAT_SCANFIRST;
  1816.     }
  1817.     }
  1818. }
  1819.  
  1820. char *
  1821. expand_charset(s,len,retlen)
  1822. register char *s;
  1823. int len;
  1824. int *retlen;
  1825. {
  1826.     char t[520];
  1827.     register char *d = t;
  1828.     register int i;
  1829.     register char *send = s + len;
  1830.  
  1831.     while (s < send && d - t <= 256) {
  1832.     if (s[1] == '-' && s+2 < send) {
  1833.         for (i = (s[0] & 0377); i <= (s[2] & 0377); i++)
  1834.         *d++ = i;
  1835.         s += 3;
  1836.     }
  1837.     else
  1838.         *d++ = *s++;
  1839.     }
  1840.     *d = '\0';
  1841.     *retlen = d - t;
  1842.     return nsavestr(t,d-t);
  1843. }
  1844.  
  1845. char *
  1846. scantrans(s)
  1847. register char *s;
  1848. {
  1849.     ARG *arg =
  1850.     l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
  1851.     register char *t;
  1852.     register char *r;
  1853.     register short *tbl;
  1854.     register int i;
  1855.     register int j;
  1856.     int tlen, rlen;
  1857.     int squash;
  1858.     int delete;
  1859.     int complement;
  1860.  
  1861.     New(803,tbl,256,short);
  1862.     arg[2].arg_type = A_NULL;
  1863.     arg[2].arg_ptr.arg_cval = (char*) tbl;
  1864.     s = scanstr(s);
  1865.     if (s >= bufend) {
  1866.     yyerror("Translation pattern not terminated");
  1867.     yylval.arg = Nullarg;
  1868.     return s;
  1869.     }
  1870.     t = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
  1871.     yylval.arg[1].arg_ptr.arg_str->str_cur,&tlen);
  1872.     arg_free(yylval.arg);
  1873.     s = scanstr(s-1);
  1874.     if (s >= bufend) {
  1875.     yyerror("Translation replacement not terminated");
  1876.     yylval.arg = Nullarg;
  1877.     return s;
  1878.     }
  1879.     complement = delete = squash = 0;
  1880.     while (*s == 'c' || *s == 'd' || *s == 's') {
  1881.     if (*s == 'c')
  1882.         complement = 1;
  1883.     else if (*s == 'd')
  1884.         delete = 2;
  1885.     else
  1886.         squash = 1;
  1887.     s++;
  1888.     }
  1889.     r = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
  1890.     yylval.arg[1].arg_ptr.arg_str->str_cur,&rlen);
  1891.     arg_free(yylval.arg);
  1892.     arg[2].arg_len = delete|squash;
  1893.     yylval.arg = arg;
  1894.     if (!rlen && !delete) {
  1895.     Safefree(r);
  1896.     r = t; rlen = tlen;
  1897.     }
  1898.     if (complement) {
  1899.     Zero(tbl, 256, short);
  1900.     for (i = 0; i < tlen; i++)
  1901.         tbl[t[i] & 0377] = -1;
  1902.     for (i = 0, j = 0; i < 256; i++) {
  1903.         if (!tbl[i]) {
  1904.         if (j >= rlen) {
  1905.             if (delete)
  1906.             tbl[i] = -2;
  1907.             else
  1908.             tbl[i] = r[j-1];
  1909.         }
  1910.         else
  1911.             tbl[i] = r[j++];
  1912.         }
  1913.     }
  1914.     }
  1915.     else {
  1916.     for (i = 0; i < 256; i++)
  1917.         tbl[i] = -1;
  1918.     for (i = 0, j = 0; i < tlen; i++,j++) {
  1919.         if (j >= rlen) {
  1920.         if (delete) {
  1921.             if (tbl[t[i] & 0377] == -1)
  1922.             tbl[t[i] & 0377] = -2;
  1923.             continue;
  1924.         }
  1925.         --j;
  1926.         }
  1927.         if (tbl[t[i] & 0377] == -1)
  1928.         tbl[t[i] & 0377] = r[j] & 0377;
  1929.     }
  1930.     }
  1931.     if (r != t)
  1932.     Safefree(r);
  1933.     Safefree(t);
  1934.     return s;
  1935. }
  1936.  
  1937. char *
  1938. scanstr(s)
  1939. register char *s;
  1940. {
  1941.     register char term;
  1942.     register char *d;
  1943.     register ARG *arg;
  1944.     register char *send;
  1945.     register bool makesingle = FALSE;
  1946.     register STAB *stab;
  1947.     bool alwaysdollar = FALSE;
  1948.     bool hereis = FALSE;
  1949.     STR *herewas;
  1950.     STR *str;
  1951.     char *leave = "\\$@nrtfbeacx0123456789[{]}lLuUE"; /* which backslash sequences to keep */
  1952.     int len;
  1953.  
  1954.     arg = op_new(1);
  1955.     yylval.arg = arg;
  1956.     arg->arg_type = O_ITEM;
  1957.  
  1958.     switch (*s) {
  1959.     default:            /* a substitution replacement */
  1960.     arg[1].arg_type = A_DOUBLE;
  1961.     makesingle = TRUE;    /* maybe disable runtime scanning */
  1962.     term = *s;
  1963.     if (term == '\'')
  1964.         leave = Nullch;
  1965.     goto snarf_it;
  1966.     case '0':
  1967.     {
  1968.         unsigned long i;
  1969.         int shift;
  1970.  
  1971.         arg[1].arg_type = A_SINGLE;
  1972.         if (s[1] == 'x') {
  1973.         shift = 4;
  1974.         s += 2;
  1975.         }
  1976.         else if (s[1] == '.')
  1977.         goto decimal;
  1978.         else
  1979.         shift = 3;
  1980.         i = 0;
  1981.         for (;;) {
  1982.         switch (*s) {
  1983.         default:
  1984.             goto out;
  1985.         case '_':
  1986.             s++;
  1987.             break;
  1988.         case '8': case '9':
  1989.             if (shift != 4)
  1990.             yyerror("Illegal octal digit");
  1991.             /* FALL THROUGH */
  1992.         case '0': case '1': case '2': case '3': case '4':
  1993.         case '5': case '6': case '7':
  1994.             i <<= shift;
  1995.             i += *s++ & 15;
  1996.             break;
  1997.         case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
  1998.         case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
  1999.             if (shift != 4)
  2000.             goto out;
  2001.             i <<= 4;
  2002.             i += (*s++ & 7) + 9;
  2003.             break;
  2004.         }
  2005.         }
  2006.       out:
  2007.         str = Str_new(92,0);
  2008.         str_numset(str,(double)i);
  2009.         if (str->str_ptr) {
  2010.         Safefree(str->str_ptr);
  2011.         str->str_ptr = Nullch;
  2012.         str->str_len = str->str_cur = 0;
  2013.         }
  2014.         arg[1].arg_ptr.arg_str = str;
  2015.     }
  2016.     break;
  2017.     case '1': case '2': case '3': case '4': case '5':
  2018.     case '6': case '7': case '8': case '9': case '.':
  2019.       decimal:
  2020.     arg[1].arg_type = A_SINGLE;
  2021.     d = tokenbuf;
  2022.     while (isDIGIT(*s) || *s == '_') {
  2023.         if (*s == '_')
  2024.         s++;
  2025.         else
  2026.         *d++ = *s++;
  2027.     }
  2028.     if (*s == '.' && s[1] && index("0123456789eE ;",s[1])) {
  2029.         *d++ = *s++;
  2030.         while (isDIGIT(*s) || *s == '_') {
  2031.         if (*s == '_')
  2032.             s++;
  2033.         else
  2034.             *d++ = *s++;
  2035.         }
  2036.     }
  2037.     if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
  2038.         *d++ = *s++;
  2039.         if (*s == '+' || *s == '-')
  2040.         *d++ = *s++;
  2041.         while (isDIGIT(*s))
  2042.         *d++ = *s++;
  2043.     }
  2044.     *d = '\0';
  2045.     str = Str_new(92,0);
  2046.     str_numset(str,atof(tokenbuf));
  2047.     if (str->str_ptr) {
  2048.         Safefree(str->str_ptr);
  2049.         str->str_ptr = Nullch;
  2050.         str->str_len = str->str_cur = 0;
  2051.     }
  2052.     arg[1].arg_ptr.arg_str = str;
  2053.     break;
  2054.     case '<':
  2055.     if (*++s == '<') {
  2056.         hereis = TRUE;
  2057.         d = tokenbuf;
  2058.         if (!rsfp)
  2059.         *d++ = '\n';
  2060.         if (*++s && index("`'\"",*s)) {
  2061.         term = *s++;
  2062.         s = cpytill(d,s,bufend,term,&len);
  2063.         if (s < bufend)
  2064.             s++;
  2065.         d += len;
  2066.         }
  2067.         else {
  2068.         if (*s == '\\')
  2069.             s++, term = '\'';
  2070.         else
  2071.             term = '"';
  2072.         while (isALNUM(*s))
  2073.             *d++ = *s++;
  2074.         }                /* assuming tokenbuf won't clobber */
  2075.         *d++ = '\n';
  2076.         *d = '\0';
  2077.         len = d - tokenbuf;
  2078.         d = "\n";
  2079.         if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
  2080.         herewas = str_make(s,bufend-s);
  2081.         else
  2082.         s--, herewas = str_make(s,d-s);
  2083.         s += herewas->str_cur;
  2084.         if (term == '\'')
  2085.         goto do_single;
  2086.         if (term == '`')
  2087.         goto do_back;
  2088.         goto do_double;
  2089.     }
  2090.     d = tokenbuf;
  2091.     s = cpytill(d,s,bufend,'>',&len);
  2092.     if (s < bufend)
  2093.         s++;
  2094.     if (*d == '$') d++;
  2095.     while (*d && (isALNUM(*d) || *d == '\''))
  2096.         d++;
  2097.     if (d - tokenbuf != len) {
  2098.         d = tokenbuf;
  2099.         arg[1].arg_type = A_GLOB;
  2100.         d = nsavestr(d,len);
  2101.         arg[1].arg_ptr.arg_stab = stab = genstab();
  2102.         stab_io(stab) = stio_new();
  2103.         stab_val(stab) = str_make(d,len);
  2104.         Safefree(d);
  2105.         set_csh();
  2106.     }
  2107.     else {
  2108.         d = tokenbuf;
  2109.         if (!len)
  2110.         (void)strcpy(d,"ARGV");
  2111.         if (*d == '$') {
  2112.         arg[1].arg_type = A_INDREAD;
  2113.         arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
  2114.         }
  2115.         else {
  2116.         arg[1].arg_type = A_READ;
  2117.         arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
  2118.         if (!stab_io(arg[1].arg_ptr.arg_stab))
  2119.             stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
  2120.         if (strEQ(d,"ARGV")) {
  2121.             (void)aadd(arg[1].arg_ptr.arg_stab);
  2122.             stab_io(arg[1].arg_ptr.arg_stab)->flags |=
  2123.               IOF_ARGV|IOF_START;
  2124.         }
  2125.         }
  2126.     }
  2127.     break;
  2128.  
  2129.     case 'q':
  2130.     s++;
  2131.     if (*s == 'q') {
  2132.         s++;
  2133.         goto do_double;
  2134.     }
  2135.     if (*s == 'x') {
  2136.         s++;
  2137.         goto do_back;
  2138.     }
  2139.     /* FALL THROUGH */
  2140.     case '\'':
  2141.       do_single:
  2142.     term = *s;
  2143.     arg[1].arg_type = A_SINGLE;
  2144.     leave = Nullch;
  2145.     goto snarf_it;
  2146.  
  2147.     case '"': 
  2148.       do_double:
  2149.     term = *s;
  2150.     arg[1].arg_type = A_DOUBLE;
  2151.     makesingle = TRUE;    /* maybe disable runtime scanning */
  2152.     alwaysdollar = TRUE;    /* treat $) and $| as variables */
  2153.     goto snarf_it;
  2154.     case '`':
  2155.       do_back:
  2156.     term = *s;
  2157.     arg[1].arg_type = A_BACKTICK;
  2158.     set_csh();
  2159.     alwaysdollar = TRUE;    /* treat $) and $| as variables */
  2160.       snarf_it:
  2161.     {
  2162.         STR *tmpstr;
  2163.         char *tmps;
  2164.  
  2165.         CLINE;
  2166.         multi_start = curcmd->c_line;
  2167.         if (hereis)
  2168.         multi_open = multi_close = '<';
  2169.         else {
  2170.         multi_open = term;
  2171.         if (term && (tmps = index("([{< )]}> )]}>",term)))
  2172.             term = tmps[5];
  2173.         multi_close = term;
  2174.         }
  2175.         tmpstr = Str_new(87,80);
  2176.         if (hereis) {
  2177.         term = *tokenbuf;
  2178.         if (!rsfp) {
  2179.             d = s;
  2180.             while (s < bufend &&
  2181.               (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
  2182.             if (*s++ == '\n')
  2183.                 curcmd->c_line++;
  2184.             }
  2185.             if (s >= bufend) {
  2186.             curcmd->c_line = multi_start;
  2187.             fatal("EOF in string");
  2188.             }
  2189.             str_nset(tmpstr,d+1,s-d);
  2190.             s += len - 1;
  2191.             str_ncat(herewas,s,bufend-s);
  2192.             str_replace(linestr,herewas);
  2193.             oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
  2194.             bufend = linestr->str_ptr + linestr->str_cur;
  2195.             hereis = FALSE;
  2196.         }
  2197.         else
  2198.             str_nset(tmpstr,"",0);   /* avoid "uninitialized" warning */
  2199.         }
  2200.         else
  2201.         s = str_append_till(tmpstr,s+1,bufend,term,leave);
  2202.         while (s >= bufend) {    /* multiple line string? */
  2203.         if (!rsfp ||
  2204.          !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
  2205.             curcmd->c_line = multi_start;
  2206.             fatal("EOF in string");
  2207.         }
  2208.         curcmd->c_line++;
  2209.         if (perldb) {
  2210.             STR *str = Str_new(88,0);
  2211.  
  2212.             str_sset(str,linestr);
  2213.             astore(stab_xarray(curcmd->c_filestab),
  2214.               (int)curcmd->c_line,str);
  2215.         }
  2216.         bufend = linestr->str_ptr + linestr->str_cur;
  2217.         if (hereis) {
  2218.             if (*s == term && bcmp(s,tokenbuf,len) == 0) {
  2219.             s = bufend - 1;
  2220.             *s = ' ';
  2221.             str_scat(linestr,herewas);
  2222.             bufend = linestr->str_ptr + linestr->str_cur;
  2223.             }
  2224.             else {
  2225.             s = bufend;
  2226.             str_scat(tmpstr,linestr);
  2227.             }
  2228.         }
  2229.         else
  2230.             s = str_append_till(tmpstr,s,bufend,term,leave);
  2231.         }
  2232.         multi_end = curcmd->c_line;
  2233.         s++;
  2234.         if (tmpstr->str_cur + 5 < tmpstr->str_len) {
  2235.         tmpstr->str_len = tmpstr->str_cur + 1;
  2236.         Renew(tmpstr->str_ptr, tmpstr->str_len, char);
  2237.         }
  2238.         if ((arg[1].arg_type & A_MASK) == A_SINGLE) {
  2239.         arg[1].arg_ptr.arg_str = tmpstr;
  2240.         break;
  2241.         }
  2242.         tmps = s;
  2243.         s = tmpstr->str_ptr;
  2244.         send = s + tmpstr->str_cur;
  2245.         while (s < send) {        /* see if we can make SINGLE */
  2246.         if (*s == '\\' && s[1] && isDIGIT(s[1]) && !isDIGIT(s[2]) &&
  2247.           !alwaysdollar && s[1] != '0')
  2248.             *s = '$';        /* grandfather \digit in subst */
  2249.         if ((*s == '$' || *s == '@') && s+1 < send &&
  2250.           (alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
  2251.             makesingle = FALSE;    /* force interpretation */
  2252.         }
  2253.         else if (*s == '\\' && s+1 < send) {
  2254.             if (index("lLuUE",s[1]))
  2255.             makesingle = FALSE;
  2256.             s++;
  2257.         }
  2258.         s++;
  2259.         }
  2260.         s = d = tmpstr->str_ptr;    /* assuming shrinkage only */
  2261.         while (s < send) {
  2262.         if ((*s == '$' && s+1 < send &&
  2263.             (alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) ||
  2264.             (*s == '@' && s+1 < send) ) {
  2265.             if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
  2266.             *d++ = *s++;
  2267.             len = scanident(s,send,tokenbuf) - s;
  2268.             if (*s == '$' || strEQ(tokenbuf,"ARGV")
  2269.               || strEQ(tokenbuf,"ENV")
  2270.               || strEQ(tokenbuf,"SIG")
  2271.               || strEQ(tokenbuf,"INC") )
  2272.             (void)stabent(tokenbuf,TRUE); /* make sure it exists */
  2273.             while (len--)
  2274.             *d++ = *s++;
  2275.             continue;
  2276.         }
  2277.         else if (*s == '\\' && s+1 < send) {
  2278.             s++;
  2279.             switch (*s) {
  2280.             default:
  2281.             if (!makesingle && (!leave || (*s && index(leave,*s))))
  2282.                 *d++ = '\\';
  2283.             *d++ = *s++;
  2284.             continue;
  2285.             case '0': case '1': case '2': case '3':
  2286.             case '4': case '5': case '6': case '7':
  2287.             *d++ = scanoct(s, 3, &len);
  2288.             s += len;
  2289.             continue;
  2290.             case 'x':
  2291.             *d++ = scanhex(++s, 2, &len);
  2292.             s += len;
  2293.             continue;
  2294.             case 'c':
  2295.             s++;
  2296.             *d = *s++;
  2297.             if (isLOWER(*d))
  2298.                 *d = toupper(*d);
  2299.             *d++ ^= 64;
  2300.             continue;
  2301.             case 'b':
  2302.             *d++ = '\b';
  2303.             break;
  2304.             case 'n':
  2305.             *d++ = '\n';
  2306.             break;
  2307.             case 'r':
  2308.             *d++ = '\r';
  2309.             break;
  2310.             case 'f':
  2311.             *d++ = '\f';
  2312.             break;
  2313.             case 't':
  2314.             *d++ = '\t';
  2315.             break;
  2316.             case 'e':
  2317.             *d++ = '\033';
  2318.             break;
  2319.             case 'a':
  2320.             *d++ = '\007';
  2321.             break;
  2322.             }
  2323.             s++;
  2324.             continue;
  2325.         }
  2326.         *d++ = *s++;
  2327.         }
  2328.         *d = '\0';
  2329.  
  2330.         if ((arg[1].arg_type & A_MASK) == A_DOUBLE && makesingle)
  2331.             arg[1].arg_type = A_SINGLE;    /* now we can optimize on it */
  2332.  
  2333.         tmpstr->str_cur = d - tmpstr->str_ptr;
  2334.         arg[1].arg_ptr.arg_str = tmpstr;
  2335.         s = tmps;
  2336.         break;
  2337.     }
  2338.     }
  2339.     if (hereis)
  2340.     str_free(herewas);
  2341.     return s;
  2342. }
  2343.  
  2344. FCMD *
  2345. load_format()
  2346. {
  2347.     FCMD froot;
  2348.     FCMD *flinebeg;
  2349.     char *eol;
  2350.     register FCMD *fprev = &froot;
  2351.     register FCMD *fcmd;
  2352.     register char *s;
  2353.     register char *t;
  2354.     register STR *str;
  2355.     bool noblank;
  2356.     bool repeater;
  2357.  
  2358.     Zero(&froot, 1, FCMD);
  2359.     s = bufptr;
  2360.     while (s < bufend || (rsfp && (s = str_gets(linestr,rsfp, 0)) != Nullch)) {
  2361.     curcmd->c_line++;
  2362.     if (in_eval && !rsfp) {
  2363.         eol = index(s,'\n');
  2364.         if (!eol++)
  2365.         eol = bufend;
  2366.     }
  2367.     else
  2368.         eol = bufend = linestr->str_ptr + linestr->str_cur;
  2369.     if (perldb) {
  2370.         STR *tmpstr = Str_new(89,0);
  2371.  
  2372.         str_nset(tmpstr, s, eol-s);
  2373.         astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
  2374.     }
  2375.     if (*s == '.') {
  2376.         /*SUPPRESS 530*/
  2377.         for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
  2378.         if (*t == '\n') {
  2379.         bufptr = s;
  2380.         return froot.f_next;
  2381.         }
  2382.     }
  2383.     if (*s == '#') {
  2384.         s = eol;
  2385.         continue;
  2386.     }
  2387.     flinebeg = Nullfcmd;
  2388.     noblank = FALSE;
  2389.     repeater = FALSE;
  2390.     while (s < eol) {
  2391.         Newz(804,fcmd,1,FCMD);
  2392.         fprev->f_next = fcmd;
  2393.         fprev = fcmd;
  2394.         for (t=s; t < eol && *t != '@' && *t != '^'; t++) {
  2395.         if (*t == '~') {
  2396.             noblank = TRUE;
  2397.             *t = ' ';
  2398.             if (t[1] == '~') {
  2399.             repeater = TRUE;
  2400.             t[1] = ' ';
  2401.             }
  2402.         }
  2403.         }
  2404.         fcmd->f_pre = nsavestr(s, t-s);
  2405.         fcmd->f_presize = t-s;
  2406.         s = t;
  2407.         if (s >= eol) {
  2408.         if (noblank)
  2409.             fcmd->f_flags |= FC_NOBLANK;
  2410.         if (repeater)
  2411.             fcmd->f_flags |= FC_REPEAT;
  2412.         break;
  2413.         }
  2414.         if (!flinebeg)
  2415.         flinebeg = fcmd;        /* start values here */
  2416.         if (*s++ == '^')
  2417.         fcmd->f_flags |= FC_CHOP;    /* for doing text filling */
  2418.         switch (*s) {
  2419.         case '*':
  2420.         fcmd->f_type = F_LINES;
  2421.         *s = '\0';
  2422.         break;
  2423.         case '<':
  2424.         fcmd->f_type = F_LEFT;
  2425.         while (*s == '<')
  2426.             s++;
  2427.         break;
  2428.         case '>':
  2429.         fcmd->f_type = F_RIGHT;
  2430.         while (*s == '>')
  2431.             s++;
  2432.         break;
  2433.         case '|':
  2434.         fcmd->f_type = F_CENTER;
  2435.         while (*s == '|')
  2436.             s++;
  2437.         break;
  2438.         case '#':
  2439.         case '.':
  2440.         /* Catch the special case @... and handle it as a string
  2441.            field. */
  2442.         if (*s == '.' && s[1] == '.') {
  2443.             goto default_format;
  2444.         }
  2445.         fcmd->f_type = F_DECIMAL;
  2446.         {
  2447.             char *p;
  2448.  
  2449.             /* Read a format in the form @####.####, where either group
  2450.                of ### may be empty, or the final .### may be missing. */
  2451.             while (*s == '#')
  2452.             s++;
  2453.             if (*s == '.') {
  2454.             s++;
  2455.             p = s;
  2456.             while (*s == '#')
  2457.                 s++;
  2458.             fcmd->f_decimals = s-p;
  2459.             fcmd->f_flags |= FC_DP;
  2460.             } else {
  2461.             fcmd->f_decimals = 0;
  2462.             }
  2463.         }
  2464.         break;
  2465.         default:
  2466.         default_format:
  2467.         fcmd->f_type = F_LEFT;
  2468.         break;
  2469.         }
  2470.         if (fcmd->f_flags & FC_CHOP && *s == '.') {
  2471.         fcmd->f_flags |= FC_MORE;
  2472.         while (*s == '.')
  2473.             s++;
  2474.         }
  2475.         fcmd->f_size = s-t;
  2476.     }
  2477.     if (flinebeg) {
  2478.       again:
  2479.         if (s >= bufend &&
  2480.           (!rsfp || (s = str_gets(linestr, rsfp, 0)) == Nullch) )
  2481.         goto badform;
  2482.         curcmd->c_line++;
  2483.         if (in_eval && !rsfp) {
  2484.         eol = index(s,'\n');
  2485.         if (!eol++)
  2486.             eol = bufend;
  2487.         }
  2488.         else
  2489.         eol = bufend = linestr->str_ptr + linestr->str_cur;
  2490.         if (perldb) {
  2491.         STR *tmpstr = Str_new(90,0);
  2492.  
  2493.         str_nset(tmpstr, s, eol-s);
  2494.         astore(stab_xarray(curcmd->c_filestab),
  2495.             (int)curcmd->c_line,tmpstr);
  2496.         }
  2497.         if (strnEQ(s,".\n",2)) {
  2498.         bufptr = s;
  2499.         yyerror("Missing values line");
  2500.         return froot.f_next;
  2501.         }
  2502.         if (*s == '#') {
  2503.         s = eol;
  2504.         goto again;
  2505.         }
  2506.         str = flinebeg->f_unparsed = Str_new(91,eol - s);
  2507.         str->str_u.str_hash = curstash;
  2508.         str_nset(str,"(",1);
  2509.         flinebeg->f_line = curcmd->c_line;
  2510.         eol[-1] = '\0';
  2511.         if (!flinebeg->f_next->f_type || index(s, ',')) {
  2512.         eol[-1] = '\n';
  2513.         str_ncat(str, s, eol - s - 1);
  2514.         str_ncat(str,",$$);",5);
  2515.         s = eol;
  2516.         }
  2517.         else {
  2518.         eol[-1] = '\n';
  2519.         while (s < eol && isSPACE(*s))
  2520.             s++;
  2521.         t = s;
  2522.         while (s < eol) {
  2523.             switch (*s) {
  2524.             case ' ': case '\t': case '\n': case ';':
  2525.             str_ncat(str, t, s - t);
  2526.             str_ncat(str, "," ,1);
  2527.             while (s < eol && (isSPACE(*s) || *s == ';'))
  2528.                 s++;
  2529.             t = s;
  2530.             break;
  2531.             case '$':
  2532.             str_ncat(str, t, s - t);
  2533.             t = s;
  2534.             s = scanident(s,eol,tokenbuf);
  2535.             str_ncat(str, t, s - t);
  2536.             t = s;
  2537.             if (s < eol && *s && index("$'\"",*s))
  2538.                 str_ncat(str, ",", 1);
  2539.             break;
  2540.             case '"': case '\'':
  2541.             str_ncat(str, t, s - t);
  2542.             t = s;
  2543.             s++;
  2544.             while (s < eol && (*s != *t || s[-1] == '\\'))
  2545.                 s++;
  2546.             if (s < eol)
  2547.                 s++;
  2548.             str_ncat(str, t, s - t);
  2549.             t = s;
  2550.             if (s < eol && *s && index("$'\"",*s))
  2551.                 str_ncat(str, ",", 1);
  2552.             break;
  2553.             default:
  2554.             yyerror("Please use commas to separate fields");
  2555.             }
  2556.         }
  2557.         str_ncat(str,"$$);",4);
  2558.         }
  2559.     }
  2560.     }
  2561.   badform:
  2562.     bufptr = str_get(linestr);
  2563.     yyerror("Format not terminated");
  2564.     return froot.f_next;
  2565. }
  2566.  
  2567. set_csh()
  2568. {
  2569. #ifdef CSH
  2570.     if (!cshlen)
  2571.     cshlen = strlen(cshname);
  2572. #endif
  2573. }
  2574.