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