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