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