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