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