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