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