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