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