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