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