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