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