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