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