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