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