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