This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 4.0 patch 36: (combined patch)
[perl5.git] / toke.c
CommitLineData
514dae0d 1/* $RCSfile: toke.c,v $$Revision: 4.0.1.8 $$Date: 92/06/23 12:33:45 $
a687059c 2 *
d48672a2 3 * Copyright (c) 1991, Larry Wall
a687059c 4 *
d48672a2
LW
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
378cc40b
LW
7 *
8 * $Log: toke.c,v $
514dae0d
LW
9 * Revision 4.0.1.8 92/06/23 12:33:45 lwall
10 * patch35: bad interaction between backslash and hyphen in tr///
11 *
faf8582f
LW
12 * Revision 4.0.1.7 92/06/11 21:16:30 lwall
13 * patch34: expectterm incorrectly set to indicate start of program or block
14 *
2f3197b3
LW
15 * Revision 4.0.1.6 92/06/08 16:03:49 lwall
16 * patch20: an EXPR may now start with a bareword
17 * patch20: print $fh EXPR can now expect term rather than operator in EXPR
18 * patch20: added ... as variant on ..
19 * patch20: new warning on spurious backslash
20 * patch20: new warning on missing $ for foreach variable
21 * patch20: "foo"x1024 now legal without space after x
22 * patch20: new warning on print accidentally used as function
23 * patch20: tr/stuff// wasn't working right
24 * patch20: 2. now eats the dot
25 * patch20: <@ARGV> now notices @ARGV
26 * patch20: tr/// now lets you say \-
27 *
988174c1
LW
28 * Revision 4.0.1.5 91/11/11 16:45:51 lwall
29 * patch19: default arg for shift was wrong after first subroutine definition
30 *
de3bb511
LW
31 * Revision 4.0.1.4 91/11/05 19:02:48 lwall
32 * patch11: \x and \c were subject to double interpretation in regexps
33 * patch11: prepared for ctype implementations that don't define isascii()
34 * patch11: nested list operators could miscount parens
35 * patch11: once-thru blocks didn't display right in the debugger
36 * patch11: sort eval "whatever" didn't work
37 * patch11: underscore is now allowed within literal octal and hex numbers
38 *
1462b684
LW
39 * Revision 4.0.1.3 91/06/10 01:32:26 lwall
40 * patch10: m'$foo' now treats string as single quoted
41 * patch10: certain pattern optimizations were botched
42 *
d48672a2
LW
43 * Revision 4.0.1.2 91/06/07 12:05:56 lwall
44 * patch4: new copyright notice
45 * patch4: debugger lost track of lines in eval
46 * patch4: //o and s///o now optimize themselves fully at runtime
47 * patch4: added global modifier for pattern matches
48 *
35c8bce7
LW
49 * Revision 4.0.1.1 91/04/12 09:18:18 lwall
50 * patch1: perl -de "print" wouldn't stop at the first statement
51 *
fe14fcc3
LW
52 * Revision 4.0 91/03/20 01:42:14 lwall
53 * 4.0 baseline.
378cc40b
LW
54 *
55 */
56
57#include "EXTERN.h"
58#include "perl.h"
59#include "perly.h"
60
2f3197b3
LW
61static void set_csh();
62
395c3793
LW
63#ifdef I_FCNTL
64#include <fcntl.h>
65#endif
fe14fcc3
LW
66#ifdef I_SYS_FILE
67#include <sys/file.h>
68#endif
395c3793 69
d48672a2
LW
70#ifdef f_next
71#undef f_next
72#endif
73
395c3793
LW
74/* which backslash sequences to keep in m// or s// */
75
de3bb511 76static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}";
395c3793 77
fe14fcc3
LW
78char *reparse; /* if non-null, scanident found ${foo[$bar]} */
79
80void checkcomma();
a687059c 81
ae986130
LW
82#ifdef CLINE
83#undef CLINE
84#endif
e929a76b 85#define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_line : cmdline))
378cc40b 86
2f3197b3
LW
87#ifdef atarist
88#define PERL_META(c) ((c) | 128)
89#else
a687059c 90#define META(c) ((c) | 128)
2f3197b3 91#endif
a687059c 92
378cc40b
LW
93#define RETURN(retval) return (bufptr = s,(int)retval)
94#define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
95#define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
96#define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
378cc40b
LW
97#define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
98#define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
99#define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
100#define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
395c3793 101#define FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x)
378cc40b 102#define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
395c3793
LW
103#define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4)
104#define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5)
a687059c
LW
105#define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
106#define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
107#define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
108#define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
109#define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
a687059c
LW
110#define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
111#define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
112#define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
113#define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
114#define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
115#define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
116#define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
117#define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
118#define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
119#define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
120
2f3197b3
LW
121static char *last_uni;
122
a687059c
LW
123/* This bit of chicanery makes a unary function followed by
124 * a parenthesis into a function with one argument, highest precedence.
125 */
2f3197b3
LW
126#define UNI(f) return(yylval.ival = f, \
127 expectterm = TRUE, \
128 bufptr = s, \
129 last_uni = oldbufptr, \
a687059c
LW
130 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
131
132/* This does similarly for list operators, merely by pretending that the
133 * paren came before the listop rather than after.
134 */
2f3197b3
LW
135#ifdef atarist
136#define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
137 (*s = (char) PERL_META('('), bufptr = oldbufptr, '(') : \
138 (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
139#else
35c8bce7 140#define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
de3bb511 141 (*s = (char) META('('), bufptr = oldbufptr, '(') : \
a687059c 142 (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
2f3197b3 143#endif
9f68db38
LW
144/* grandfather return to old style */
145#define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
a687059c
LW
146
147char *
148skipspace(s)
149register char *s;
150{
de3bb511 151 while (s < bufend && isSPACE(*s))
a687059c
LW
152 s++;
153 return s;
154}
378cc40b 155
2f3197b3
LW
156void
157check_uni() {
158 char *s;
159 char ch;
160
161 if (oldoldbufptr != last_uni)
162 return;
163 while (isSPACE(*last_uni))
164 last_uni++;
e334a159 165 for (s = last_uni; isALNUM(*s) || *s == '-'; s++) ;
2f3197b3
LW
166 ch = *s;
167 *s = '\0';
168 warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
169 *s = ch;
170}
171
ffed7fef
LW
172#ifdef CRIPPLED_CC
173
174#undef UNI
175#undef LOP
176#define UNI(f) return uni(f,s)
177#define LOP(f) return lop(f,s)
178
179int
180uni(f,s)
181int f;
182char *s;
183{
184 yylval.ival = f;
185 expectterm = TRUE;
186 bufptr = s;
2f3197b3 187 last_uni = oldbufptr;
ffed7fef
LW
188 if (*s == '(')
189 return FUNC1;
190 s = skipspace(s);
191 if (*s == '(')
192 return FUNC1;
193 else
194 return UNIOP;
195}
196
197int
198lop(f,s)
199int f;
200char *s;
201{
35c8bce7 202 CLINE;
ffed7fef
LW
203 if (*s != '(')
204 s = skipspace(s);
205 if (*s == '(') {
2f3197b3
LW
206#ifdef atarist
207 *s = PERL_META('(');
208#else
ffed7fef 209 *s = META('(');
2f3197b3 210#endif
ffed7fef
LW
211 bufptr = oldbufptr;
212 return '(';
213 }
214 else {
215 yylval.ival=f;
216 expectterm = TRUE;
217 bufptr = s;
218 return LISTOP;
219 }
220}
221
222#endif /* CRIPPLED_CC */
223
2f3197b3 224int
378cc40b
LW
225yylex()
226{
227 register char *s = bufptr;
228 register char *d;
229 register int tmp;
230 static bool in_format = FALSE;
231 static bool firstline = TRUE;
a687059c
LW
232 extern int yychar; /* last token */
233
234 oldoldbufptr = oldbufptr;
235 oldbufptr = s;
378cc40b
LW
236
237 retry:
238#ifdef YYDEBUG
ae986130 239 if (debug & 1)
378cc40b
LW
240 if (index(s,'\n'))
241 fprintf(stderr,"Tokener at %s",s);
242 else
243 fprintf(stderr,"Tokener at %s\n",s);
244#endif
e929a76b
LW
245#ifdef BADSWITCH
246 if (*s & 128) {
de3bb511 247 if ((*s & 127) == '(') {
e929a76b 248 *s++ = '(';
de3bb511
LW
249 oldbufptr = s;
250 }
2f3197b3
LW
251 else if ((*s & 127) == '}') {
252 *s++ = '}';
253 RETURN('}');
254 }
e929a76b 255 else
fe14fcc3 256 warn("Unrecognized character \\%03o ignored", *s++ & 255);
e929a76b
LW
257 goto retry;
258 }
259#endif
378cc40b
LW
260 switch (*s) {
261 default:
de3bb511 262 if ((*s & 127) == '(') {
a687059c 263 *s++ = '(';
de3bb511
LW
264 oldbufptr = s;
265 }
2f3197b3
LW
266 else if ((*s & 127) == '}') {
267 *s++ = '}';
268 RETURN('}');
269 }
a687059c 270 else
fe14fcc3 271 warn("Unrecognized character \\%03o ignored", *s++ & 255);
378cc40b 272 goto retry;
e929a76b
LW
273 case 4:
274 case 26:
275 goto fake_eof; /* emulate EOF on ^D or ^Z */
378cc40b 276 case 0:
378cc40b
LW
277 if (!rsfp)
278 RETURN(0);
a687059c
LW
279 if (s++ < bufend)
280 goto retry; /* ignore stray nulls */
2f3197b3 281 last_uni = 0;
a687059c
LW
282 if (firstline) {
283 firstline = FALSE;
284 if (minus_n || minus_p || perldb) {
285 str_set(linestr,"");
395c3793
LW
286 if (perldb) {
287 char *getenv();
288 char *pdb = getenv("PERLDB");
289
290 str_cat(linestr, pdb ? pdb : "require 'perldb.pl'");
291 str_cat(linestr, ";");
292 }
a687059c
LW
293 if (minus_n || minus_p) {
294 str_cat(linestr,"line: while (<>) {");
fe14fcc3
LW
295 if (minus_l)
296 str_cat(linestr,"chop;");
a687059c
LW
297 if (minus_a)
298 str_cat(linestr,"@F=split(' ');");
299 }
300 oldoldbufptr = oldbufptr = s = str_get(linestr);
301 bufend = linestr->str_ptr + linestr->str_cur;
302 goto retry;
303 }
304 }
378cc40b 305 if (in_format) {
0f85fab0 306 bufptr = bufend;
a687059c 307 yylval.formval = load_format();
378cc40b 308 in_format = FALSE;
a687059c
LW
309 oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
310 bufend = linestr->str_ptr + linestr->str_cur;
e929a76b
LW
311 OPERATOR(FORMLIST);
312 }
313 curcmd->c_line++;
314#ifdef CRYPTSCRIPT
315 cryptswitch();
316#endif /* CRYPTSCRIPT */
317 do {
318 if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
319 fake_eof:
395c3793
LW
320 if (rsfp) {
321 if (preprocess)
322 (void)mypclose(rsfp);
de3bb511 323 else if ((FILE*)rsfp == stdin)
395c3793
LW
324 clearerr(stdin);
325 else
326 (void)fclose(rsfp);
327 rsfp = Nullfp;
328 }
e929a76b
LW
329 if (minus_n || minus_p) {
330 str_set(linestr,minus_p ? ";}continue{print" : "");
331 str_cat(linestr,";}");
332 oldoldbufptr = oldbufptr = s = str_get(linestr);
333 bufend = linestr->str_ptr + linestr->str_cur;
334 minus_n = minus_p = 0;
335 goto retry;
336 }
a687059c 337 oldoldbufptr = oldbufptr = s = str_get(linestr);
e929a76b
LW
338 str_set(linestr,"");
339 RETURN(';'); /* not infinite loop because rsfp is NULL now */
378cc40b 340 }
e929a76b
LW
341 if (doextract && *linestr->str_ptr == '#')
342 doextract = FALSE;
343 } while (doextract);
a687059c
LW
344 oldoldbufptr = oldbufptr = bufptr = s;
345 if (perldb) {
346 STR *str = Str_new(85,0);
347
348 str_sset(str,linestr);
395c3793 349 astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
a687059c 350 }
378cc40b 351#ifdef DEBUG
a687059c 352 if (firstline) {
378cc40b
LW
353 char *showinput();
354 s = showinput();
355 }
356#endif
a687059c 357 bufend = linestr->str_ptr + linestr->str_cur;
e929a76b 358 if (curcmd->c_line == 1) {
9f68db38
LW
359 if (*s == '#' && s[1] == '!') {
360 if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
361 char **newargv;
362 char *cmd;
363
364 s += 2;
365 if (*s == ' ')
366 s++;
367 cmd = s;
de3bb511 368 while (s < bufend && !isSPACE(*s))
9f68db38
LW
369 s++;
370 *s++ = '\0';
de3bb511 371 while (s < bufend && isSPACE(*s))
9f68db38
LW
372 s++;
373 if (s < bufend) {
374 Newz(899,newargv,origargc+3,char*);
375 newargv[1] = s;
de3bb511 376 while (s < bufend && !isSPACE(*s))
9f68db38
LW
377 s++;
378 *s = '\0';
379 Copy(origargv+1, newargv+2, origargc+1, char*);
380 }
381 else
382 newargv = origargv;
383 newargv[0] = cmd;
384 execv(cmd,newargv);
385 fatal("Can't exec %s", cmd);
386 }
387 }
388 else {
de3bb511 389 while (s < bufend && isSPACE(*s))
9f68db38
LW
390 s++;
391 if (*s == ':') /* for csh's that have to exec sh scripts */
392 s++;
393 }
ae986130 394 }
378cc40b 395 goto retry;
fe14fcc3 396 case ' ': case '\t': case '\f': case '\r': case 013:
378cc40b
LW
397 s++;
398 goto retry;
378cc40b
LW
399 case '#':
400 if (preprocess && s == str_get(linestr) &&
de3bb511
LW
401 s[1] == ' ' && (isDIGIT(s[2]) || strnEQ(s+2,"line ",5)) ) {
402 while (*s && !isDIGIT(*s))
403 s++;
404 curcmd->c_line = atoi(s)-1;
405 while (isDIGIT(*s))
406 s++;
a687059c 407 d = bufend;
de3bb511 408 while (s < d && isSPACE(*s)) s++;
378cc40b
LW
409 s[strlen(s)-1] = '\0'; /* wipe out newline */
410 if (*s == '"') {
411 s++;
412 s[strlen(s)-1] = '\0'; /* wipe out trailing quote */
413 }
414 if (*s)
395c3793 415 curcmd->c_filestab = fstab(s);
378cc40b 416 else
395c3793 417 curcmd->c_filestab = fstab(origfilename);
a687059c 418 oldoldbufptr = oldbufptr = s = str_get(linestr);
378cc40b 419 }
e929a76b
LW
420 /* FALL THROUGH */
421 case '\n':
a687059c
LW
422 if (in_eval && !rsfp) {
423 d = bufend;
424 while (s < d && *s != '\n')
378cc40b 425 s++;
0f85fab0 426 if (s < d)
378cc40b 427 s++;
0f85fab0
LW
428 if (in_format) {
429 bufptr = s;
430 yylval.formval = load_format();
431 in_format = FALSE;
432 oldoldbufptr = oldbufptr = s = bufptr + 1;
433 TERM(FORMLIST);
a687059c 434 }
e929a76b 435 curcmd->c_line++;
378cc40b 436 }
a687059c 437 else {
378cc40b 438 *s = '\0';
a687059c
LW
439 bufend = s;
440 }
378cc40b
LW
441 goto retry;
442 case '-':
de3bb511 443 if (s[1] && isALPHA(s[1]) && !isALPHA(s[2])) {
378cc40b 444 s++;
e334a159 445 last_uni = oldbufptr;
378cc40b
LW
446 switch (*s++) {
447 case 'r': FTST(O_FTEREAD);
448 case 'w': FTST(O_FTEWRITE);
449 case 'x': FTST(O_FTEEXEC);
450 case 'o': FTST(O_FTEOWNED);
451 case 'R': FTST(O_FTRREAD);
452 case 'W': FTST(O_FTRWRITE);
453 case 'X': FTST(O_FTREXEC);
454 case 'O': FTST(O_FTROWNED);
455 case 'e': FTST(O_FTIS);
456 case 'z': FTST(O_FTZERO);
457 case 's': FTST(O_FTSIZE);
458 case 'f': FTST(O_FTFILE);
459 case 'd': FTST(O_FTDIR);
460 case 'l': FTST(O_FTLINK);
461 case 'p': FTST(O_FTPIPE);
462 case 'S': FTST(O_FTSOCK);
463 case 'u': FTST(O_FTSUID);
464 case 'g': FTST(O_FTSGID);
465 case 'k': FTST(O_FTSVTX);
466 case 'b': FTST(O_FTBLK);
467 case 'c': FTST(O_FTCHR);
468 case 't': FTST(O_FTTTY);
469 case 'T': FTST(O_FTTEXT);
470 case 'B': FTST(O_FTBINARY);
395c3793
LW
471 case 'M': stabent("\024",TRUE); FTST(O_FTMTIME);
472 case 'A': stabent("\024",TRUE); FTST(O_FTATIME);
473 case 'C': stabent("\024",TRUE); FTST(O_FTCTIME);
378cc40b
LW
474 default:
475 s -= 2;
476 break;
477 }
478 }
a687059c
LW
479 tmp = *s++;
480 if (*s == tmp) {
481 s++;
482 RETURN(DEC);
483 }
2f3197b3
LW
484 if (expectterm) {
485 if (isSPACE(*s) || !isSPACE(*bufptr))
486 check_uni();
a687059c 487 OPERATOR('-');
2f3197b3 488 }
a687059c
LW
489 else
490 AOP(O_SUBTRACT);
378cc40b 491 case '+':
a687059c
LW
492 tmp = *s++;
493 if (*s == tmp) {
378cc40b 494 s++;
a687059c 495 RETURN(INC);
378cc40b 496 }
2f3197b3
LW
497 if (expectterm) {
498 if (isSPACE(*s) || !isSPACE(*bufptr))
499 check_uni();
a687059c 500 OPERATOR('+');
2f3197b3 501 }
a687059c
LW
502 else
503 AOP(O_ADD);
504
378cc40b 505 case '*':
a687059c 506 if (expectterm) {
2f3197b3 507 check_uni();
fe14fcc3 508 s = scanident(s,bufend,tokenbuf);
a687059c
LW
509 yylval.stabval = stabent(tokenbuf,TRUE);
510 TERM(STAR);
511 }
512 tmp = *s++;
513 if (*s == tmp) {
514 s++;
515 OPERATOR(POW);
516 }
517 MOP(O_MULTIPLY);
378cc40b 518 case '%':
a687059c 519 if (expectterm) {
2f3197b3
LW
520 if (!isALPHA(s[1]))
521 check_uni();
fe14fcc3 522 s = scanident(s,bufend,tokenbuf);
6eb13c3b 523 yylval.stabval = hadd(stabent(tokenbuf,TRUE));
a687059c
LW
524 TERM(HSH);
525 }
526 s++;
527 MOP(O_MODULO);
528
378cc40b
LW
529 case '^':
530 case '~':
531 case '(':
532 case ',':
533 case ':':
534 case '[':
535 tmp = *s++;
536 OPERATOR(tmp);
537 case '{':
538 tmp = *s++;
de3bb511
LW
539 yylval.ival = curcmd->c_line;
540 if (isSPACE(*s) || *s == '#')
378cc40b 541 cmdline = NOLINE; /* invalidate current command line number */
faf8582f
LW
542 expectterm = 2;
543 RETURN(tmp);
378cc40b 544 case ';':
e929a76b
LW
545 if (curcmd->c_line < cmdline)
546 cmdline = curcmd->c_line;
378cc40b
LW
547 tmp = *s++;
548 OPERATOR(tmp);
549 case ')':
550 case ']':
551 tmp = *s++;
552 TERM(tmp);
553 case '}':
2f3197b3
LW
554 *s |= 128;
555 RETURN(';');
378cc40b
LW
556 case '&':
557 s++;
558 tmp = *s++;
559 if (tmp == '&')
560 OPERATOR(ANDAND);
561 s--;
a687059c
LW
562 if (expectterm) {
563 d = bufend;
de3bb511 564 while (s < d && isSPACE(*s))
a687059c 565 s++;
de3bb511 566 if (isALPHA(*s) || *s == '_' || *s == '\'')
a687059c 567 *(--s) = '\\'; /* force next ident to WORD */
2f3197b3
LW
568 else
569 check_uni();
a687059c
LW
570 OPERATOR(AMPER);
571 }
378cc40b
LW
572 OPERATOR('&');
573 case '|':
574 s++;
575 tmp = *s++;
576 if (tmp == '|')
577 OPERATOR(OROR);
578 s--;
579 OPERATOR('|');
580 case '=':
581 s++;
582 tmp = *s++;
583 if (tmp == '=')
a687059c 584 EOP(O_EQ);
378cc40b
LW
585 if (tmp == '~')
586 OPERATOR(MATCH);
587 s--;
588 OPERATOR('=');
589 case '!':
590 s++;
591 tmp = *s++;
592 if (tmp == '=')
a687059c 593 EOP(O_NE);
378cc40b
LW
594 if (tmp == '~')
595 OPERATOR(NMATCH);
596 s--;
597 OPERATOR('!');
598 case '<':
599 if (expectterm) {
2f3197b3
LW
600 if (s[1] != '<' && !index(s,'>'))
601 check_uni();
602 s = scanstr(s, SCAN_DEF);
378cc40b
LW
603 TERM(RSTRING);
604 }
605 s++;
606 tmp = *s++;
607 if (tmp == '<')
608 OPERATOR(LS);
395c3793
LW
609 if (tmp == '=') {
610 tmp = *s++;
611 if (tmp == '>')
612 EOP(O_NCMP);
613 s--;
a687059c 614 ROP(O_LE);
395c3793 615 }
378cc40b 616 s--;
a687059c 617 ROP(O_LT);
378cc40b
LW
618 case '>':
619 s++;
620 tmp = *s++;
621 if (tmp == '>')
622 OPERATOR(RS);
623 if (tmp == '=')
a687059c 624 ROP(O_GE);
378cc40b 625 s--;
a687059c 626 ROP(O_GT);
378cc40b
LW
627
628#define SNARFWORD \
629 d = tokenbuf; \
de3bb511 630 while (isALNUM(*s) || *s == '\'') \
378cc40b 631 *d++ = *s++; \
663a0e37 632 while (d[-1] == '\'') \
a687059c 633 d--,s--; \
378cc40b
LW
634 *d = '\0'; \
635 d = tokenbuf;
636
637 case '$':
de3bb511 638 if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) {
378cc40b 639 s++;
fe14fcc3 640 s = scanident(s,bufend,tokenbuf);
378cc40b
LW
641 yylval.stabval = aadd(stabent(tokenbuf,TRUE));
642 TERM(ARYLEN);
643 }
a687059c 644 d = s;
fe14fcc3 645 s = scanident(s,bufend,tokenbuf);
a687059c
LW
646 if (reparse) { /* turn ${foo[bar]} into ($foo[bar]) */
647 do_reparse:
648 s[-1] = ')';
649 s = d;
650 s[1] = s[0];
651 s[0] = '(';
652 goto retry;
653 }
378cc40b 654 yylval.stabval = stabent(tokenbuf,TRUE);
2f3197b3
LW
655 expectterm = FALSE;
656 if (isSPACE(*s) && oldoldbufptr && oldoldbufptr < bufptr) {
657 s++;
658 while (isSPACE(*oldoldbufptr))
659 oldoldbufptr++;
660 if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5)) {
661 if (index("&*<%", *s) && isALPHA(s[1]))
662 expectterm = TRUE; /* e.g. print $fh &sub */
663 else if (*s == '.' && isDIGIT(s[1]))
664 expectterm = TRUE; /* e.g. print $fh .3 */
665 else if (index("/?-+", *s) && !isSPACE(s[1]))
666 expectterm = TRUE; /* e.g. print $fh -1 */
667 }
668 }
669 RETURN(REG);
378cc40b
LW
670
671 case '@':
a687059c 672 d = s;
fe14fcc3 673 s = scanident(s,bufend,tokenbuf);
a687059c
LW
674 if (reparse)
675 goto do_reparse;
e929a76b 676 yylval.stabval = aadd(stabent(tokenbuf,TRUE));
378cc40b
LW
677 TERM(ARY);
678
679 case '/': /* may either be division or pattern */
680 case '?': /* may either be conditional or pattern */
681 if (expectterm) {
2f3197b3 682 check_uni();
378cc40b
LW
683 s = scanpat(s);
684 TERM(PATTERN);
685 }
686 tmp = *s++;
a687059c
LW
687 if (tmp == '/')
688 MOP(O_DIVIDE);
378cc40b
LW
689 OPERATOR(tmp);
690
691 case '.':
de3bb511 692 if (!expectterm || !isDIGIT(s[1])) {
378cc40b 693 tmp = *s++;
a687059c
LW
694 if (*s == tmp) {
695 s++;
2f3197b3
LW
696 if (*s == tmp) {
697 s++;
698 yylval.ival = 0;
699 }
700 else
701 yylval.ival = AF_COMMON;
378cc40b 702 OPERATOR(DOTDOT);
a687059c 703 }
2f3197b3
LW
704 if (expectterm)
705 check_uni();
a687059c 706 AOP(O_CONCAT);
378cc40b
LW
707 }
708 /* FALL THROUGH */
709 case '0': case '1': case '2': case '3': case '4':
710 case '5': case '6': case '7': case '8': case '9':
711 case '\'': case '"': case '`':
2f3197b3 712 s = scanstr(s, SCAN_DEF);
378cc40b
LW
713 TERM(RSTRING);
714
a687059c
LW
715 case '\\': /* some magic to force next word to be a WORD */
716 s++; /* used by do and sub to force a separate namespace */
2f3197b3
LW
717 if (!isALPHA(*s) && *s != '_' && *s != '\'') {
718 warn("Spurious backslash ignored");
719 goto retry;
720 }
a687059c 721 /* FALL THROUGH */
378cc40b
LW
722 case '_':
723 SNARFWORD;
e929a76b
LW
724 if (d[1] == '_') {
725 if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) {
726 ARG *arg = op_new(1);
727
728 yylval.arg = arg;
729 arg->arg_type = O_ITEM;
730 if (d[2] == 'L')
731 (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line);
732 else
395c3793 733 strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr);
e929a76b
LW
734 arg[1].arg_type = A_SINGLE;
735 arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
736 TERM(RSTRING);
737 }
395c3793 738 else if (strEQ(d,"__END__")) {
395c3793
LW
739 STAB *stab;
740 int fd;
741
de3bb511 742 /*SUPPRESS 560*/
2f3197b3 743 if (!in_eval && (stab = stabent("DATA",FALSE))) {
395c3793 744 stab->str_pok |= SP_MULTI;
2f3197b3
LW
745 if (!stab_io(stab))
746 stab_io(stab) = stio_new();
395c3793 747 stab_io(stab)->ifp = rsfp;
fe14fcc3 748#if defined(HAS_FCNTL) && defined(F_SETFD)
395c3793
LW
749 fd = fileno(rsfp);
750 fcntl(fd,F_SETFD,fd >= 3);
751#endif
752 if (preprocess)
753 stab_io(stab)->type = '|';
de3bb511 754 else if ((FILE*)rsfp == stdin)
395c3793
LW
755 stab_io(stab)->type = '-';
756 else
757 stab_io(stab)->type = '<';
758 rsfp = Nullfp;
759 }
e929a76b 760 goto fake_eof;
395c3793 761 }
e929a76b 762 }
a687059c 763 break;
378cc40b
LW
764 case 'a': case 'A':
765 SNARFWORD;
34de22dd
LW
766 if (strEQ(d,"alarm"))
767 UNI(O_ALARM);
a687059c
LW
768 if (strEQ(d,"accept"))
769 FOP22(O_ACCEPT);
770 if (strEQ(d,"atan2"))
771 FUN2(O_ATAN2);
772 break;
378cc40b
LW
773 case 'b': case 'B':
774 SNARFWORD;
a687059c
LW
775 if (strEQ(d,"bind"))
776 FOP2(O_BIND);
0f85fab0
LW
777 if (strEQ(d,"binmode"))
778 FOP(O_BINMODE);
a687059c 779 break;
378cc40b
LW
780 case 'c': case 'C':
781 SNARFWORD;
a687059c
LW
782 if (strEQ(d,"chop"))
783 LFUN(O_CHOP);
378cc40b
LW
784 if (strEQ(d,"continue"))
785 OPERATOR(CONTINUE);
9f68db38
LW
786 if (strEQ(d,"chdir")) {
787 (void)stabent("ENV",TRUE); /* may use HOME */
378cc40b 788 UNI(O_CHDIR);
9f68db38 789 }
378cc40b 790 if (strEQ(d,"close"))
a687059c
LW
791 FOP(O_CLOSE);
792 if (strEQ(d,"closedir"))
793 FOP(O_CLOSEDIR);
395c3793
LW
794 if (strEQ(d,"cmp"))
795 EOP(O_SCMP);
796 if (strEQ(d,"caller"))
797 UNI(O_CALLER);
a687059c
LW
798 if (strEQ(d,"crypt")) {
799#ifdef FCRYPT
de3bb511
LW
800 static int cryptseen = 0;
801
802 if (!cryptseen++)
803 init_des();
a687059c 804#endif
378cc40b 805 FUN2(O_CRYPT);
378cc40b 806 }
a687059c
LW
807 if (strEQ(d,"chmod"))
808 LOP(O_CHMOD);
809 if (strEQ(d,"chown"))
810 LOP(O_CHOWN);
811 if (strEQ(d,"connect"))
812 FOP2(O_CONNECT);
813 if (strEQ(d,"cos"))
814 UNI(O_COS);
815 if (strEQ(d,"chroot"))
816 UNI(O_CHROOT);
817 break;
378cc40b
LW
818 case 'd': case 'D':
819 SNARFWORD;
a687059c
LW
820 if (strEQ(d,"do")) {
821 d = bufend;
de3bb511 822 while (s < d && isSPACE(*s))
a687059c 823 s++;
de3bb511 824 if (isALPHA(*s) || *s == '_')
a687059c 825 *(--s) = '\\'; /* force next ident to WORD */
378cc40b 826 OPERATOR(DO);
a687059c 827 }
378cc40b 828 if (strEQ(d,"die"))
a687059c
LW
829 LOP(O_DIE);
830 if (strEQ(d,"defined"))
831 LFUN(O_DEFINED);
378cc40b
LW
832 if (strEQ(d,"delete"))
833 OPERATOR(DELETE);
a687059c
LW
834 if (strEQ(d,"dbmopen"))
835 HFUN3(O_DBMOPEN);
836 if (strEQ(d,"dbmclose"))
837 HFUN(O_DBMCLOSE);
838 if (strEQ(d,"dump"))
839 LOOPX(O_DUMP);
840 break;
378cc40b
LW
841 case 'e': case 'E':
842 SNARFWORD;
843 if (strEQ(d,"else"))
844 OPERATOR(ELSE);
845 if (strEQ(d,"elsif")) {
e929a76b 846 yylval.ival = curcmd->c_line;
378cc40b
LW
847 OPERATOR(ELSIF);
848 }
849 if (strEQ(d,"eq") || strEQ(d,"EQ"))
a687059c 850 EOP(O_SEQ);
378cc40b
LW
851 if (strEQ(d,"exit"))
852 UNI(O_EXIT);
853 if (strEQ(d,"eval")) {
854 allstabs = TRUE; /* must initialize everything since */
855 UNI(O_EVAL); /* we don't know what will be used */
856 }
857 if (strEQ(d,"eof"))
a687059c 858 FOP(O_EOF);
378cc40b 859 if (strEQ(d,"exp"))
a687059c 860 UNI(O_EXP);
378cc40b 861 if (strEQ(d,"each"))
a687059c 862 HFUN(O_EACH);
378cc40b 863 if (strEQ(d,"exec")) {
a687059c 864 set_csh();
395c3793 865 LOP(O_EXEC_OP);
378cc40b 866 }
a687059c
LW
867 if (strEQ(d,"endhostent"))
868 FUN0(O_EHOSTENT);
869 if (strEQ(d,"endnetent"))
870 FUN0(O_ENETENT);
871 if (strEQ(d,"endservent"))
872 FUN0(O_ESERVENT);
873 if (strEQ(d,"endprotoent"))
874 FUN0(O_EPROTOENT);
875 if (strEQ(d,"endpwent"))
876 FUN0(O_EPWENT);
877 if (strEQ(d,"endgrent"))
878 FUN0(O_EGRENT);
879 break;
378cc40b
LW
880 case 'f': case 'F':
881 SNARFWORD;
9f68db38 882 if (strEQ(d,"for") || strEQ(d,"foreach")) {
e929a76b 883 yylval.ival = curcmd->c_line;
2f3197b3
LW
884 while (s < bufend && isSPACE(*s))
885 s++;
886 if (isALPHA(*s))
887 fatal("Missing $ on loop variable");
378cc40b 888 OPERATOR(FOR);
9f68db38 889 }
378cc40b 890 if (strEQ(d,"format")) {
a687059c 891 d = bufend;
de3bb511 892 while (s < d && isSPACE(*s))
a687059c 893 s++;
de3bb511 894 if (isALPHA(*s) || *s == '_')
a687059c 895 *(--s) = '\\'; /* force next ident to WORD */
378cc40b 896 in_format = TRUE;
a687059c
LW
897 allstabs = TRUE; /* must initialize everything since */
898 OPERATOR(FORMAT); /* we don't know what will be used */
378cc40b
LW
899 }
900 if (strEQ(d,"fork"))
901 FUN0(O_FORK);
a687059c
LW
902 if (strEQ(d,"fcntl"))
903 FOP3(O_FCNTL);
904 if (strEQ(d,"fileno"))
905 FOP(O_FILENO);
906 if (strEQ(d,"flock"))
907 FOP2(O_FLOCK);
908 break;
378cc40b
LW
909 case 'g': case 'G':
910 SNARFWORD;
911 if (strEQ(d,"gt") || strEQ(d,"GT"))
a687059c 912 ROP(O_SGT);
378cc40b 913 if (strEQ(d,"ge") || strEQ(d,"GE"))
a687059c
LW
914 ROP(O_SGE);
915 if (strEQ(d,"grep"))
916 FL2(O_GREP);
378cc40b
LW
917 if (strEQ(d,"goto"))
918 LOOPX(O_GOTO);
919 if (strEQ(d,"gmtime"))
a687059c
LW
920 UNI(O_GMTIME);
921 if (strEQ(d,"getc"))
922 FOP(O_GETC);
923 if (strnEQ(d,"get",3)) {
924 d += 3;
925 if (*d == 'p') {
926 if (strEQ(d,"ppid"))
927 FUN0(O_GETPPID);
928 if (strEQ(d,"pgrp"))
929 UNI(O_GETPGRP);
930 if (strEQ(d,"priority"))
931 FUN2(O_GETPRIORITY);
932 if (strEQ(d,"protobyname"))
933 UNI(O_GPBYNAME);
934 if (strEQ(d,"protobynumber"))
935 FUN1(O_GPBYNUMBER);
936 if (strEQ(d,"protoent"))
937 FUN0(O_GPROTOENT);
938 if (strEQ(d,"pwent"))
939 FUN0(O_GPWENT);
940 if (strEQ(d,"pwnam"))
941 FUN1(O_GPWNAM);
942 if (strEQ(d,"pwuid"))
943 FUN1(O_GPWUID);
944 if (strEQ(d,"peername"))
945 FOP(O_GETPEERNAME);
946 }
947 else if (*d == 'h') {
948 if (strEQ(d,"hostbyname"))
949 UNI(O_GHBYNAME);
950 if (strEQ(d,"hostbyaddr"))
951 FUN2(O_GHBYADDR);
952 if (strEQ(d,"hostent"))
953 FUN0(O_GHOSTENT);
954 }
955 else if (*d == 'n') {
956 if (strEQ(d,"netbyname"))
957 UNI(O_GNBYNAME);
958 if (strEQ(d,"netbyaddr"))
959 FUN2(O_GNBYADDR);
960 if (strEQ(d,"netent"))
961 FUN0(O_GNETENT);
962 }
963 else if (*d == 's') {
964 if (strEQ(d,"servbyname"))
965 FUN2(O_GSBYNAME);
966 if (strEQ(d,"servbyport"))
967 FUN2(O_GSBYPORT);
968 if (strEQ(d,"servent"))
969 FUN0(O_GSERVENT);
970 if (strEQ(d,"sockname"))
971 FOP(O_GETSOCKNAME);
972 if (strEQ(d,"sockopt"))
973 FOP3(O_GSOCKOPT);
974 }
975 else if (*d == 'g') {
976 if (strEQ(d,"grent"))
977 FUN0(O_GGRENT);
978 if (strEQ(d,"grnam"))
979 FUN1(O_GGRNAM);
980 if (strEQ(d,"grgid"))
981 FUN1(O_GGRGID);
982 }
983 else if (*d == 'l') {
984 if (strEQ(d,"login"))
985 FUN0(O_GETLOGIN);
986 }
987 d -= 3;
988 }
989 break;
378cc40b
LW
990 case 'h': case 'H':
991 SNARFWORD;
992 if (strEQ(d,"hex"))
a687059c
LW
993 UNI(O_HEX);
994 break;
378cc40b
LW
995 case 'i': case 'I':
996 SNARFWORD;
997 if (strEQ(d,"if")) {
e929a76b 998 yylval.ival = curcmd->c_line;
378cc40b
LW
999 OPERATOR(IF);
1000 }
1001 if (strEQ(d,"index"))
395c3793 1002 FUN2x(O_INDEX);
378cc40b 1003 if (strEQ(d,"int"))
a687059c
LW
1004 UNI(O_INT);
1005 if (strEQ(d,"ioctl"))
1006 FOP3(O_IOCTL);
1007 break;
378cc40b
LW
1008 case 'j': case 'J':
1009 SNARFWORD;
1010 if (strEQ(d,"join"))
a687059c
LW
1011 FL2(O_JOIN);
1012 break;
378cc40b
LW
1013 case 'k': case 'K':
1014 SNARFWORD;
1015 if (strEQ(d,"keys"))
a687059c
LW
1016 HFUN(O_KEYS);
1017 if (strEQ(d,"kill"))
1018 LOP(O_KILL);
1019 break;
378cc40b
LW
1020 case 'l': case 'L':
1021 SNARFWORD;
1022 if (strEQ(d,"last"))
1023 LOOPX(O_LAST);
1024 if (strEQ(d,"local"))
1025 OPERATOR(LOCAL);
1026 if (strEQ(d,"length"))
a687059c 1027 UNI(O_LENGTH);
378cc40b 1028 if (strEQ(d,"lt") || strEQ(d,"LT"))
a687059c 1029 ROP(O_SLT);
378cc40b 1030 if (strEQ(d,"le") || strEQ(d,"LE"))
a687059c 1031 ROP(O_SLE);
378cc40b 1032 if (strEQ(d,"localtime"))
a687059c 1033 UNI(O_LOCALTIME);
378cc40b 1034 if (strEQ(d,"log"))
a687059c 1035 UNI(O_LOG);
378cc40b
LW
1036 if (strEQ(d,"link"))
1037 FUN2(O_LINK);
a687059c
LW
1038 if (strEQ(d,"listen"))
1039 FOP2(O_LISTEN);
1040 if (strEQ(d,"lstat"))
1041 FOP(O_LSTAT);
1042 break;
378cc40b 1043 case 'm': case 'M':
663a0e37
LW
1044 if (s[1] == '\'') {
1045 d = "m";
1046 s++;
1047 }
1048 else {
1049 SNARFWORD;
1050 }
378cc40b
LW
1051 if (strEQ(d,"m")) {
1052 s = scanpat(s-1);
a687059c
LW
1053 if (yylval.arg)
1054 TERM(PATTERN);
1055 else
1056 RETURN(1); /* force error */
378cc40b 1057 }
395c3793
LW
1058 switch (d[1]) {
1059 case 'k':
1060 if (strEQ(d,"mkdir"))
1061 FUN2(O_MKDIR);
1062 break;
1063 case 's':
1064 if (strEQ(d,"msgctl"))
1065 FUN3(O_MSGCTL);
1066 if (strEQ(d,"msgget"))
1067 FUN2(O_MSGGET);
1068 if (strEQ(d,"msgrcv"))
1069 FUN5(O_MSGRCV);
1070 if (strEQ(d,"msgsnd"))
1071 FUN3(O_MSGSND);
1072 break;
1073 }
a687059c 1074 break;
378cc40b
LW
1075 case 'n': case 'N':
1076 SNARFWORD;
1077 if (strEQ(d,"next"))
1078 LOOPX(O_NEXT);
1079 if (strEQ(d,"ne") || strEQ(d,"NE"))
a687059c
LW
1080 EOP(O_SNE);
1081 break;
378cc40b
LW
1082 case 'o': case 'O':
1083 SNARFWORD;
1084 if (strEQ(d,"open"))
1085 OPERATOR(OPEN);
1086 if (strEQ(d,"ord"))
a687059c 1087 UNI(O_ORD);
378cc40b 1088 if (strEQ(d,"oct"))
a687059c
LW
1089 UNI(O_OCT);
1090 if (strEQ(d,"opendir"))
d48672a2 1091 FOP2(O_OPEN_DIR);
a687059c 1092 break;
378cc40b
LW
1093 case 'p': case 'P':
1094 SNARFWORD;
1095 if (strEQ(d,"print")) {
2f3197b3 1096 checkcomma(s,d,"filehandle");
a687059c 1097 LOP(O_PRINT);
378cc40b
LW
1098 }
1099 if (strEQ(d,"printf")) {
2f3197b3 1100 checkcomma(s,d,"filehandle");
a687059c 1101 LOP(O_PRTF);
378cc40b
LW
1102 }
1103 if (strEQ(d,"push")) {
1104 yylval.ival = O_PUSH;
1105 OPERATOR(PUSH);
1106 }
1107 if (strEQ(d,"pop"))
1108 OPERATOR(POP);
a687059c
LW
1109 if (strEQ(d,"pack"))
1110 FL2(O_PACK);
1111 if (strEQ(d,"package"))
1112 OPERATOR(PACKAGE);
9f68db38 1113 if (strEQ(d,"pipe"))
2f3197b3 1114 FOP22(O_PIPE_OP);
a687059c 1115 break;
378cc40b
LW
1116 case 'q': case 'Q':
1117 SNARFWORD;
a687059c 1118 if (strEQ(d,"q")) {
2f3197b3 1119 s = scanstr(s-1, SCAN_DEF);
a687059c
LW
1120 TERM(RSTRING);
1121 }
1122 if (strEQ(d,"qq")) {
2f3197b3 1123 s = scanstr(s-2, SCAN_DEF);
a687059c
LW
1124 TERM(RSTRING);
1125 }
fe14fcc3 1126 if (strEQ(d,"qx")) {
2f3197b3 1127 s = scanstr(s-2, SCAN_DEF);
fe14fcc3
LW
1128 TERM(RSTRING);
1129 }
a687059c 1130 break;
378cc40b
LW
1131 case 'r': case 'R':
1132 SNARFWORD;
a687059c 1133 if (strEQ(d,"return"))
9f68db38 1134 OLDLOP(O_RETURN);
e929a76b
LW
1135 if (strEQ(d,"require")) {
1136 allstabs = TRUE; /* must initialize everything since */
1137 UNI(O_REQUIRE); /* we don't know what will be used */
1138 }
378cc40b
LW
1139 if (strEQ(d,"reset"))
1140 UNI(O_RESET);
1141 if (strEQ(d,"redo"))
1142 LOOPX(O_REDO);
1143 if (strEQ(d,"rename"))
1144 FUN2(O_RENAME);
a687059c
LW
1145 if (strEQ(d,"rand"))
1146 UNI(O_RAND);
1147 if (strEQ(d,"rmdir"))
1148 UNI(O_RMDIR);
1149 if (strEQ(d,"rindex"))
395c3793 1150 FUN2x(O_RINDEX);
a687059c
LW
1151 if (strEQ(d,"read"))
1152 FOP3(O_READ);
1153 if (strEQ(d,"readdir"))
1154 FOP(O_READDIR);
1155 if (strEQ(d,"rewinddir"))
1156 FOP(O_REWINDDIR);
1157 if (strEQ(d,"recv"))
1158 FOP4(O_RECV);
1159 if (strEQ(d,"reverse"))
1160 LOP(O_REVERSE);
1161 if (strEQ(d,"readlink"))
1162 UNI(O_READLINK);
1163 break;
378cc40b 1164 case 's': case 'S':
663a0e37
LW
1165 if (s[1] == '\'') {
1166 d = "s";
1167 s++;
1168 }
1169 else {
1170 SNARFWORD;
1171 }
378cc40b
LW
1172 if (strEQ(d,"s")) {
1173 s = scansubst(s);
a687059c
LW
1174 if (yylval.arg)
1175 TERM(SUBST);
1176 else
1177 RETURN(1); /* force error */
1178 }
1179 switch (d[1]) {
1180 case 'a':
1181 case 'b':
395c3793 1182 break;
a687059c 1183 case 'c':
395c3793
LW
1184 if (strEQ(d,"scalar"))
1185 UNI(O_SCALAR);
1186 break;
a687059c
LW
1187 case 'd':
1188 break;
1189 case 'e':
1190 if (strEQ(d,"select"))
e929a76b 1191 OPERATOR(SSELECT);
a687059c
LW
1192 if (strEQ(d,"seek"))
1193 FOP3(O_SEEK);
395c3793
LW
1194 if (strEQ(d,"semctl"))
1195 FUN4(O_SEMCTL);
1196 if (strEQ(d,"semget"))
1197 FUN3(O_SEMGET);
1198 if (strEQ(d,"semop"))
1199 FUN2(O_SEMOP);
a687059c
LW
1200 if (strEQ(d,"send"))
1201 FOP3(O_SEND);
1202 if (strEQ(d,"setpgrp"))
1203 FUN2(O_SETPGRP);
1204 if (strEQ(d,"setpriority"))
1205 FUN3(O_SETPRIORITY);
1206 if (strEQ(d,"sethostent"))
1207 FUN1(O_SHOSTENT);
1208 if (strEQ(d,"setnetent"))
1209 FUN1(O_SNETENT);
1210 if (strEQ(d,"setservent"))
1211 FUN1(O_SSERVENT);
1212 if (strEQ(d,"setprotoent"))
1213 FUN1(O_SPROTOENT);
1214 if (strEQ(d,"setpwent"))
1215 FUN0(O_SPWENT);
1216 if (strEQ(d,"setgrent"))
1217 FUN0(O_SGRENT);
1218 if (strEQ(d,"seekdir"))
1219 FOP2(O_SEEKDIR);
1220 if (strEQ(d,"setsockopt"))
1221 FOP4(O_SSOCKOPT);
1222 break;
1223 case 'f':
1224 case 'g':
1225 break;
1226 case 'h':
1227 if (strEQ(d,"shift"))
1228 TERM(SHIFT);
395c3793
LW
1229 if (strEQ(d,"shmctl"))
1230 FUN3(O_SHMCTL);
1231 if (strEQ(d,"shmget"))
1232 FUN3(O_SHMGET);
1233 if (strEQ(d,"shmread"))
1234 FUN4(O_SHMREAD);
1235 if (strEQ(d,"shmwrite"))
1236 FUN4(O_SHMWRITE);
a687059c
LW
1237 if (strEQ(d,"shutdown"))
1238 FOP2(O_SHUTDOWN);
1239 break;
1240 case 'i':
1241 if (strEQ(d,"sin"))
1242 UNI(O_SIN);
1243 break;
1244 case 'j':
1245 case 'k':
1246 break;
1247 case 'l':
1248 if (strEQ(d,"sleep"))
1249 UNI(O_SLEEP);
1250 break;
1251 case 'm':
1252 case 'n':
1253 break;
1254 case 'o':
1255 if (strEQ(d,"socket"))
1256 FOP4(O_SOCKET);
1257 if (strEQ(d,"socketpair"))
e929a76b 1258 FOP25(O_SOCKPAIR);
a687059c 1259 if (strEQ(d,"sort")) {
2f3197b3 1260 checkcomma(s,d,"subroutine name");
a687059c 1261 d = bufend;
de3bb511 1262 while (s < d && isSPACE(*s)) s++;
a687059c
LW
1263 if (*s == ';' || *s == ')') /* probably a close */
1264 fatal("sort is now a reserved word");
de3bb511
LW
1265 if (isALPHA(*s) || *s == '_') {
1266 /*SUPPRESS 530*/
1267 for (d = s; isALNUM(*d); d++) ;
03a14243 1268 strncpy(tokenbuf,s,d-s);
2f3197b3 1269 tokenbuf[d-s] = '\0';
03a14243
LW
1270 if (strNE(tokenbuf,"keys") &&
1271 strNE(tokenbuf,"values") &&
1272 strNE(tokenbuf,"split") &&
1273 strNE(tokenbuf,"grep") &&
1274 strNE(tokenbuf,"readdir") &&
1275 strNE(tokenbuf,"unpack") &&
1276 strNE(tokenbuf,"do") &&
de3bb511
LW
1277 strNE(tokenbuf,"eval") &&
1278 (d >= bufend || isSPACE(*d)) )
a687059c
LW
1279 *(--s) = '\\'; /* force next ident to WORD */
1280 }
1281 LOP(O_SORT);
1282 }
1283 break;
1284 case 'p':
1285 if (strEQ(d,"split"))
1286 TERM(SPLIT);
1287 if (strEQ(d,"sprintf"))
1288 FL(O_SPRINTF);
79a0689e
LW
1289 if (strEQ(d,"splice")) {
1290 yylval.ival = O_SPLICE;
1291 OPERATOR(PUSH);
1292 }
a687059c
LW
1293 break;
1294 case 'q':
1295 if (strEQ(d,"sqrt"))
1296 UNI(O_SQRT);
1297 break;
1298 case 'r':
1299 if (strEQ(d,"srand"))
1300 UNI(O_SRAND);
1301 break;
1302 case 's':
1303 break;
1304 case 't':
1305 if (strEQ(d,"stat"))
1306 FOP(O_STAT);
1307 if (strEQ(d,"study")) {
1308 sawstudy++;
1309 LFUN(O_STUDY);
1310 }
1311 break;
1312 case 'u':
1313 if (strEQ(d,"substr"))
395c3793 1314 FUN2x(O_SUBSTR);
a687059c 1315 if (strEQ(d,"sub")) {
de3bb511 1316 yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
988174c1
LW
1317 savelong(&subline);
1318 saveitem(subname);
de3bb511 1319
e929a76b 1320 subline = curcmd->c_line;
a687059c 1321 d = bufend;
de3bb511 1322 while (s < d && isSPACE(*s))
a687059c 1323 s++;
de3bb511 1324 if (isALPHA(*s) || *s == '_' || *s == '\'') {
988174c1
LW
1325 str_sset(subname,curstname);
1326 str_ncat(subname,"'",1);
1327 for (d = s+1; isALNUM(*d) || *d == '\''; d++)
1328 /*SUPPRESS 530*/
1329 ;
1330 if (d[-1] == '\'')
1331 d--;
1332 str_ncat(subname,s,d-s);
a687059c
LW
1333 *(--s) = '\\'; /* force next ident to WORD */
1334 }
988174c1 1335 else
a687059c
LW
1336 str_set(subname,"?");
1337 OPERATOR(SUB);
1338 }
1339 break;
1340 case 'v':
1341 case 'w':
1342 case 'x':
1343 break;
1344 case 'y':
1345 if (strEQ(d,"system")) {
1346 set_csh();
1347 LOP(O_SYSTEM);
1348 }
1349 if (strEQ(d,"symlink"))
1350 FUN2(O_SYMLINK);
1351 if (strEQ(d,"syscall"))
1352 LOP(O_SYSCALL);
395c3793
LW
1353 if (strEQ(d,"sysread"))
1354 FOP3(O_SYSREAD);
1355 if (strEQ(d,"syswrite"))
1356 FOP3(O_SYSWRITE);
a687059c
LW
1357 break;
1358 case 'z':
1359 break;
1360 }
1361 break;
378cc40b
LW
1362 case 't': case 'T':
1363 SNARFWORD;
1364 if (strEQ(d,"tr")) {
1365 s = scantrans(s);
a687059c
LW
1366 if (yylval.arg)
1367 TERM(TRANS);
1368 else
1369 RETURN(1); /* force error */
378cc40b
LW
1370 }
1371 if (strEQ(d,"tell"))
a687059c
LW
1372 FOP(O_TELL);
1373 if (strEQ(d,"telldir"))
1374 FOP(O_TELLDIR);
378cc40b
LW
1375 if (strEQ(d,"time"))
1376 FUN0(O_TIME);
1377 if (strEQ(d,"times"))
1378 FUN0(O_TMS);
e929a76b
LW
1379 if (strEQ(d,"truncate"))
1380 FOP2(O_TRUNCATE);
a687059c 1381 break;
378cc40b
LW
1382 case 'u': case 'U':
1383 SNARFWORD;
1384 if (strEQ(d,"using"))
1385 OPERATOR(USING);
1386 if (strEQ(d,"until")) {
e929a76b 1387 yylval.ival = curcmd->c_line;
378cc40b
LW
1388 OPERATOR(UNTIL);
1389 }
1390 if (strEQ(d,"unless")) {
e929a76b 1391 yylval.ival = curcmd->c_line;
378cc40b
LW
1392 OPERATOR(UNLESS);
1393 }
a687059c
LW
1394 if (strEQ(d,"unlink"))
1395 LOP(O_UNLINK);
1396 if (strEQ(d,"undef"))
1397 LFUN(O_UNDEF);
1398 if (strEQ(d,"unpack"))
1399 FUN2(O_UNPACK);
1400 if (strEQ(d,"utime"))
1401 LOP(O_UTIME);
378cc40b 1402 if (strEQ(d,"umask"))
a687059c 1403 UNI(O_UMASK);
378cc40b
LW
1404 if (strEQ(d,"unshift")) {
1405 yylval.ival = O_UNSHIFT;
1406 OPERATOR(PUSH);
1407 }
a687059c 1408 break;
378cc40b
LW
1409 case 'v': case 'V':
1410 SNARFWORD;
1411 if (strEQ(d,"values"))
a687059c
LW
1412 HFUN(O_VALUES);
1413 if (strEQ(d,"vec")) {
1414 sawvec = TRUE;
1415 FUN3(O_VEC);
1416 }
1417 break;
378cc40b
LW
1418 case 'w': case 'W':
1419 SNARFWORD;
378cc40b 1420 if (strEQ(d,"while")) {
e929a76b 1421 yylval.ival = curcmd->c_line;
378cc40b
LW
1422 OPERATOR(WHILE);
1423 }
a687059c
LW
1424 if (strEQ(d,"warn"))
1425 LOP(O_WARN);
378cc40b
LW
1426 if (strEQ(d,"wait"))
1427 FUN0(O_WAIT);
395c3793
LW
1428 if (strEQ(d,"waitpid"))
1429 FUN2(O_WAITPID);
a687059c
LW
1430 if (strEQ(d,"wantarray")) {
1431 yylval.arg = op_new(1);
1432 yylval.arg->arg_type = O_ITEM;
1433 yylval.arg[1].arg_type = A_WANTARRAY;
1434 TERM(RSTRING);
1435 }
1436 if (strEQ(d,"write"))
1437 FOP(O_WRITE);
1438 break;
378cc40b 1439 case 'x': case 'X':
2f3197b3
LW
1440 if (*s == 'x' && isDIGIT(s[1]) && !expectterm) {
1441 s++;
a687059c 1442 MOP(O_REPEAT);
2f3197b3
LW
1443 }
1444 SNARFWORD;
1445 if (strEQ(d,"x")) {
1446 if (!expectterm)
1447 MOP(O_REPEAT);
1448 check_uni();
1449 }
a687059c 1450 break;
378cc40b 1451 case 'y': case 'Y':
663a0e37
LW
1452 if (s[1] == '\'') {
1453 d = "y";
1454 s++;
1455 }
1456 else {
1457 SNARFWORD;
1458 }
378cc40b
LW
1459 if (strEQ(d,"y")) {
1460 s = scantrans(s);
1461 TERM(TRANS);
1462 }
a687059c 1463 break;
378cc40b
LW
1464 case 'z': case 'Z':
1465 SNARFWORD;
a687059c
LW
1466 break;
1467 }
1468 yylval.cval = savestr(d);
2f3197b3
LW
1469 if (expectterm == 2) { /* special case: start of statement */
1470 while (isSPACE(*s)) s++;
1471 if (*s == ':') {
1472 s++;
1473 CLINE;
1474 OPERATOR(LABEL);
1475 }
1476 TERM(WORD);
1477 }
a687059c
LW
1478 expectterm = FALSE;
1479 if (oldoldbufptr && oldoldbufptr < bufptr) {
de3bb511 1480 while (isSPACE(*oldoldbufptr))
a687059c
LW
1481 oldoldbufptr++;
1482 if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
1483 expectterm = TRUE;
1484 else if (*oldoldbufptr == 's' && strnEQ(oldoldbufptr,"sort",4))
1485 expectterm = TRUE;
1486 }
1487 return (CLINE, bufptr = s, (int)WORD);
1488}
1489
fe14fcc3 1490void
2f3197b3 1491checkcomma(s,name,what)
a687059c 1492register char *s;
2f3197b3 1493char *name;
a687059c
LW
1494char *what;
1495{
2f3197b3
LW
1496 char *w;
1497
1498 if (dowarn && *s == ' ' && s[1] == '(') {
1499 w = index(s,')');
1500 if (w)
1501 for (w++; *w && isSPACE(*w); w++) ;
1502 if (!w || !*w || !index(";|}", *w)) /* an advisory hack only... */
1503 warn("%s (...) interpreted as function",name);
1504 }
1505 while (s < bufend && isSPACE(*s))
1506 s++;
a687059c
LW
1507 if (*s == '(')
1508 s++;
de3bb511 1509 while (s < bufend && isSPACE(*s))
a687059c 1510 s++;
de3bb511 1511 if (isALPHA(*s) || *s == '_') {
2f3197b3 1512 w = s++;
de3bb511 1513 while (isALNUM(*s))
a687059c 1514 s++;
de3bb511 1515 while (s < bufend && isSPACE(*s))
a687059c 1516 s++;
e929a76b
LW
1517 if (*s == ',') {
1518 *s = '\0';
2f3197b3 1519 w = instr(
e929a76b
LW
1520 "tell eof times getlogin wait length shift umask getppid \
1521 cos exp int log rand sin sqrt ord wantarray",
2f3197b3 1522 w);
e929a76b 1523 *s = ',';
2f3197b3 1524 if (w)
e929a76b 1525 return;
a687059c 1526 fatal("No comma allowed after %s", what);
e929a76b 1527 }
378cc40b
LW
1528 }
1529}
1530
1531char *
fe14fcc3 1532scanident(s,send,dest)
378cc40b 1533register char *s;
a687059c 1534register char *send;
378cc40b
LW
1535char *dest;
1536{
1537 register char *d;
a687059c 1538 int brackets = 0;
378cc40b 1539
a687059c 1540 reparse = Nullch;
378cc40b
LW
1541 s++;
1542 d = dest;
de3bb511
LW
1543 if (isDIGIT(*s)) {
1544 while (isDIGIT(*s))
378cc40b
LW
1545 *d++ = *s++;
1546 }
1547 else {
de3bb511 1548 while (isALNUM(*s) || *s == '\'')
378cc40b
LW
1549 *d++ = *s++;
1550 }
663a0e37 1551 while (d > dest+1 && d[-1] == '\'')
a687059c 1552 d--,s--;
378cc40b
LW
1553 *d = '\0';
1554 d = dest;
1555 if (!*d) {
1556 *d = *s++;
a687059c 1557 if (*d == '{' /* } */ ) {
378cc40b 1558 d = dest;
a687059c
LW
1559 brackets++;
1560 while (s < send && brackets) {
de3bb511 1561 if (!reparse && (d == dest || (*s && isALNUM(*s) ))) {
a687059c
LW
1562 *d++ = *s++;
1563 continue;
1564 }
1565 else if (!reparse)
1566 reparse = s;
1567 switch (*s++) {
1568 /* { */
1569 case '}':
1570 brackets--;
1571 if (reparse && reparse == s - 1)
1572 reparse = Nullch;
1573 break;
1574 case '{': /* } */
1575 brackets++;
1576 break;
1577 }
1578 }
378cc40b
LW
1579 *d = '\0';
1580 d = dest;
378cc40b
LW
1581 }
1582 else
1583 d[1] = '\0';
1584 }
de3bb511
LW
1585 if (*d == '^' && (isUPPER(*s) || index("[\\]^_?", *s))) {
1586#ifdef DEBUGGING
1587 if (*s == 'D')
1588 debug |= 32768;
1589#endif
fe14fcc3 1590 *d = *s++ ^ 64;
de3bb511 1591 }
378cc40b
LW
1592 return s;
1593}
1594
de3bb511 1595void
d48672a2
LW
1596scanconst(spat,string,len)
1597SPAT *spat;
378cc40b 1598char *string;
a687059c 1599int len;
378cc40b 1600{
de3bb511 1601 register STR *tmpstr;
378cc40b
LW
1602 register char *t;
1603 register char *d;
a687059c 1604 register char *e;
d48672a2
LW
1605 char *origstring = string;
1606 static char *vert = "|";
378cc40b 1607
d48672a2 1608 if (ninstr(string, string+len, vert, vert+1))
de3bb511 1609 return;
d48672a2
LW
1610 if (*string == '^')
1611 string++, len--;
de3bb511
LW
1612 tmpstr = Str_new(86,len);
1613 str_nset(tmpstr,string,len);
1614 t = str_get(tmpstr);
a687059c 1615 e = t + len;
de3bb511 1616 tmpstr->str_u.str_useful = 100;
a687059c 1617 for (d=t; d < e; ) {
378cc40b 1618 switch (*d) {
a687059c 1619 case '{':
de3bb511 1620 if (isDIGIT(d[1]))
a687059c
LW
1621 e = d;
1622 else
1623 goto defchar;
1624 break;
1625 case '.': case '[': case '$': case '(': case ')': case '|': case '+':
de3bb511 1626 case '^':
a687059c 1627 e = d;
378cc40b
LW
1628 break;
1629 case '\\':
de3bb511 1630 if (d[1] && index("wWbB0123456789sSdDlLuUExc",d[1])) {
a687059c 1631 e = d;
378cc40b
LW
1632 break;
1633 }
2f3197b3 1634 Move(d+1,d,e-d,char);
a687059c 1635 e--;
378cc40b
LW
1636 switch(*d) {
1637 case 'n':
1638 *d = '\n';
1639 break;
1640 case 't':
1641 *d = '\t';
1642 break;
1643 case 'f':
1644 *d = '\f';
1645 break;
1646 case 'r':
1647 *d = '\r';
1648 break;
fe14fcc3
LW
1649 case 'e':
1650 *d = '\033';
1651 break;
1652 case 'a':
1653 *d = '\007';
1654 break;
378cc40b
LW
1655 }
1656 /* FALL THROUGH */
1657 default:
a687059c
LW
1658 defchar:
1659 if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
1660 e = d;
378cc40b
LW
1661 break;
1662 }
1663 d++;
1664 }
1665 }
a687059c 1666 if (d == t) {
de3bb511
LW
1667 str_free(tmpstr);
1668 return;
378cc40b 1669 }
a687059c 1670 *d = '\0';
de3bb511 1671 tmpstr->str_cur = d - t;
d48672a2
LW
1672 if (d == t+len)
1673 spat->spat_flags |= SPAT_ALL;
1674 if (*origstring != '^')
1675 spat->spat_flags |= SPAT_SCANFIRST;
de3bb511 1676 spat->spat_short = tmpstr;
d48672a2 1677 spat->spat_slen = d - t;
378cc40b
LW
1678}
1679
1680char *
1681scanpat(s)
1682register char *s;
1683{
a687059c 1684 register SPAT *spat;
378cc40b 1685 register char *d;
a687059c
LW
1686 register char *e;
1687 int len;
1688 SPAT savespat;
395c3793 1689 STR *str = Str_new(93,0);
1462b684 1690 char delim;
378cc40b 1691
a687059c
LW
1692 Newz(801,spat,1,SPAT);
1693 spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
1694 curstash->tbl_spatroot = spat;
378cc40b
LW
1695
1696 switch (*s++) {
1697 case 'm':
1698 s++;
1699 break;
1700 case '/':
1701 break;
1702 case '?':
1703 spat->spat_flags |= SPAT_ONCE;
1704 break;
1705 default:
1706 fatal("panic: scanpat");
1707 }
395c3793 1708 s = str_append_till(str,s,bufend,s[-1],patleave);
a687059c 1709 if (s >= bufend) {
395c3793 1710 str_free(str);
a687059c
LW
1711 yyerror("Search pattern not terminated");
1712 yylval.arg = Nullarg;
1713 return s;
1714 }
1462b684 1715 delim = *s++;
d48672a2 1716 while (*s == 'i' || *s == 'o' || *s == 'g') {
a687059c
LW
1717 if (*s == 'i') {
1718 s++;
1719 sawi = TRUE;
1720 spat->spat_flags |= SPAT_FOLD;
1721 }
1722 if (*s == 'o') {
1723 s++;
1724 spat->spat_flags |= SPAT_KEEP;
1725 }
d48672a2
LW
1726 if (*s == 'g') {
1727 s++;
1728 spat->spat_flags |= SPAT_GLOBAL;
1729 }
378cc40b 1730 }
395c3793
LW
1731 len = str->str_cur;
1732 e = str->str_ptr + len;
1462b684
LW
1733 if (delim == '\'')
1734 d = e;
1735 else
1736 d = str->str_ptr;
1737 for (; d < e; d++) {
e929a76b
LW
1738 if (*d == '\\')
1739 d++;
1740 else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
1741 (*d == '@')) {
378cc40b
LW
1742 register ARG *arg;
1743
1744 spat->spat_runtime = arg = op_new(1);
1745 arg->arg_type = O_ITEM;
1746 arg[1].arg_type = A_DOUBLE;
395c3793 1747 arg[1].arg_ptr.arg_str = str_smake(str);
fe14fcc3 1748 d = scanident(d,bufend,buf);
a687059c
LW
1749 (void)stabent(buf,TRUE); /* make sure it's created */
1750 for (; d < e; d++) {
e929a76b
LW
1751 if (*d == '\\')
1752 d++;
1753 else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') {
fe14fcc3 1754 d = scanident(d,bufend,buf);
a687059c
LW
1755 (void)stabent(buf,TRUE);
1756 }
e929a76b 1757 else if (*d == '@') {
fe14fcc3 1758 d = scanident(d,bufend,buf);
a687059c
LW
1759 if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
1760 strEQ(buf,"SIG") || strEQ(buf,"INC"))
1761 (void)stabent(buf,TRUE);
1762 }
1763 }
378cc40b
LW
1764 goto got_pat; /* skip compiling for now */
1765 }
1766 }
a687059c 1767 if (spat->spat_flags & SPAT_FOLD)
2f3197b3 1768 StructCopy(spat, &savespat, SPAT);
d48672a2 1769 scanconst(spat,str->str_ptr,len);
a687059c
LW
1770 if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
1771 fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
395c3793 1772 spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
e929a76b 1773 spat->spat_flags & SPAT_FOLD);
a687059c
LW
1774 /* Note that this regexp can still be used if someone says
1775 * something like /a/ && s//b/; so we can't delete it.
1776 */
1777 }
1778 else {
1779 if (spat->spat_flags & SPAT_FOLD)
2f3197b3 1780 StructCopy(&savespat, spat, SPAT);
a687059c
LW
1781 if (spat->spat_short)
1782 fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
395c3793 1783 spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
fe14fcc3 1784 spat->spat_flags & SPAT_FOLD);
a687059c
LW
1785 hoistmust(spat);
1786 }
378cc40b 1787 got_pat:
395c3793 1788 str_free(str);
378cc40b
LW
1789 yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
1790 return s;
1791}
1792
1793char *
2f3197b3
LW
1794scansubst(start)
1795char *start;
378cc40b 1796{
2f3197b3 1797 register char *s = start;
a687059c 1798 register SPAT *spat;
378cc40b 1799 register char *d;
a687059c
LW
1800 register char *e;
1801 int len;
395c3793 1802 STR *str = Str_new(93,0);
2f3197b3
LW
1803 char term = *s;
1804
1805 if (term && (d = index("([{< )]}> )]}>",term)))
1806 term = d[5];
378cc40b 1807
a687059c
LW
1808 Newz(802,spat,1,SPAT);
1809 spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
1810 curstash->tbl_spatroot = spat;
378cc40b 1811
2f3197b3 1812 s = str_append_till(str,s+1,bufend,term,patleave);
a687059c 1813 if (s >= bufend) {
395c3793 1814 str_free(str);
a687059c
LW
1815 yyerror("Substitution pattern not terminated");
1816 yylval.arg = Nullarg;
1817 return s;
1818 }
395c3793
LW
1819 len = str->str_cur;
1820 e = str->str_ptr + len;
1821 for (d = str->str_ptr; d < e; d++) {
1822 if (*d == '\\')
1823 d++;
1824 else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') ||
1825 *d == '@' ) {
378cc40b
LW
1826 register ARG *arg;
1827
1828 spat->spat_runtime = arg = op_new(1);
1829 arg->arg_type = O_ITEM;
1830 arg[1].arg_type = A_DOUBLE;
395c3793 1831 arg[1].arg_ptr.arg_str = str_smake(str);
de3bb511 1832 d = scanident(d,e,buf);
a687059c
LW
1833 (void)stabent(buf,TRUE); /* make sure it's created */
1834 for (; *d; d++) {
1835 if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
de3bb511 1836 d = scanident(d,e,buf);
a687059c
LW
1837 (void)stabent(buf,TRUE);
1838 }
1839 else if (*d == '@' && d[-1] != '\\') {
de3bb511 1840 d = scanident(d,e,buf);
a687059c
LW
1841 if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
1842 strEQ(buf,"SIG") || strEQ(buf,"INC"))
1843 (void)stabent(buf,TRUE);
1844 }
1845 }
378cc40b
LW
1846 goto get_repl; /* skip compiling for now */
1847 }
1848 }
d48672a2 1849 scanconst(spat,str->str_ptr,len);
378cc40b 1850get_repl:
2f3197b3
LW
1851 if (term != *start)
1852 s++;
1853 s = scanstr(s, SCAN_REPL);
a687059c 1854 if (s >= bufend) {
395c3793 1855 str_free(str);
a687059c
LW
1856 yyerror("Substitution replacement not terminated");
1857 yylval.arg = Nullarg;
1858 return s;
1859 }
378cc40b 1860 spat->spat_repl = yylval.arg;
a687059c
LW
1861 if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
1862 spat->spat_flags |= SPAT_CONST;
1863 else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
1864 STR *tmpstr;
1865 register char *t;
1866
1867 spat->spat_flags |= SPAT_CONST;
1868 tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
1869 e = tmpstr->str_ptr + tmpstr->str_cur;
1870 for (t = tmpstr->str_ptr; t < e; t++) {
9f68db38 1871 if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
de3bb511 1872 (t[1] == '{' /*}*/ && isDIGIT(t[2])) ))
a687059c
LW
1873 spat->spat_flags &= ~SPAT_CONST;
1874 }
1875 }
1876 while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
2f3197b3
LW
1877 int es = 0;
1878
a687059c
LW
1879 if (*s == 'e') {
1880 s++;
2f3197b3 1881 es++;
a687059c
LW
1882 if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
1883 spat->spat_repl[1].arg_type = A_SINGLE;
de3bb511 1884 spat->spat_repl = make_op(
2f3197b3
LW
1885 (!es && spat->spat_repl[1].arg_type == A_SINGLE
1886 ? O_EVALONCE
1887 : O_EVAL),
de3bb511 1888 2,
a687059c
LW
1889 spat->spat_repl,
1890 Nullarg,
395c3793 1891 Nullarg);
a687059c
LW
1892 spat->spat_flags &= ~SPAT_CONST;
1893 }
378cc40b
LW
1894 if (*s == 'g') {
1895 s++;
d48672a2 1896 spat->spat_flags |= SPAT_GLOBAL;
378cc40b
LW
1897 }
1898 if (*s == 'i') {
1899 s++;
a687059c 1900 sawi = TRUE;
378cc40b 1901 spat->spat_flags |= SPAT_FOLD;
a687059c
LW
1902 if (!(spat->spat_flags & SPAT_SCANFIRST)) {
1903 str_free(spat->spat_short); /* anchored opt doesn't do */
1904 spat->spat_short = Nullstr; /* case insensitive match */
1905 spat->spat_slen = 0;
1906 }
1907 }
1908 if (*s == 'o') {
1909 s++;
1910 spat->spat_flags |= SPAT_KEEP;
378cc40b
LW
1911 }
1912 }
a687059c
LW
1913 if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
1914 fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
378cc40b 1915 if (!spat->spat_runtime) {
395c3793 1916 spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
fe14fcc3 1917 spat->spat_flags & SPAT_FOLD);
378cc40b 1918 hoistmust(spat);
378cc40b
LW
1919 }
1920 yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
395c3793 1921 str_free(str);
378cc40b
LW
1922 return s;
1923}
1924
1462b684 1925void
378cc40b
LW
1926hoistmust(spat)
1927register SPAT *spat;
1928{
d48672a2
LW
1929 if (!spat->spat_short && spat->spat_regexp->regstart &&
1930 (!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH)
1931 ) {
d48672a2
LW
1932 if (!(spat->spat_regexp->reganch & ROPT_ANCH))
1933 spat->spat_flags |= SPAT_SCANFIRST;
1462b684
LW
1934 else if (spat->spat_flags & SPAT_FOLD)
1935 return;
1936 spat->spat_short = str_smake(spat->spat_regexp->regstart);
d48672a2
LW
1937 }
1938 else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */
378cc40b 1939 if (spat->spat_short &&
a687059c
LW
1940 str_eq(spat->spat_short,spat->spat_regexp->regmust))
1941 {
378cc40b
LW
1942 if (spat->spat_flags & SPAT_SCANFIRST) {
1943 str_free(spat->spat_short);
1944 spat->spat_short = Nullstr;
1945 }
1946 else {
1947 str_free(spat->spat_regexp->regmust);
1948 spat->spat_regexp->regmust = Nullstr;
1949 return;
1950 }
1951 }
1952 if (!spat->spat_short || /* promote the better string */
1953 ((spat->spat_flags & SPAT_SCANFIRST) &&
1954 (spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
1955 str_free(spat->spat_short); /* ok if null */
1956 spat->spat_short = spat->spat_regexp->regmust;
1957 spat->spat_regexp->regmust = Nullstr;
1958 spat->spat_flags |= SPAT_SCANFIRST;
1959 }
1960 }
1961}
1962
1963char *
2f3197b3
LW
1964scantrans(start)
1965char *start;
378cc40b 1966{
2f3197b3 1967 register char *s = start;
378cc40b 1968 ARG *arg =
a687059c 1969 l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
2f3197b3
LW
1970 STR *tstr;
1971 STR *rstr;
378cc40b
LW
1972 register char *t;
1973 register char *r;
395c3793 1974 register short *tbl;
378cc40b 1975 register int i;
13281fa4 1976 register int j;
a687059c 1977 int tlen, rlen;
395c3793
LW
1978 int squash;
1979 int delete;
1980 int complement;
378cc40b 1981
395c3793 1982 New(803,tbl,256,short);
378cc40b 1983 arg[2].arg_type = A_NULL;
395c3793 1984 arg[2].arg_ptr.arg_cval = (char*) tbl;
2f3197b3
LW
1985
1986 s = scanstr(s, SCAN_TR);
a687059c
LW
1987 if (s >= bufend) {
1988 yyerror("Translation pattern not terminated");
1989 yylval.arg = Nullarg;
1990 return s;
1991 }
2f3197b3
LW
1992 tstr = yylval.arg[1].arg_ptr.arg_str;
1993 yylval.arg[1].arg_ptr.arg_str = Nullstr;
fe14fcc3 1994 arg_free(yylval.arg);
2f3197b3
LW
1995 t = tstr->str_ptr;
1996 tlen = tstr->str_cur;
1997
1998 if (s[-1] == *start)
1999 s--;
2000
2001 s = scanstr(s, SCAN_TR|SCAN_REPL);
a687059c
LW
2002 if (s >= bufend) {
2003 yyerror("Translation replacement not terminated");
2004 yylval.arg = Nullarg;
2005 return s;
2006 }
2f3197b3
LW
2007 rstr = yylval.arg[1].arg_ptr.arg_str;
2008 yylval.arg[1].arg_ptr.arg_str = Nullstr;
2009 arg_free(yylval.arg);
2010 r = rstr->str_ptr;
2011 rlen = rstr->str_cur;
2012
395c3793
LW
2013 complement = delete = squash = 0;
2014 while (*s == 'c' || *s == 'd' || *s == 's') {
2015 if (*s == 'c')
2016 complement = 1;
2017 else if (*s == 'd')
2018 delete = 2;
2019 else
2020 squash = 1;
2021 s++;
2022 }
395c3793 2023 arg[2].arg_len = delete|squash;
378cc40b 2024 yylval.arg = arg;
395c3793
LW
2025 if (complement) {
2026 Zero(tbl, 256, short);
2027 for (i = 0; i < tlen; i++)
2028 tbl[t[i] & 0377] = -1;
fe14fcc3 2029 for (i = 0, j = 0; i < 256; i++) {
395c3793
LW
2030 if (!tbl[i]) {
2031 if (j >= rlen) {
fe14fcc3 2032 if (delete)
395c3793 2033 tbl[i] = -2;
2f3197b3
LW
2034 else if (rlen)
2035 tbl[i] = r[j-1] & 0377;
fe14fcc3 2036 else
2f3197b3 2037 tbl[i] = i;
395c3793 2038 }
fe14fcc3 2039 else
2f3197b3 2040 tbl[i] = r[j++] & 0377;
395c3793
LW
2041 }
2042 }
2043 }
2044 else {
2f3197b3
LW
2045 if (!rlen && !delete) {
2046 r = t; rlen = tlen;
2047 }
395c3793
LW
2048 for (i = 0; i < 256; i++)
2049 tbl[i] = -1;
2050 for (i = 0, j = 0; i < tlen; i++,j++) {
2051 if (j >= rlen) {
2052 if (delete) {
2053 if (tbl[t[i] & 0377] == -1)
2054 tbl[t[i] & 0377] = -2;
2055 continue;
2056 }
2057 --j;
2058 }
2059 if (tbl[t[i] & 0377] == -1)
34de22dd 2060 tbl[t[i] & 0377] = r[j] & 0377;
395c3793 2061 }
378cc40b 2062 }
2f3197b3
LW
2063 str_free(tstr);
2064 str_free(rstr);
378cc40b
LW
2065 return s;
2066}
2067
2068char *
2f3197b3
LW
2069scanstr(start, in_what)
2070char *start;
2071int in_what;
378cc40b 2072{
2f3197b3 2073 register char *s = start;
378cc40b
LW
2074 register char term;
2075 register char *d;
2076 register ARG *arg;
a687059c 2077 register char *send;
378cc40b
LW
2078 register bool makesingle = FALSE;
2079 register STAB *stab;
a687059c
LW
2080 bool alwaysdollar = FALSE;
2081 bool hereis = FALSE;
2082 STR *herewas;
e929a76b 2083 STR *str;
2f3197b3
LW
2084 /* which backslash sequences to keep */
2085 char *leave = (in_what & SCAN_TR)
2086 ? "\\$@nrtfbeacx0123456789-"
2087 : "\\$@nrtfbeacx0123456789[{]}lLuUE";
a687059c 2088 int len;
378cc40b
LW
2089
2090 arg = op_new(1);
2091 yylval.arg = arg;
2092 arg->arg_type = O_ITEM;
2093
2094 switch (*s) {
2095 default: /* a substitution replacement */
2096 arg[1].arg_type = A_DOUBLE;
2097 makesingle = TRUE; /* maybe disable runtime scanning */
2098 term = *s;
2099 if (term == '\'')
2100 leave = Nullch;
2101 goto snarf_it;
2102 case '0':
2103 {
395c3793 2104 unsigned long i;
378cc40b
LW
2105 int shift;
2106
2107 arg[1].arg_type = A_SINGLE;
2108 if (s[1] == 'x') {
2109 shift = 4;
2110 s += 2;
2111 }
2112 else if (s[1] == '.')
2113 goto decimal;
2114 else
2115 shift = 3;
2116 i = 0;
2117 for (;;) {
2118 switch (*s) {
2119 default:
2120 goto out;
de3bb511
LW
2121 case '_':
2122 s++;
2123 break;
378cc40b
LW
2124 case '8': case '9':
2125 if (shift != 4)
a687059c 2126 yyerror("Illegal octal digit");
378cc40b
LW
2127 /* FALL THROUGH */
2128 case '0': case '1': case '2': case '3': case '4':
2129 case '5': case '6': case '7':
2130 i <<= shift;
2131 i += *s++ & 15;
2132 break;
2133 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
2134 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
2135 if (shift != 4)
2136 goto out;
2137 i <<= 4;
2138 i += (*s++ & 7) + 9;
2139 break;
2140 }
2141 }
2142 out:
e929a76b
LW
2143 str = Str_new(92,0);
2144 str_numset(str,(double)i);
2145 if (str->str_ptr) {
2146 Safefree(str->str_ptr);
2147 str->str_ptr = Nullch;
2148 str->str_len = str->str_cur = 0;
2149 }
2150 arg[1].arg_ptr.arg_str = str;
378cc40b
LW
2151 }
2152 break;
2153 case '1': case '2': case '3': case '4': case '5':
2154 case '6': case '7': case '8': case '9': case '.':
2155 decimal:
2156 arg[1].arg_type = A_SINGLE;
2157 d = tokenbuf;
de3bb511 2158 while (isDIGIT(*s) || *s == '_') {
378cc40b
LW
2159 if (*s == '_')
2160 s++;
2161 else
2162 *d++ = *s++;
2163 }
2f3197b3 2164 if (*s == '.' && s[1] != '.') {
378cc40b 2165 *d++ = *s++;
de3bb511 2166 while (isDIGIT(*s) || *s == '_') {
378cc40b
LW
2167 if (*s == '_')
2168 s++;
2169 else
2170 *d++ = *s++;
2171 }
2172 }
a687059c 2173 if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
378cc40b
LW
2174 *d++ = *s++;
2175 if (*s == '+' || *s == '-')
2176 *d++ = *s++;
de3bb511 2177 while (isDIGIT(*s))
378cc40b
LW
2178 *d++ = *s++;
2179 }
2180 *d = '\0';
e929a76b
LW
2181 str = Str_new(92,0);
2182 str_numset(str,atof(tokenbuf));
2183 if (str->str_ptr) {
2184 Safefree(str->str_ptr);
2185 str->str_ptr = Nullch;
2186 str->str_len = str->str_cur = 0;
2187 }
2188 arg[1].arg_ptr.arg_str = str;
378cc40b 2189 break;
378cc40b 2190 case '<':
2f3197b3
LW
2191 if (in_what & (SCAN_REPL|SCAN_TR))
2192 goto do_double;
a687059c
LW
2193 if (*++s == '<') {
2194 hereis = TRUE;
2195 d = tokenbuf;
2196 if (!rsfp)
2197 *d++ = '\n';
2198 if (*++s && index("`'\"",*s)) {
2199 term = *s++;
2200 s = cpytill(d,s,bufend,term,&len);
2201 if (s < bufend)
2202 s++;
2203 d += len;
2204 }
2205 else {
2206 if (*s == '\\')
2207 s++, term = '\'';
2208 else
2209 term = '"';
de3bb511 2210 while (isALNUM(*s))
a687059c
LW
2211 *d++ = *s++;
2212 } /* assuming tokenbuf won't clobber */
2213 *d++ = '\n';
2214 *d = '\0';
2215 len = d - tokenbuf;
2216 d = "\n";
2217 if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
2218 herewas = str_make(s,bufend-s);
2219 else
2220 s--, herewas = str_make(s,d-s);
2221 s += herewas->str_cur;
2222 if (term == '\'')
2223 goto do_single;
2224 if (term == '`')
2225 goto do_back;
2226 goto do_double;
2227 }
378cc40b 2228 d = tokenbuf;
a687059c
LW
2229 s = cpytill(d,s,bufend,'>',&len);
2230 if (s < bufend)
378cc40b 2231 s++;
2f3197b3
LW
2232 else
2233 fatal("Unterminated <> operator");
2234
378cc40b 2235 if (*d == '$') d++;
de3bb511 2236 while (*d && (isALNUM(*d) || *d == '\''))
a687059c
LW
2237 d++;
2238 if (d - tokenbuf != len) {
2f3197b3
LW
2239 s = start;
2240 term = *s;
378cc40b 2241 arg[1].arg_type = A_GLOB;
a687059c 2242 set_csh();
2f3197b3
LW
2243 alwaysdollar = TRUE; /* treat $) and $| as variables */
2244 goto snarf_it;
378cc40b
LW
2245 }
2246 else {
2247 d = tokenbuf;
a687059c
LW
2248 if (!len)
2249 (void)strcpy(d,"ARGV");
378cc40b
LW
2250 if (*d == '$') {
2251 arg[1].arg_type = A_INDREAD;
2252 arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
2253 }
2254 else {
2255 arg[1].arg_type = A_READ;
378cc40b 2256 arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
a687059c
LW
2257 if (!stab_io(arg[1].arg_ptr.arg_stab))
2258 stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
378cc40b 2259 if (strEQ(d,"ARGV")) {
a687059c
LW
2260 (void)aadd(arg[1].arg_ptr.arg_stab);
2261 stab_io(arg[1].arg_ptr.arg_stab)->flags |=
378cc40b
LW
2262 IOF_ARGV|IOF_START;
2263 }
2264 }
2265 }
2266 break;
a687059c
LW
2267
2268 case 'q':
2269 s++;
2270 if (*s == 'q') {
2271 s++;
2272 goto do_double;
2273 }
fe14fcc3
LW
2274 if (*s == 'x') {
2275 s++;
2276 goto do_back;
2277 }
a687059c
LW
2278 /* FALL THROUGH */
2279 case '\'':
2280 do_single:
2281 term = *s;
2282 arg[1].arg_type = A_SINGLE;
2283 leave = Nullch;
2284 goto snarf_it;
2285
378cc40b 2286 case '"':
a687059c
LW
2287 do_double:
2288 term = *s;
378cc40b
LW
2289 arg[1].arg_type = A_DOUBLE;
2290 makesingle = TRUE; /* maybe disable runtime scanning */
a687059c 2291 alwaysdollar = TRUE; /* treat $) and $| as variables */
378cc40b
LW
2292 goto snarf_it;
2293 case '`':
a687059c 2294 do_back:
378cc40b 2295 term = *s;
a687059c
LW
2296 arg[1].arg_type = A_BACKTICK;
2297 set_csh();
2298 alwaysdollar = TRUE; /* treat $) and $| as variables */
378cc40b
LW
2299 snarf_it:
2300 {
2301 STR *tmpstr;
2f3197b3 2302 STR *tmpstr2 = Nullstr;
378cc40b 2303 char *tmps;
e334a159 2304 char *start;
514dae0d 2305 bool dorange = FALSE;
378cc40b 2306
d48672a2 2307 CLINE;
e929a76b 2308 multi_start = curcmd->c_line;
a687059c
LW
2309 if (hereis)
2310 multi_open = multi_close = '<';
2311 else {
2312 multi_open = term;
395c3793 2313 if (term && (tmps = index("([{< )]}> )]}>",term)))
a687059c
LW
2314 term = tmps[5];
2315 multi_close = term;
2316 }
9f68db38 2317 tmpstr = Str_new(87,80);
a687059c
LW
2318 if (hereis) {
2319 term = *tokenbuf;
2320 if (!rsfp) {
2321 d = s;
2322 while (s < bufend &&
2323 (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
2324 if (*s++ == '\n')
e929a76b 2325 curcmd->c_line++;
a687059c
LW
2326 }
2327 if (s >= bufend) {
e929a76b 2328 curcmd->c_line = multi_start;
a687059c
LW
2329 fatal("EOF in string");
2330 }
2331 str_nset(tmpstr,d+1,s-d);
2332 s += len - 1;
2333 str_ncat(herewas,s,bufend-s);
2334 str_replace(linestr,herewas);
2335 oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
2336 bufend = linestr->str_ptr + linestr->str_cur;
2337 hereis = FALSE;
2338 }
e929a76b
LW
2339 else
2340 str_nset(tmpstr,"",0); /* avoid "uninitialized" warning */
a687059c
LW
2341 }
2342 else
2343 s = str_append_till(tmpstr,s+1,bufend,term,leave);
2344 while (s >= bufend) { /* multiple line string? */
2345 if (!rsfp ||
2346 !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
e929a76b 2347 curcmd->c_line = multi_start;
378cc40b
LW
2348 fatal("EOF in string");
2349 }
e929a76b 2350 curcmd->c_line++;
a687059c
LW
2351 if (perldb) {
2352 STR *str = Str_new(88,0);
2353
2354 str_sset(str,linestr);
395c3793
LW
2355 astore(stab_xarray(curcmd->c_filestab),
2356 (int)curcmd->c_line,str);
a687059c
LW
2357 }
2358 bufend = linestr->str_ptr + linestr->str_cur;
2359 if (hereis) {
2360 if (*s == term && bcmp(s,tokenbuf,len) == 0) {
2361 s = bufend - 1;
2362 *s = ' ';
2363 str_scat(linestr,herewas);
2364 bufend = linestr->str_ptr + linestr->str_cur;
2365 }
2366 else {
2367 s = bufend;
2368 str_scat(tmpstr,linestr);
2369 }
2370 }
2371 else
2372 s = str_append_till(tmpstr,s,bufend,term,leave);
378cc40b 2373 }
e929a76b 2374 multi_end = curcmd->c_line;
378cc40b 2375 s++;
a687059c
LW
2376 if (tmpstr->str_cur + 5 < tmpstr->str_len) {
2377 tmpstr->str_len = tmpstr->str_cur + 1;
2378 Renew(tmpstr->str_ptr, tmpstr->str_len, char);
2379 }
2f3197b3 2380 if (arg[1].arg_type == A_SINGLE) {
378cc40b
LW
2381 arg[1].arg_ptr.arg_str = tmpstr;
2382 break;
2383 }
2384 tmps = s;
2385 s = tmpstr->str_ptr;
a687059c
LW
2386 send = s + tmpstr->str_cur;
2387 while (s < send) { /* see if we can make SINGLE */
de3bb511 2388 if (*s == '\\' && s[1] && isDIGIT(s[1]) && !isDIGIT(s[2]) &&
e929a76b 2389 !alwaysdollar && s[1] != '0')
378cc40b 2390 *s = '$'; /* grandfather \digit in subst */
a687059c
LW
2391 if ((*s == '$' || *s == '@') && s+1 < send &&
2392 (alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
378cc40b
LW
2393 makesingle = FALSE; /* force interpretation */
2394 }
a687059c 2395 else if (*s == '\\' && s+1 < send) {
fe14fcc3
LW
2396 if (index("lLuUE",s[1]))
2397 makesingle = FALSE;
378cc40b
LW
2398 s++;
2399 }
2400 s++;
2401 }
e334a159 2402 s = d = start = tmpstr->str_ptr; /* assuming shrinkage only */
514dae0d 2403 while (s < send || dorange) {
2f3197b3 2404 if (in_what & SCAN_TR) {
514dae0d 2405 if (dorange) {
2f3197b3 2406 int i;
514dae0d 2407 int max;
2f3197b3
LW
2408 if (!tmpstr2) { /* oops, have to grow */
2409 tmpstr2 = str_smake(tmpstr);
2410 s = tmpstr2->str_ptr + (s - tmpstr->str_ptr);
2411 send = tmpstr2->str_ptr + (send - tmpstr->str_ptr);
2412 }
2413 i = d - tmpstr->str_ptr;
2414 STR_GROW(tmpstr, tmpstr->str_len + 256);
2415 d = tmpstr->str_ptr + i;
514dae0d
LW
2416 d -= 2;
2417 max = d[1] & 0377;
2418 for (i = (*d & 0377); i <= max; i++)
2f3197b3 2419 *d++ = i;
e334a159 2420 start = s;
514dae0d 2421 dorange = FALSE;
2f3197b3
LW
2422 continue;
2423 }
e334a159 2424 else if (*s == '-' && s+1 < send && s != start) {
514dae0d
LW
2425 dorange = TRUE;
2426 s++;
2427 }
378cc40b 2428 }
2f3197b3
LW
2429 else {
2430 if ((*s == '$' && s+1 < send &&
2431 (alwaysdollar || /*(*/(s[1] != ')' && s[1] != '|')) ) ||
2432 (*s == '@' && s+1 < send) ) {
2433 if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
2434 *d++ = *s++;
2435 len = scanident(s,send,tokenbuf) - s;
2436 if (*s == '$' || strEQ(tokenbuf,"ARGV")
2437 || strEQ(tokenbuf,"ENV")
2438 || strEQ(tokenbuf,"SIG")
2439 || strEQ(tokenbuf,"INC") )
2440 (void)stabent(tokenbuf,TRUE); /* add symbol */
2441 while (len--)
2442 *d++ = *s++;
2443 continue;
2444 }
2445 }
2446 if (*s == '\\' && s+1 < send) {
378cc40b
LW
2447 s++;
2448 switch (*s) {
514dae0d
LW
2449 case '-':
2450 if (in_what & SCAN_TR) {
2451 *d++ = *s++;
2452 continue;
2453 }
2454 /* FALL THROUGH */
378cc40b 2455 default:
a687059c 2456 if (!makesingle && (!leave || (*s && index(leave,*s))))
378cc40b
LW
2457 *d++ = '\\';
2458 *d++ = *s++;
2459 continue;
2460 case '0': case '1': case '2': case '3':
2461 case '4': case '5': case '6': case '7':
fe14fcc3
LW
2462 *d++ = scanoct(s, 3, &len);
2463 s += len;
2464 continue;
2465 case 'x':
2466 *d++ = scanhex(++s, 2, &len);
2467 s += len;
2468 continue;
2469 case 'c':
2470 s++;
2471 *d = *s++;
de3bb511 2472 if (isLOWER(*d))
fe14fcc3
LW
2473 *d = toupper(*d);
2474 *d++ ^= 64;
378cc40b
LW
2475 continue;
2476 case 'b':
2477 *d++ = '\b';
2478 break;
2479 case 'n':
2480 *d++ = '\n';
2481 break;
2482 case 'r':
2483 *d++ = '\r';
2484 break;
2485 case 'f':
2486 *d++ = '\f';
2487 break;
2488 case 't':
2489 *d++ = '\t';
2490 break;
fe14fcc3
LW
2491 case 'e':
2492 *d++ = '\033';
2493 break;
2494 case 'a':
2495 *d++ = '\007';
2496 break;
378cc40b
LW
2497 }
2498 s++;
2499 continue;
2500 }
2501 *d++ = *s++;
2502 }
2503 *d = '\0';
2504
2f3197b3
LW
2505 if (arg[1].arg_type == A_DOUBLE && makesingle)
2506 arg[1].arg_type = A_SINGLE; /* now we can optimize on it */
a687059c 2507
a687059c 2508 tmpstr->str_cur = d - tmpstr->str_ptr;
2f3197b3
LW
2509 if (arg[1].arg_type == A_GLOB) {
2510 arg[1].arg_ptr.arg_stab = stab = genstab();
2511 stab_io(stab) = stio_new();
2512 str_sset(stab_val(stab), tmpstr);
2513 }
2514 else
2515 arg[1].arg_ptr.arg_str = tmpstr;
378cc40b 2516 s = tmps;
2f3197b3
LW
2517 if (tmpstr2)
2518 str_free(tmpstr2);
378cc40b
LW
2519 break;
2520 }
2521 }
a687059c
LW
2522 if (hereis)
2523 str_free(herewas);
378cc40b
LW
2524 return s;
2525}
2526
2527FCMD *
2528load_format()
2529{
2530 FCMD froot;
2531 FCMD *flinebeg;
0f85fab0 2532 char *eol;
378cc40b
LW
2533 register FCMD *fprev = &froot;
2534 register FCMD *fcmd;
2535 register char *s;
2536 register char *t;
a687059c 2537 register STR *str;
378cc40b 2538 bool noblank;
a687059c 2539 bool repeater;
378cc40b 2540
a687059c 2541 Zero(&froot, 1, FCMD);
0f85fab0 2542 s = bufptr;
27e2fb84 2543 while (s < bufend || (rsfp && (s = str_gets(linestr,rsfp, 0)) != Nullch)) {
e929a76b 2544 curcmd->c_line++;
0f85fab0
LW
2545 if (in_eval && !rsfp) {
2546 eol = index(s,'\n');
2547 if (!eol++)
2548 eol = bufend;
2549 }
2550 else
2551 eol = bufend = linestr->str_ptr + linestr->str_cur;
395c3793
LW
2552 if (perldb) {
2553 STR *tmpstr = Str_new(89,0);
2554
2555 str_nset(tmpstr, s, eol-s);
2556 astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
2557 }
27e2fb84 2558 if (*s == '.') {
de3bb511 2559 /*SUPPRESS 530*/
27e2fb84
LW
2560 for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
2561 if (*t == '\n') {
2562 bufptr = s;
2563 return froot.f_next;
2564 }
378cc40b 2565 }
0f85fab0
LW
2566 if (*s == '#') {
2567 s = eol;
378cc40b 2568 continue;
0f85fab0 2569 }
378cc40b
LW
2570 flinebeg = Nullfcmd;
2571 noblank = FALSE;
a687059c 2572 repeater = FALSE;
0f85fab0 2573 while (s < eol) {
a687059c 2574 Newz(804,fcmd,1,FCMD);
378cc40b
LW
2575 fprev->f_next = fcmd;
2576 fprev = fcmd;
0f85fab0 2577 for (t=s; t < eol && *t != '@' && *t != '^'; t++) {
378cc40b
LW
2578 if (*t == '~') {
2579 noblank = TRUE;
2580 *t = ' ';
a687059c
LW
2581 if (t[1] == '~') {
2582 repeater = TRUE;
2583 t[1] = ' ';
2584 }
378cc40b
LW
2585 }
2586 }
a687059c
LW
2587 fcmd->f_pre = nsavestr(s, t-s);
2588 fcmd->f_presize = t-s;
378cc40b 2589 s = t;
0f85fab0 2590 if (s >= eol) {
378cc40b
LW
2591 if (noblank)
2592 fcmd->f_flags |= FC_NOBLANK;
a687059c
LW
2593 if (repeater)
2594 fcmd->f_flags |= FC_REPEAT;
378cc40b
LW
2595 break;
2596 }
2597 if (!flinebeg)
2598 flinebeg = fcmd; /* start values here */
2599 if (*s++ == '^')
2600 fcmd->f_flags |= FC_CHOP; /* for doing text filling */
2601 switch (*s) {
2602 case '*':
2603 fcmd->f_type = F_LINES;
2604 *s = '\0';
2605 break;
2606 case '<':
2607 fcmd->f_type = F_LEFT;
2608 while (*s == '<')
2609 s++;
2610 break;
2611 case '>':
2612 fcmd->f_type = F_RIGHT;
2613 while (*s == '>')
2614 s++;
2615 break;
2616 case '|':
2617 fcmd->f_type = F_CENTER;
2618 while (*s == '|')
2619 s++;
2620 break;
395c3793
LW
2621 case '#':
2622 case '.':
2623 /* Catch the special case @... and handle it as a string
2624 field. */
2625 if (*s == '.' && s[1] == '.') {
2626 goto default_format;
2627 }
2628 fcmd->f_type = F_DECIMAL;
2629 {
2630 char *p;
2631
2632 /* Read a format in the form @####.####, where either group
2633 of ### may be empty, or the final .### may be missing. */
2634 while (*s == '#')
2635 s++;
2636 if (*s == '.') {
2637 s++;
2638 p = s;
2639 while (*s == '#')
2640 s++;
2641 fcmd->f_decimals = s-p;
2642 fcmd->f_flags |= FC_DP;
2643 } else {
2644 fcmd->f_decimals = 0;
2645 }
2646 }
2647 break;
378cc40b 2648 default:
395c3793 2649 default_format:
378cc40b
LW
2650 fcmd->f_type = F_LEFT;
2651 break;
2652 }
2653 if (fcmd->f_flags & FC_CHOP && *s == '.') {
2654 fcmd->f_flags |= FC_MORE;
2655 while (*s == '.')
2656 s++;
2657 }
2658 fcmd->f_size = s-t;
2659 }
2660 if (flinebeg) {
2661 again:
27e2fb84
LW
2662 if (s >= bufend &&
2663 (!rsfp || (s = str_gets(linestr, rsfp, 0)) == Nullch) )
378cc40b 2664 goto badform;
e929a76b 2665 curcmd->c_line++;
0f85fab0
LW
2666 if (in_eval && !rsfp) {
2667 eol = index(s,'\n');
2668 if (!eol++)
2669 eol = bufend;
2670 }
2671 else
2672 eol = bufend = linestr->str_ptr + linestr->str_cur;
395c3793
LW
2673 if (perldb) {
2674 STR *tmpstr = Str_new(90,0);
2675
2676 str_nset(tmpstr, s, eol-s);
2677 astore(stab_xarray(curcmd->c_filestab),
2678 (int)curcmd->c_line,tmpstr);
2679 }
0f85fab0 2680 if (strnEQ(s,".\n",2)) {
a687059c 2681 bufptr = s;
378cc40b
LW
2682 yyerror("Missing values line");
2683 return froot.f_next;
2684 }
0f85fab0
LW
2685 if (*s == '#') {
2686 s = eol;
378cc40b 2687 goto again;
0f85fab0
LW
2688 }
2689 str = flinebeg->f_unparsed = Str_new(91,eol - s);
a687059c
LW
2690 str->str_u.str_hash = curstash;
2691 str_nset(str,"(",1);
e929a76b 2692 flinebeg->f_line = curcmd->c_line;
0f85fab0
LW
2693 eol[-1] = '\0';
2694 if (!flinebeg->f_next->f_type || index(s, ',')) {
2695 eol[-1] = '\n';
2696 str_ncat(str, s, eol - s - 1);
a687059c 2697 str_ncat(str,",$$);",5);
0f85fab0 2698 s = eol;
a687059c
LW
2699 }
2700 else {
0f85fab0 2701 eol[-1] = '\n';
de3bb511 2702 while (s < eol && isSPACE(*s))
a687059c
LW
2703 s++;
2704 t = s;
0f85fab0 2705 while (s < eol) {
a687059c
LW
2706 switch (*s) {
2707 case ' ': case '\t': case '\n': case ';':
2708 str_ncat(str, t, s - t);
2709 str_ncat(str, "," ,1);
de3bb511 2710 while (s < eol && (isSPACE(*s) || *s == ';'))
a687059c
LW
2711 s++;
2712 t = s;
2713 break;
2714 case '$':
2715 str_ncat(str, t, s - t);
2716 t = s;
fe14fcc3 2717 s = scanident(s,eol,tokenbuf);
a687059c
LW
2718 str_ncat(str, t, s - t);
2719 t = s;
0f85fab0 2720 if (s < eol && *s && index("$'\"",*s))
a687059c
LW
2721 str_ncat(str, ",", 1);
2722 break;
2723 case '"': case '\'':
2724 str_ncat(str, t, s - t);
2725 t = s;
2726 s++;
0f85fab0 2727 while (s < eol && (*s != *t || s[-1] == '\\'))
a687059c 2728 s++;
0f85fab0 2729 if (s < eol)
a687059c
LW
2730 s++;
2731 str_ncat(str, t, s - t);
2732 t = s;
0f85fab0 2733 if (s < eol && *s && index("$'\"",*s))
a687059c
LW
2734 str_ncat(str, ",", 1);
2735 break;
2736 default:
2737 yyerror("Please use commas to separate fields");
378cc40b 2738 }
378cc40b 2739 }
a687059c 2740 str_ncat(str,"$$);",4);
378cc40b 2741 }
378cc40b
LW
2742 }
2743 }
2744 badform:
2745 bufptr = str_get(linestr);
2746 yyerror("Format not terminated");
2747 return froot.f_next;
2748}
a687059c 2749
2f3197b3 2750static void
a687059c
LW
2751set_csh()
2752{
ae986130
LW
2753#ifdef CSH
2754 if (!cshlen)
2755 cshlen = strlen(cshname);
2756#endif
a687059c 2757}