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 1.0 patch 14: a2p incorrectly translates 'for (a in b)' construct.
[perl5.git] / perly.c
CommitLineData
a559c259 1char rcsid[] = "$Header: perly.c,v 1.0.1.3 88/01/28 10:28:31 root Exp $";
8d063cd8
LW		 2/*
3 * $Log: perly.c,v $
a559c259
LW		 4 * Revision 1.0.1.3 88/01/28 10:28:31 root
5 * patch8: added eval operator. Also fixed expectterm following right curly.
6 *
135863df
AB		 7 * Revision 1.0.1.2 88/01/24 00:06:03 root
8 * patch 2: s/(abc)/\1/ grandfathering didn't work right.
9 *
36ce8bec
DF		 10 * Revision 1.0.1.1 88/01/21 21:25:57 root
11 * Now uses CPP and CPPMINUS symbols from config.h.
12 *
8d063cd8
LW		 13 * Revision 1.0 87/12/18 15:53:31 root
14 * Initial revision
15 *
16 */
17
18bool preprocess = FALSE;
19bool assume_n = FALSE;
20bool assume_p = FALSE;
21bool doswitches = FALSE;
a559c259 22bool allstabs = FALSE; /* init all customary symbols in symbol table?*/
8d063cd8
LW		 23char *filename;
24char *e_tmpname = "/tmp/perl-eXXXXXX";
25FILE *e_fp = Nullfp;
26ARG *l();
27
28main(argc,argv,env)
29register int argc;
30register char **argv;
31register char **env;
32{
33 register STR *str;
34 register char *s;
35 char *index();
36
37 linestr = str_new(80);
38 str = str_make("-I/usr/lib/perl "); /* first used for -I flags */
39 for (argc--,argv++; argc; argc--,argv++) {
40 if (argv[0][0] != '-' || !argv[0][1])
41 break;
42 reswitch:
43 switch (argv[0][1]) {
44#ifdef DEBUGGING
45 case 'D':
46 debug = atoi(argv[0]+2);
47#ifdef YYDEBUG
48 yydebug = (debug & 1);
49#endif
50 break;
51#endif
52 case 'e':
53 if (!e_fp) {
54 mktemp(e_tmpname);
55 e_fp = fopen(e_tmpname,"w");
56 }
57 if (argv[1])
58 fputs(argv[1],e_fp);
59 putc('\n', e_fp);
60 argc--,argv++;
61 break;
62 case 'i':
63 inplace = savestr(argv[0]+2);
64 argvoutstab = stabent("ARGVOUT",TRUE);
65 break;
66 case 'I':
67 str_cat(str,argv[0]);
68 str_cat(str," ");
69 if (!argv[0][2]) {
70 str_cat(str,argv[1]);
71 argc--,argv++;
72 str_cat(str," ");
73 }
74 break;
75 case 'n':
76 assume_n = TRUE;
77 strcpy(argv[0], argv[0]+1);
78 goto reswitch;
79 case 'p':
80 assume_p = TRUE;
81 strcpy(argv[0], argv[0]+1);
82 goto reswitch;
83 case 'P':
84 preprocess = TRUE;
85 strcpy(argv[0], argv[0]+1);
86 goto reswitch;
87 case 's':
88 doswitches = TRUE;
89 strcpy(argv[0], argv[0]+1);
90 goto reswitch;
91 case 'v':
92 version();
93 exit(0);
94 case '-':
95 argc--,argv++;
96 goto switch_end;
97 case 0:
98 break;
99 default:
100 fatal("Unrecognized switch: %s\n",argv[0]);
101 }
102 }
103 switch_end:
104 if (e_fp) {
105 fclose(e_fp);
106 argc++,argv--;
107 argv[0] = e_tmpname;
108 }
109
110 str_set(&str_no,No);
111 str_set(&str_yes,Yes);
112 init_eval();
113
114 /* open script */
115
116 if (argv[0] == Nullch)
117 argv[0] = "-";
118 filename = savestr(argv[0]);
119 if (strEQ(filename,"-"))
120 argv[0] = "";
121 if (preprocess) {
122 sprintf(buf, "\
123/bin/sed -e '/^[^#]/b' \
124 -e '/^#[ ]*include[ ]/b' \
125 -e '/^#[ ]*define[ ]/b' \
126 -e '/^#[ ]*if[ ]/b' \
127 -e '/^#[ ]*ifdef[ ]/b' \
128 -e '/^#[ ]*else/b' \
129 -e '/^#[ ]*endif/b' \
130 -e 's/^#.*//' \
36ce8bec
DF		 131 %s | %s -C %s%s",
132 argv[0], CPP, str_get(str), CPPMINUS);
8d063cd8
LW		 133 rsfp = popen(buf,"r");
134 }
135 else if (!*argv[0])
136 rsfp = stdin;
137 else
138 rsfp = fopen(argv[0],"r");
139 if (rsfp == Nullfp)
140 fatal("Perl script \"%s\" doesn't seem to exist.\n",filename);
141 str_free(str); /* free -I directories */
142
143 defstab = stabent("_",TRUE);
144
145 /* init tokener */
146
147 bufptr = str_get(linestr);
148
149 /* now parse the report spec */
150
151 if (yyparse())
152 fatal("Execution aborted due to compilation errors.\n");
153
154 if (e_fp) {
155 e_fp = Nullfp;
156 UNLINK(e_tmpname);
157 }
158 argc--,argv++; /* skip name of script */
159 if (doswitches) {
160 for (; argc > 0 && **argv == '-'; argc--,argv++) {
161 if (argv[0][1] == '-') {
162 argc--,argv++;
163 break;
164 }
165 str_numset(stabent(argv[0]+1,TRUE)->stab_val,(double)1.0);
166 }
167 }
a559c259 168 if (argvstab = stabent("ARGV",allstabs)) {
8d063cd8
LW		 169 for (; argc > 0; argc--,argv++) {
170 apush(argvstab->stab_array,str_make(argv[0]));
171 }
172 }
a559c259 173 if (envstab = stabent("ENV",allstabs)) {
8d063cd8
LW		 174 for (; *env; env++) {
175 if (!(s = index(*env,'=')))
176 continue;
177 *s++ = '\0';
178 str = str_make(s);
179 str->str_link.str_magic = envstab;
180 hstore(envstab->stab_hash,*env,str);
181 *--s = '=';
182 }
183 }
a559c259 184 sigstab = stabent("SIG",allstabs);
8d063cd8
LW		 185
186 magicalize("!#?^~=-%0123456789.+&*(),\\/[|");
187
a559c259
LW		 188 (tmpstab = stabent("0",allstabs)) && str_set(STAB_STR(tmpstab),filename);
189 (tmpstab = stabent("$",allstabs)) &&
8d063cd8
LW		 190 str_numset(STAB_STR(tmpstab),(double)getpid());
191
192 tmpstab = stabent("stdin",TRUE);
193 tmpstab->stab_io = stio_new();
194 tmpstab->stab_io->fp = stdin;
195
196 tmpstab = stabent("stdout",TRUE);
197 tmpstab->stab_io = stio_new();
198 tmpstab->stab_io->fp = stdout;
199 defoutstab = tmpstab;
200 curoutstab = tmpstab;
201
202 tmpstab = stabent("stderr",TRUE);
203 tmpstab->stab_io = stio_new();
204 tmpstab->stab_io->fp = stderr;
a559c259
LW		 205 safefree(filename);
206 filename = "(eval)";
8d063cd8
LW		 207
208 setjmp(top_env); /* sets goto_targ on longjump */
209
210#ifdef DEBUGGING
211 if (debug & 1024)
212 dump_cmd(main_root,Nullcmd);
213 if (debug)
214 fprintf(stderr,"\nEXECUTING...\n\n");
215#endif
216
217 /* do it */
218
219 (void) cmd_exec(main_root);
220
221 if (goto_targ)
222 fatal("Can't find label \"%s\"--aborting.\n",goto_targ);
223 exit(0);
224}
225
226magicalize(list)
227register char *list;
228{
229 register STAB *stab;
230 char sym[2];
231
232 sym[1] = '\0';
233 while (*sym = *list++) {
a559c259 234 if (stab = stabent(sym,allstabs)) {
8d063cd8
LW		 235 stab->stab_flags = SF_VMAGIC;
236 stab->stab_val->str_link.str_magic = stab;
237 }
238 }
239}
240
241#define RETURN(retval) return (bufptr = s,retval)
242#define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,retval)
243#define TERM(retval) return (expectterm = FALSE,bufptr = s,retval)
244#define LOOPX(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,LOOPEX)
245#define UNI(f) return (yylval.ival = f,expectterm = TRUE,bufptr = s,UNIOP)
246#define FUN0(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC0)
247#define FUN1(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC1)
248#define FUN2(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC2)
249#define FUN3(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC3)
250#define SFUN(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,STABFUN)
251
252yylex()
253{
254 register char *s = bufptr;
255 register char *d;
256 register int tmp;
257 static bool in_format = FALSE;
258 static bool firstline = TRUE;
259
260 retry:
261#ifdef YYDEBUG
262 if (yydebug)
263 if (index(s,'\n'))
264 fprintf(stderr,"Tokener at %s",s);
265 else
266 fprintf(stderr,"Tokener at %s\n",s);
267#endif
268 switch (*s) {
269 default:
270 fprintf(stderr,
271 "Unrecognized character %c in file %s line %d--ignoring.\n",
272 *s++,filename,line);
273 goto retry;
274 case 0:
275 s = str_get(linestr);
276 *s = '\0';
277 if (firstline && (assume_n || assume_p)) {
278 firstline = FALSE;
279 str_set(linestr,"while (<>) {");
280 s = str_get(linestr);
281 goto retry;
282 }
283 if (!rsfp)
284 RETURN(0);
285 if (in_format) {
286 yylval.formval = load_format(); /* leaves . in buffer */
287 in_format = FALSE;
288 s = str_get(linestr);
289 TERM(FORMLIST);
290 }
291 line++;
292 if ((s = str_gets(linestr, rsfp)) == Nullch) {
293 if (preprocess)
294 pclose(rsfp);
295 else if (rsfp != stdin)
296 fclose(rsfp);
297 rsfp = Nullfp;
298 if (assume_n || assume_p) {
299 str_set(linestr,assume_p ? "}continue{print;" : "");
300 str_cat(linestr,"}");
301 s = str_get(linestr);
302 goto retry;
303 }
304 s = str_get(linestr);
305 RETURN(0);
306 }
307#ifdef DEBUG
308 else if (firstline) {
309 char *showinput();
310 s = showinput();
311 }
312#endif
313 firstline = FALSE;
314 goto retry;
315 case ' ': case '\t':
316 s++;
317 goto retry;
318 case '\n':
319 case '#':
320 if (preprocess && s == str_get(linestr) &&
321 s[1] == ' ' && isdigit(s[2])) {
322 line = atoi(s+2)-1;
323 for (s += 2; isdigit(*s); s++) ;
324 while (*s && isspace(*s)) s++;
325 if (filename)
326 safefree(filename);
327 s[strlen(s)-1] = '\0'; /* wipe out newline */
328 filename = savestr(s);
329 s = str_get(linestr);
330 }
a559c259
LW		 331 if (in_eval) {
332 while (*s && *s != '\n')
333 s++;
334 if (*s)
335 s++;
336 line++;
337 }
338 else
339 *s = '\0';
8d063cd8
LW		 340 if (lex_newlines)
341 RETURN('\n');
342 goto retry;
343 case '+':
344 case '-':
345 if (s[1] == *s) {
346 s++;
347 if (*s++ == '+')
348 RETURN(INC);
349 else
350 RETURN(DEC);
351 }
352 /* FALL THROUGH */
353 case '*':
354 case '%':
355 case '^':
356 case '~':
357 case '(':
358 case ',':
359 case ':':
360 case ';':
361 case '{':
362 case '[':
363 tmp = *s++;
364 OPERATOR(tmp);
365 case ')':
366 case ']':
8d063cd8
LW		 367 tmp = *s++;
368 TERM(tmp);
a559c259
LW		 369 case '}':
370 tmp = *s++;
371 for (d = s; *d == ' ' || *d == '\t'; d++) ;
372 if (*d == '\n' || *d == '#')
373 OPERATOR(tmp); /* block end */
374 else
375 TERM(tmp); /* associative array end */
8d063cd8
LW		 376 case '&':
377 s++;
378 tmp = *s++;
379 if (tmp == '&')
380 OPERATOR(ANDAND);
381 s--;
382 OPERATOR('&');
383 case '|':
384 s++;
385 tmp = *s++;
386 if (tmp == '|')
387 OPERATOR(OROR);
388 s--;
389 OPERATOR('|');
390 case '=':
391 s++;
392 tmp = *s++;
393 if (tmp == '=')
394 OPERATOR(EQ);
395 if (tmp == '~')
396 OPERATOR(MATCH);
397 s--;
398 OPERATOR('=');
399 case '!':
400 s++;
401 tmp = *s++;
402 if (tmp == '=')
403 OPERATOR(NE);
404 if (tmp == '~')
405 OPERATOR(NMATCH);
406 s--;
407 OPERATOR('!');
408 case '<':
409 if (expectterm) {
410 s = scanstr(s);
411 TERM(RSTRING);
412 }
413 s++;
414 tmp = *s++;
415 if (tmp == '<')
416 OPERATOR(LS);
417 if (tmp == '=')
418 OPERATOR(LE);
419 s--;
420 OPERATOR('<');
421 case '>':
422 s++;
423 tmp = *s++;
424 if (tmp == '>')
425 OPERATOR(RS);
426 if (tmp == '=')
427 OPERATOR(GE);
428 s--;
429 OPERATOR('>');
430
431#define SNARFWORD \
432 d = tokenbuf; \
433 while (isalpha(*s) || isdigit(*s) || *s == '_') \
434 *d++ = *s++; \
435 *d = '\0'; \
436 d = tokenbuf;
437
438 case '$':
439 if (s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) {
440 s++;
441 s = scanreg(s,tokenbuf);
442 yylval.stabval = aadd(stabent(tokenbuf,TRUE));
443 TERM(ARYLEN);
444 }
445 s = scanreg(s,tokenbuf);
446 yylval.stabval = stabent(tokenbuf,TRUE);
447 TERM(REG);
448
449 case '@':
450 s = scanreg(s,tokenbuf);
451 yylval.stabval = aadd(stabent(tokenbuf,TRUE));
452 TERM(ARY);
453
454 case '/': /* may either be division or pattern */
455 case '?': /* may either be conditional or pattern */
456 if (expectterm) {
457 s = scanpat(s);
458 TERM(PATTERN);
459 }
460 tmp = *s++;
461 OPERATOR(tmp);
462
463 case '.':
464 if (!expectterm || !isdigit(s[1])) {
465 s++;
466 tmp = *s++;
467 if (tmp == '.')
468 OPERATOR(DOTDOT);
469 s--;
470 OPERATOR('.');
471 }
472 /* FALL THROUGH */
473 case '0': case '1': case '2': case '3': case '4':
474 case '5': case '6': case '7': case '8': case '9':
475 case '\'': case '"': case '`':
476 s = scanstr(s);
477 TERM(RSTRING);
478
479 case '_':
480 SNARFWORD;
481 yylval.cval = savestr(d);
482 OPERATOR(WORD);
483 case 'a': case 'A':
484 SNARFWORD;
485 yylval.cval = savestr(d);
486 OPERATOR(WORD);
487 case 'b': case 'B':
488 SNARFWORD;
489 yylval.cval = savestr(d);
490 OPERATOR(WORD);
491 case 'c': case 'C':
492 SNARFWORD;
493 if (strEQ(d,"continue"))
494 OPERATOR(CONTINUE);
495 if (strEQ(d,"chdir"))
496 UNI(O_CHDIR);
497 if (strEQ(d,"close"))
498 OPERATOR(CLOSE);
499 if (strEQ(d,"crypt"))
500 FUN2(O_CRYPT);
501 if (strEQ(d,"chop"))
502 OPERATOR(CHOP);
503 if (strEQ(d,"chmod")) {
504 yylval.ival = O_CHMOD;
505 OPERATOR(PRINT);
506 }
507 if (strEQ(d,"chown")) {
508 yylval.ival = O_CHOWN;
509 OPERATOR(PRINT);
510 }
511 yylval.cval = savestr(d);
512 OPERATOR(WORD);
513 case 'd': case 'D':
514 SNARFWORD;
515 if (strEQ(d,"do"))
516 OPERATOR(DO);
517 if (strEQ(d,"die"))
518 UNI(O_DIE);
519 yylval.cval = savestr(d);
520 OPERATOR(WORD);
521 case 'e': case 'E':
522 SNARFWORD;
523 if (strEQ(d,"else"))
524 OPERATOR(ELSE);
525 if (strEQ(d,"elsif"))
526 OPERATOR(ELSIF);
527 if (strEQ(d,"eq") || strEQ(d,"EQ"))
528 OPERATOR(SEQ);
529 if (strEQ(d,"exit"))
530 UNI(O_EXIT);
a559c259
LW		 531 if (strEQ(d,"eval")) {
532 allstabs = TRUE; /* must initialize everything since */
533 UNI(O_EVAL); /* we don't know what will be used */
534 }
8d063cd8
LW		 535 if (strEQ(d,"eof"))
536 TERM(FEOF);
537 if (strEQ(d,"exp"))
538 FUN1(O_EXP);
539 if (strEQ(d,"each"))
540 SFUN(O_EACH);
541 if (strEQ(d,"exec")) {
542 yylval.ival = O_EXEC;
543 OPERATOR(PRINT);
544 }
545 yylval.cval = savestr(d);
546 OPERATOR(WORD);
547 case 'f': case 'F':
548 SNARFWORD;
549 if (strEQ(d,"for"))
550 OPERATOR(FOR);
551 if (strEQ(d,"format")) {
552 in_format = TRUE;
553 OPERATOR(FORMAT);
554 }
555 if (strEQ(d,"fork"))
556 FUN0(O_FORK);
557 yylval.cval = savestr(d);
558 OPERATOR(WORD);
559 case 'g': case 'G':
560 SNARFWORD;
561 if (strEQ(d,"gt") || strEQ(d,"GT"))
562 OPERATOR(SGT);
563 if (strEQ(d,"ge") || strEQ(d,"GE"))
564 OPERATOR(SGE);
565 if (strEQ(d,"goto"))
566 LOOPX(O_GOTO);
567 if (strEQ(d,"gmtime"))
568 FUN1(O_GMTIME);
569 yylval.cval = savestr(d);
570 OPERATOR(WORD);
571 case 'h': case 'H':
572 SNARFWORD;
573 if (strEQ(d,"hex"))
574 FUN1(O_HEX);
575 yylval.cval = savestr(d);
576 OPERATOR(WORD);
577 case 'i': case 'I':
578 SNARFWORD;
579 if (strEQ(d,"if"))
580 OPERATOR(IF);
581 if (strEQ(d,"index"))
582 FUN2(O_INDEX);
583 if (strEQ(d,"int"))
584 FUN1(O_INT);
585 yylval.cval = savestr(d);
586 OPERATOR(WORD);
587 case 'j': case 'J':
588 SNARFWORD;
589 if (strEQ(d,"join"))
590 OPERATOR(JOIN);
591 yylval.cval = savestr(d);
592 OPERATOR(WORD);
593 case 'k': case 'K':
594 SNARFWORD;
595 if (strEQ(d,"keys"))
596 SFUN(O_KEYS);
597 if (strEQ(d,"kill")) {
598 yylval.ival = O_KILL;
599 OPERATOR(PRINT);
600 }
601 yylval.cval = savestr(d);
602 OPERATOR(WORD);
603 case 'l': case 'L':
604 SNARFWORD;
605 if (strEQ(d,"last"))
606 LOOPX(O_LAST);
607 if (strEQ(d,"length"))
608 FUN1(O_LENGTH);
609 if (strEQ(d,"lt") || strEQ(d,"LT"))
610 OPERATOR(SLT);
611 if (strEQ(d,"le") || strEQ(d,"LE"))
612 OPERATOR(SLE);
613 if (strEQ(d,"localtime"))
614 FUN1(O_LOCALTIME);
615 if (strEQ(d,"log"))
616 FUN1(O_LOG);
617 if (strEQ(d,"link"))
618 FUN2(O_LINK);
619 yylval.cval = savestr(d);
620 OPERATOR(WORD);
621 case 'm': case 'M':
622 SNARFWORD;
623 if (strEQ(d,"m")) {
624 s = scanpat(s-1);
625 TERM(PATTERN);
626 }
627 yylval.cval = savestr(d);
628 OPERATOR(WORD);
629 case 'n': case 'N':
630 SNARFWORD;
631 if (strEQ(d,"next"))
632 LOOPX(O_NEXT);
633 if (strEQ(d,"ne") || strEQ(d,"NE"))
634 OPERATOR(SNE);
635 yylval.cval = savestr(d);
636 OPERATOR(WORD);
637 case 'o': case 'O':
638 SNARFWORD;
639 if (strEQ(d,"open"))
640 OPERATOR(OPEN);
641 if (strEQ(d,"ord"))
642 FUN1(O_ORD);
643 if (strEQ(d,"oct"))
644 FUN1(O_OCT);
645 yylval.cval = savestr(d);
646 OPERATOR(WORD);
647 case 'p': case 'P':
648 SNARFWORD;
649 if (strEQ(d,"print")) {
650 yylval.ival = O_PRINT;
651 OPERATOR(PRINT);
652 }
653 if (strEQ(d,"printf")) {
654 yylval.ival = O_PRTF;
655 OPERATOR(PRINT);
656 }
657 if (strEQ(d,"push")) {
658 yylval.ival = O_PUSH;
659 OPERATOR(PUSH);
660 }
661 if (strEQ(d,"pop"))
662 OPERATOR(POP);
663 yylval.cval = savestr(d);
664 OPERATOR(WORD);
665 case 'q': case 'Q':
666 SNARFWORD;
667 yylval.cval = savestr(d);
668 OPERATOR(WORD);
669 case 'r': case 'R':
670 SNARFWORD;
671 if (strEQ(d,"reset"))
672 UNI(O_RESET);
673 if (strEQ(d,"redo"))
674 LOOPX(O_REDO);
675 if (strEQ(d,"rename"))
676 FUN2(O_RENAME);
677 yylval.cval = savestr(d);
678 OPERATOR(WORD);
679 case 's': case 'S':
680 SNARFWORD;
681 if (strEQ(d,"s")) {
682 s = scansubst(s);
683 TERM(SUBST);
684 }
685 if (strEQ(d,"shift"))
686 TERM(SHIFT);
687 if (strEQ(d,"split"))
688 TERM(SPLIT);
689 if (strEQ(d,"substr"))
690 FUN3(O_SUBSTR);
691 if (strEQ(d,"sprintf"))
692 OPERATOR(SPRINTF);
693 if (strEQ(d,"sub"))
694 OPERATOR(SUB);
695 if (strEQ(d,"select"))
696 OPERATOR(SELECT);
697 if (strEQ(d,"seek"))
698 OPERATOR(SEEK);
699 if (strEQ(d,"stat"))
700 OPERATOR(STAT);
701 if (strEQ(d,"sqrt"))
702 FUN1(O_SQRT);
703 if (strEQ(d,"sleep"))
704 UNI(O_SLEEP);
705 if (strEQ(d,"system")) {
706 yylval.ival = O_SYSTEM;
707 OPERATOR(PRINT);
708 }
709 yylval.cval = savestr(d);
710 OPERATOR(WORD);
711 case 't': case 'T':
712 SNARFWORD;
713 if (strEQ(d,"tr")) {
714 s = scantrans(s);
715 TERM(TRANS);
716 }
717 if (strEQ(d,"tell"))
718 TERM(TELL);
719 if (strEQ(d,"time"))
720 FUN0(O_TIME);
721 if (strEQ(d,"times"))
722 FUN0(O_TMS);
723 yylval.cval = savestr(d);
724 OPERATOR(WORD);
725 case 'u': case 'U':
726 SNARFWORD;
727 if (strEQ(d,"using"))
728 OPERATOR(USING);
729 if (strEQ(d,"until"))
730 OPERATOR(UNTIL);
731 if (strEQ(d,"unless"))
732 OPERATOR(UNLESS);
733 if (strEQ(d,"umask"))
734 FUN1(O_UMASK);
735 if (strEQ(d,"unshift")) {
736 yylval.ival = O_UNSHIFT;
737 OPERATOR(PUSH);
738 }
739 if (strEQ(d,"unlink")) {
740 yylval.ival = O_UNLINK;
741 OPERATOR(PRINT);
742 }
743 yylval.cval = savestr(d);
744 OPERATOR(WORD);
745 case 'v': case 'V':
746 SNARFWORD;
747 if (strEQ(d,"values"))
748 SFUN(O_VALUES);
749 yylval.cval = savestr(d);
750 OPERATOR(WORD);
751 case 'w': case 'W':
752 SNARFWORD;
753 if (strEQ(d,"write"))
754 TERM(WRITE);
755 if (strEQ(d,"while"))
756 OPERATOR(WHILE);
757 yylval.cval = savestr(d);
758 OPERATOR(WORD);
759 case 'x': case 'X':
760 SNARFWORD;
761 if (!expectterm && strEQ(d,"x"))
762 OPERATOR('x');
763 yylval.cval = savestr(d);
764 OPERATOR(WORD);
765 case 'y': case 'Y':
766 SNARFWORD;
767 if (strEQ(d,"y")) {
768 s = scantrans(s);
769 TERM(TRANS);
770 }
771 yylval.cval = savestr(d);
772 OPERATOR(WORD);
773 case 'z': case 'Z':
774 SNARFWORD;
775 yylval.cval = savestr(d);
776 OPERATOR(WORD);
777 }
778}
779
780STAB *
781stabent(name,add)
782register char *name;
783int add;
784{
785 register STAB *stab;
786
787 for (stab = stab_index[*name]; stab; stab = stab->stab_next) {
788 if (strEQ(name,stab->stab_name))
789 return stab;
790 }
791
792 /* no entry--should we add one? */
793
794 if (add) {
795 stab = (STAB *) safemalloc(sizeof(STAB));
796 bzero((char*)stab, sizeof(STAB));
797 stab->stab_name = savestr(name);
798 stab->stab_val = str_new(0);
799 stab->stab_next = stab_index[*name];
800 stab_index[*name] = stab;
801 return stab;
802 }
803 return Nullstab;
804}
805
806STIO *
807stio_new()
808{
809 STIO *stio = (STIO *) safemalloc(sizeof(STIO));
810
811 bzero((char*)stio, sizeof(STIO));
812 stio->page_len = 60;
813 return stio;
814}
815
816char *
817scanreg(s,dest)
818register char *s;
819char *dest;
820{
821 register char *d;
822
823 s++;
824 d = dest;
825 while (isalpha(*s) || isdigit(*s) || *s == '_')
826 *d++ = *s++;
827 *d = '\0';
828 d = dest;
829 if (!*d) {
830 *d = *s++;
831 if (*d == '{') {
832 d = dest;
833 while (*s && *s != '}')
834 *d++ = *s++;
835 *d = '\0';
836 d = dest;
837 if (*s)
838 s++;
839 }
840 else
841 d[1] = '\0';
842 }
843 if (*d == '^' && !isspace(*s))
844 *d = *s++ & 31;
845 return s;
846}
847
848STR *
849scanconst(string)
850char *string;
851{
852 register STR *retstr;
853 register char *t;
854 register char *d;
855
856 if (index(string,'|')) {
857 return Nullstr;
858 }
859 retstr = str_make(string);
860 t = str_get(retstr);
861 for (d=t; *d; ) {
862 switch (*d) {
863 case '.': case '[': case '$': case '(': case ')': case '|':
864 *d = '\0';
865 break;
866 case '\\':
867 if (index("wWbB0123456789",d[1])) {
868 *d = '\0';
869 break;
870 }
871 strcpy(d,d+1);
872 switch(*d) {
873 case 'n':
874 *d = '\n';
875 break;
876 case 't':
877 *d = '\t';
878 break;
879 case 'f':
880 *d = '\f';
881 break;
882 case 'r':
883 *d = '\r';
884 break;
885 }
886 /* FALL THROUGH */
887 default:
888 if (d[1] == '*' || d[1] == '+' || d[1] == '?') {
889 *d = '\0';
890 break;
891 }
892 d++;
893 }
894 }
895 if (!*t) {
896 str_free(retstr);
897 return Nullstr;
898 }
899 retstr->str_cur = strlen(retstr->str_ptr); /* XXX cheating here */
900 return retstr;
901}
902
903char *
904scanpat(s)
905register char *s;
906{
907 register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT));
908 register char *d;
909
910 bzero((char *)spat, sizeof(SPAT));
911 spat->spat_next = spat_root; /* link into spat list */
912 spat_root = spat;
913 init_compex(&spat->spat_compex);
914
915 switch (*s++) {
916 case 'm':
917 s++;
918 break;
919 case '/':
920 break;
921 case '?':
922 spat->spat_flags |= SPAT_USE_ONCE;
923 break;
924 default:
925 fatal("Search pattern not found:\n%s",str_get(linestr));
926 }
927 s = cpytill(tokenbuf,s,s[-1]);
928 if (!*s)
929 fatal("Search pattern not terminated:\n%s",str_get(linestr));
930 s++;
931 if (*tokenbuf == '^') {
932 spat->spat_first = scanconst(tokenbuf+1);
933 if (spat->spat_first) {
934 spat->spat_flen = strlen(spat->spat_first->str_ptr);
935 if (spat->spat_flen == strlen(tokenbuf+1))
936 spat->spat_flags |= SPAT_SCANALL;
937 }
938 }
939 else {
940 spat->spat_flags |= SPAT_SCANFIRST;
941 spat->spat_first = scanconst(tokenbuf);
942 if (spat->spat_first) {
943 spat->spat_flen = strlen(spat->spat_first->str_ptr);
944 if (spat->spat_flen == strlen(tokenbuf))
945 spat->spat_flags |= SPAT_SCANALL;
946 }
947 }
948 if (d = compile(&spat->spat_compex,tokenbuf,TRUE,FALSE))
949 fatal(d);
950 yylval.arg = make_match(O_MATCH,stab_to_arg(A_STAB,defstab),spat);
951 return s;
952}
953
954char *
955scansubst(s)
956register char *s;
957{
958 register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT));
959 register char *d;
960
961 bzero((char *)spat, sizeof(SPAT));
962 spat->spat_next = spat_root; /* link into spat list */
963 spat_root = spat;
964 init_compex(&spat->spat_compex);
965
966 s = cpytill(tokenbuf,s+1,*s);
967 if (!*s)
968 fatal("Substitution pattern not terminated:\n%s",str_get(linestr));
969 for (d=tokenbuf; *d; d++) {
970 if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
971 register ARG *arg;
972
973 spat->spat_runtime = arg = op_new(1);
974 arg->arg_type = O_ITEM;
975 arg[1].arg_type = A_DOUBLE;
976 arg[1].arg_ptr.arg_str = str_make(tokenbuf);
977 goto get_repl; /* skip compiling for now */
978 }
979 }
980 if (*tokenbuf == '^') {
981 spat->spat_first = scanconst(tokenbuf+1);
982 if (spat->spat_first)
983 spat->spat_flen = strlen(spat->spat_first->str_ptr);
984 }
985 else {
986 spat->spat_flags |= SPAT_SCANFIRST;
987 spat->spat_first = scanconst(tokenbuf);
988 if (spat->spat_first)
989 spat->spat_flen = strlen(spat->spat_first->str_ptr);
990 }
991 if (d = compile(&spat->spat_compex,tokenbuf,TRUE,FALSE))
992 fatal(d);
993get_repl:
994 s = scanstr(s);
995 if (!*s)
996 fatal("Substitution replacement not terminated:\n%s",str_get(linestr));
997 spat->spat_repl = yylval.arg;
998 if (*s == 'g') {
999 s++;
1000 spat->spat_flags &= ~SPAT_USE_ONCE;
1001 }
1002 else
1003 spat->spat_flags |= SPAT_USE_ONCE;
1004 yylval.arg = make_match(O_SUBST,stab_to_arg(A_STAB,defstab),spat);
1005 return s;
1006}
1007
1008ARG *
1009make_split(stab,arg)
1010register STAB *stab;
1011register ARG *arg;
1012{
1013 if (arg->arg_type != O_MATCH) {
1014 register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT));
1015 register char *d;
1016
1017 bzero((char *)spat, sizeof(SPAT));
1018 spat->spat_next = spat_root; /* link into spat list */
1019 spat_root = spat;
1020 init_compex(&spat->spat_compex);
1021
1022 spat->spat_runtime = arg;
1023 arg = make_match(O_MATCH,stab_to_arg(A_STAB,defstab),spat);
1024 }
1025 arg->arg_type = O_SPLIT;
1026 arg[2].arg_ptr.arg_spat->spat_repl = stab_to_arg(A_STAB,aadd(stab));
1027 return arg;
1028}
1029
1030char *
1031expand_charset(s)
1032register char *s;
1033{
1034 char t[512];
1035 register char *d = t;
1036 register int i;
1037
1038 while (*s) {
1039 if (s[1] == '-' && s[2]) {
1040 for (i = s[0]; i <= s[2]; i++)
1041 *d++ = i;
1042 s += 3;
1043 }
1044 else
1045 *d++ = *s++;
1046 }
1047 *d = '\0';
1048 return savestr(t);
1049}
1050
1051char *
1052scantrans(s)
1053register char *s;
1054{
1055 ARG *arg =
1056 l(make_op(O_TRANS,2,stab_to_arg(A_STAB,defstab),Nullarg,Nullarg,0));
1057 register char *t;
1058 register char *r;
1059 register char *tbl = safemalloc(256);
1060 register int i;
1061
1062 arg[2].arg_type = A_NULL;
1063 arg[2].arg_ptr.arg_cval = tbl;
1064 for (i=0; i<256; i++)
1065 tbl[i] = 0;
1066 s = scanstr(s);
1067 if (!*s)
1068 fatal("Translation pattern not terminated:\n%s",str_get(linestr));
1069 t = expand_charset(str_get(yylval.arg[1].arg_ptr.arg_str));
1070 free_arg(yylval.arg);
1071 s = scanstr(s-1);
1072 if (!*s)
1073 fatal("Translation replacement not terminated:\n%s",str_get(linestr));
1074 r = expand_charset(str_get(yylval.arg[1].arg_ptr.arg_str));
1075 free_arg(yylval.arg);
1076 yylval.arg = arg;
1077 if (!*r) {
1078 safefree(r);
1079 r = t;
1080 }
1081 for (i = 0; t[i]; i++) {
1082 if (!r[i])
1083 r[i] = r[i-1];
1084 tbl[t[i] & 0377] = r[i];
1085 }
1086 if (r != t)
1087 safefree(r);
1088 safefree(t);
1089 return s;
1090}
1091
1092CMD *
1093block_head(tail)
1094register CMD *tail;
1095{
1096 if (tail == Nullcmd) {
1097 return tail;
1098 }
1099 return tail->c_head;
1100}
1101
1102CMD *
1103append_line(head,tail)
1104register CMD *head;
1105register CMD *tail;
1106{
1107 if (tail == Nullcmd)
1108 return head;
1109 if (!tail->c_head) /* make sure tail is well formed */
1110 tail->c_head = tail;
1111 if (head != Nullcmd) {
1112 tail = tail->c_head; /* get to start of tail list */
1113 if (!head->c_head)
1114 head->c_head = head; /* start a new head list */
1115 while (head->c_next) {
1116 head->c_next->c_head = head->c_head;
1117 head = head->c_next; /* get to end of head list */
1118 }
1119 head->c_next = tail; /* link to end of old list */
1120 tail->c_head = head->c_head; /* propagate head pointer */
1121 }
1122 while (tail->c_next) {
1123 tail->c_next->c_head = tail->c_head;
1124 tail = tail->c_next;
1125 }
1126 return tail;
1127}
1128
1129CMD *
1130make_acmd(type,stab,cond,arg)
1131int type;
1132STAB *stab;
1133ARG *cond;
1134ARG *arg;
1135{
1136 register CMD *cmd = (CMD *) safemalloc(sizeof (CMD));
1137
1138 bzero((char *)cmd, sizeof(CMD));
1139 cmd->c_type = type;
1140 cmd->ucmd.acmd.ac_stab = stab;
1141 cmd->ucmd.acmd.ac_expr = arg;
1142 cmd->c_expr = cond;
1143 if (cond) {
1144 opt_arg(cmd,1);
1145 cmd->c_flags |= CF_COND;
1146 }
1147 return cmd;
1148}
1149
1150CMD *
1151make_ccmd(type,arg,cblock)
1152int type;
1153register ARG *arg;
1154struct compcmd cblock;
1155{
1156 register CMD *cmd = (CMD *) safemalloc(sizeof (CMD));
1157
1158 bzero((char *)cmd, sizeof(CMD));
1159 cmd->c_type = type;
1160 cmd->c_expr = arg;
1161 cmd->ucmd.ccmd.cc_true = cblock.comp_true;
1162 cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
1163 if (arg) {
1164 opt_arg(cmd,1);
1165 cmd->c_flags |= CF_COND;
1166 }
1167 return cmd;
1168}
1169
1170void
1171opt_arg(cmd,fliporflop)
1172register CMD *cmd;
1173int fliporflop;
1174{
1175 register ARG *arg;
1176 int opt = CFT_EVAL;
1177 int sure = 0;
1178 ARG *arg2;
1179 char *tmps; /* for True macro */
1180 int context = 0; /* 0 = normal, 1 = before &&, 2 = before || */
1181 int flp = fliporflop;
1182
1183 if (!cmd)
1184 return;
1185 arg = cmd->c_expr;
1186
1187 /* Turn "if (!expr)" into "unless (expr)" */
1188
1189 while (arg->arg_type == O_NOT && arg[1].arg_type == A_EXPR) {
1190 cmd->c_flags ^= CF_INVERT; /* flip sense of cmd */
1191 cmd->c_expr = arg[1].arg_ptr.arg_arg; /* hoist the rest of expr */
1192 free_arg(arg);
1193 arg = cmd->c_expr; /* here we go again */
1194 }
1195
1196 if (!arg->arg_len) { /* sanity check */
1197 cmd->c_flags |= opt;
1198 return;
1199 }
1200
1201 /* for "cond .. cond" we set up for the initial check */
1202
1203 if (arg->arg_type == O_FLIP)
1204 context |= 4;
1205
1206 /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
1207
1208 if (arg->arg_type == O_AND)
1209 context |= 1;
1210 else if (arg->arg_type == O_OR)
1211 context |= 2;
1212 if (context && arg[flp].arg_type == A_EXPR) {
1213 arg = arg[flp].arg_ptr.arg_arg;
1214 flp = 1;
1215 }
1216
1217 if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
1218 cmd->c_flags |= opt;
1219 return; /* side effect, can't optimize */
1220 }
1221
1222 if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
1223 arg->arg_type == O_AND || arg->arg_type == O_OR) {
1224 if (arg[flp].arg_type == A_SINGLE) {
1225 opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
1226 cmd->c_first = arg[flp].arg_ptr.arg_str;
1227 goto literal;
1228 }
1229 else if (arg[flp].arg_type == A_STAB || arg[flp].arg_type == A_LVAL) {
1230 cmd->c_stab = arg[flp].arg_ptr.arg_stab;
1231 opt = CFT_REG;
1232 literal:
1233 if (!context) { /* no && or ||? */
1234 free_arg(arg);
1235 cmd->c_expr = Nullarg;
1236 }
1237 if (!(context & 1))
1238 cmd->c_flags |= CF_EQSURE;
1239 if (!(context & 2))
1240 cmd->c_flags |= CF_NESURE;
1241 }
1242 }
1243 else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
1244 arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
1245 if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
1246 arg[2].arg_type == A_SPAT &&
1247 arg[2].arg_ptr.arg_spat->spat_first ) {
1248 cmd->c_stab = arg[1].arg_ptr.arg_stab;
1249 cmd->c_first = arg[2].arg_ptr.arg_spat->spat_first;
1250 cmd->c_flen = arg[2].arg_ptr.arg_spat->spat_flen;
1251 if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANALL &&
1252 (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
1253 sure |= CF_EQSURE; /* (SUBST must be forced even */
1254 /* if we know it will work.) */
1255 arg[2].arg_ptr.arg_spat->spat_first = Nullstr;
1256 arg[2].arg_ptr.arg_spat->spat_flen = 0; /* only one chk */
1257 sure |= CF_NESURE; /* normally only sure if it fails */
1258 if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
1259 cmd->c_flags |= CF_FIRSTNEG;
1260 if (context & 1) { /* only sure if thing is false */
1261 if (cmd->c_flags & CF_FIRSTNEG)
1262 sure &= ~CF_NESURE;
1263 else
1264 sure &= ~CF_EQSURE;
1265 }
1266 else if (context & 2) { /* only sure if thing is true */
1267 if (cmd->c_flags & CF_FIRSTNEG)
1268 sure &= ~CF_EQSURE;
1269 else
1270 sure &= ~CF_NESURE;
1271 }
1272 if (sure & (CF_EQSURE|CF_NESURE)) { /* if we know anything*/
1273 if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
1274 opt = CFT_SCAN;
1275 else
1276 opt = CFT_ANCHOR;
1277 if (sure == (CF_EQSURE|CF_NESURE) /* really sure? */
1278 && arg->arg_type == O_MATCH
1279 && context & 4
1280 && fliporflop == 1) {
1281 arg[2].arg_type = A_SINGLE; /* don't do twice */
1282 arg[2].arg_ptr.arg_str = &str_yes;
1283 }
1284 cmd->c_flags |= sure;
1285 }
1286 }
1287 }
1288 else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
1289 arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
1290 if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
1291 if (arg[2].arg_type == A_SINGLE) {
1292 cmd->c_stab = arg[1].arg_ptr.arg_stab;
1293 cmd->c_first = arg[2].arg_ptr.arg_str;
1294 cmd->c_flen = 30000;
1295 switch (arg->arg_type) {
1296 case O_SLT: case O_SGT:
1297 sure |= CF_EQSURE;
1298 cmd->c_flags |= CF_FIRSTNEG;
1299 break;
1300 case O_SNE:
1301 cmd->c_flags |= CF_FIRSTNEG;
1302 /* FALL THROUGH */
1303 case O_SEQ:
1304 sure |= CF_NESURE|CF_EQSURE;
1305 break;
1306 }
1307 if (context & 1) { /* only sure if thing is false */
1308 if (cmd->c_flags & CF_FIRSTNEG)
1309 sure &= ~CF_NESURE;
1310 else
1311 sure &= ~CF_EQSURE;
1312 }
1313 else if (context & 2) { /* only sure if thing is true */
1314 if (cmd->c_flags & CF_FIRSTNEG)
1315 sure &= ~CF_EQSURE;
1316 else
1317 sure &= ~CF_NESURE;
1318 }
1319 if (sure & (CF_EQSURE|CF_NESURE)) {
1320 opt = CFT_STROP;
1321 cmd->c_flags |= sure;
1322 }
1323 }
1324 }
1325 }
1326 else if (arg->arg_type == O_ASSIGN &&
1327 (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
1328 arg[1].arg_ptr.arg_stab == defstab &&
1329 arg[2].arg_type == A_EXPR ) {
1330 arg2 = arg[2].arg_ptr.arg_arg;
1331 if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
1332 opt = CFT_GETS;
1333 cmd->c_stab = arg2[1].arg_ptr.arg_stab;
1334 if (!(arg2[1].arg_ptr.arg_stab->stab_io->flags & IOF_ARGV)) {
1335 free_arg(arg2);
1336 free_arg(arg);
1337 cmd->c_expr = Nullarg;
1338 }
1339 }
1340 }
1341 else if (arg->arg_type == O_CHOP &&
1342 (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
1343 opt = CFT_CHOP;
1344 cmd->c_stab = arg[1].arg_ptr.arg_stab;
1345 free_arg(arg);
1346 cmd->c_expr = Nullarg;
1347 }
1348 if (context & 4)
1349 opt |= CF_FLIP;
1350 cmd->c_flags |= opt;
1351
1352 if (cmd->c_flags & CF_FLIP) {
1353 if (fliporflop == 1) {
1354 arg = cmd->c_expr; /* get back to O_FLIP arg */
1355 arg[3].arg_ptr.arg_cmd = (CMD*)safemalloc(sizeof(CMD));
1356 bcopy((char *)cmd, (char *)arg[3].arg_ptr.arg_cmd, sizeof(CMD));
1357 arg[4].arg_ptr.arg_cmd = (CMD*)safemalloc(sizeof(CMD));
1358 bcopy((char *)cmd, (char *)arg[4].arg_ptr.arg_cmd, sizeof(CMD));
1359 opt_arg(arg[4].arg_ptr.arg_cmd,2);
1360 arg->arg_len = 2; /* this is a lie */
1361 }
1362 else {
1363 if ((opt & CF_OPTIMIZE) == CFT_EVAL)
1364 cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
1365 }
1366 }
1367}
1368
1369ARG *
1370mod_match(type,left,pat)
1371register ARG *left;
1372register ARG *pat;
1373{
1374
1375 register SPAT *spat;
1376 register ARG *newarg;
1377
1378 if ((pat->arg_type == O_MATCH ||
1379 pat->arg_type == O_SUBST ||
1380 pat->arg_type == O_TRANS ||
1381 pat->arg_type == O_SPLIT
1382 ) &&
1383 pat[1].arg_ptr.arg_stab == defstab ) {
1384 switch (pat->arg_type) {
1385 case O_MATCH:
1386 newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH,
1387 pat->arg_len,
1388 left,Nullarg,Nullarg,0);
1389 break;
1390 case O_SUBST:
1391 newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST,
1392 pat->arg_len,
1393 left,Nullarg,Nullarg,0));
1394 break;
1395 case O_TRANS:
1396 newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS,
1397 pat->arg_len,
1398 left,Nullarg,Nullarg,0));
1399 break;
1400 case O_SPLIT:
1401 newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT,
1402 pat->arg_len,
1403 left,Nullarg,Nullarg,0);
1404 break;
1405 }
1406 if (pat->arg_len >= 2) {
1407 newarg[2].arg_type = pat[2].arg_type;
1408 newarg[2].arg_ptr = pat[2].arg_ptr;
1409 newarg[2].arg_flags = pat[2].arg_flags;
1410 if (pat->arg_len >= 3) {
1411 newarg[3].arg_type = pat[3].arg_type;
1412 newarg[3].arg_ptr = pat[3].arg_ptr;
1413 newarg[3].arg_flags = pat[3].arg_flags;
1414 }
1415 }
1416 safefree((char*)pat);
1417 }
1418 else {
1419 spat = (SPAT *) safemalloc(sizeof (SPAT));
1420 bzero((char *)spat, sizeof(SPAT));
1421 spat->spat_next = spat_root; /* link into spat list */
1422 spat_root = spat;
1423 init_compex(&spat->spat_compex);
1424
1425 spat->spat_runtime = pat;
1426 newarg = make_op(type,2,left,Nullarg,Nullarg,0);
1427 newarg[2].arg_type = A_SPAT;
1428 newarg[2].arg_ptr.arg_spat = spat;
1429 newarg[2].arg_flags = AF_SPECIAL;
1430 }
1431
1432 return newarg;
1433}
1434
1435CMD *
1436add_label(lbl,cmd)
1437char *lbl;
1438register CMD *cmd;
1439{
1440 if (cmd)
1441 cmd->c_label = lbl;
1442 return cmd;
1443}
1444
1445CMD *
1446addcond(cmd, arg)
1447register CMD *cmd;
1448register ARG *arg;
1449{
1450 cmd->c_expr = arg;
1451 opt_arg(cmd,1);
1452 cmd->c_flags |= CF_COND;
1453 return cmd;
1454}
1455
1456CMD *
1457addloop(cmd, arg)
1458register CMD *cmd;
1459register ARG *arg;
1460{
1461 cmd->c_expr = arg;
1462 opt_arg(cmd,1);
1463 cmd->c_flags |= CF_COND|CF_LOOP;
1464 if (cmd->c_type == C_BLOCK)
1465 cmd->c_flags &= ~CF_COND;
1466 else {
1467 arg = cmd->ucmd.acmd.ac_expr;
1468 if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
1469 cmd->c_flags &= ~CF_COND; /* "do {} while" happens at least once */
1470 if (arg && arg->arg_type == O_SUBR)
1471 cmd->c_flags &= ~CF_COND; /* likewise for "do subr() while" */
1472 }
1473 return cmd;
1474}
1475
1476CMD *
1477invert(cmd)
1478register CMD *cmd;
1479{
1480 cmd->c_flags ^= CF_INVERT;
1481 return cmd;
1482}
1483
1484yyerror(s)
1485char *s;
1486{
1487 char tmpbuf[128];
1488 char *tname = tmpbuf;
1489
1490 if (yychar > 256) {
1491 tname = tokename[yychar-256];
1492 if (strEQ(tname,"word"))
1493 strcpy(tname,tokenbuf);
1494 else if (strEQ(tname,"register"))
1495 sprintf(tname,"$%s",tokenbuf);
1496 else if (strEQ(tname,"array_length"))
1497 sprintf(tname,"$#%s",tokenbuf);
1498 }
1499 else if (!yychar)
1500 strcpy(tname,"EOF");
1501 else if (yychar < 32)
1502 sprintf(tname,"^%c",yychar+64);
1503 else if (yychar == 127)
1504 strcpy(tname,"^?");
1505 else
1506 sprintf(tname,"%c",yychar);
a559c259 1507 sprintf(tokenbuf, "%s in file %s at line %d, next token \"%s\"\n",
8d063cd8 1508 s,filename,line,tname);
a559c259
LW		 1509 if (in_eval)
1510 str_set(stabent("@",TRUE)->stab_val,tokenbuf);
1511 else
1512 fputs(tokenbuf,stderr);
8d063cd8
LW		 1513}
1514
1515char *
1516scanstr(s)
1517register char *s;
1518{
1519 register char term;
1520 register char *d;
1521 register ARG *arg;
1522 register bool makesingle = FALSE;
1523 char *leave = "\\$nrtfb0123456789"; /* which backslash sequences to keep */
1524
1525 arg = op_new(1);
1526 yylval.arg = arg;
1527 arg->arg_type = O_ITEM;
1528
1529 switch (*s) {
1530 default: /* a substitution replacement */
1531 arg[1].arg_type = A_DOUBLE;
1532 makesingle = TRUE; /* maybe disable runtime scanning */
1533 term = *s;
1534 if (term == '\'')
1535 leave = Nullch;
1536 goto snarf_it;
1537 case '0':
1538 {
1539 long i;
1540 int shift;
1541
1542 arg[1].arg_type = A_SINGLE;
1543 if (s[1] == 'x') {
1544 shift = 4;
1545 s += 2;
1546 }
1547 else if (s[1] == '.')
1548 goto decimal;
1549 else
1550 shift = 3;
1551 i = 0;
1552 for (;;) {
1553 switch (*s) {
1554 default:
1555 goto out;
1556 case '8': case '9':
1557 if (shift != 4)
1558 fatal("Illegal octal digit at line %d",line);
1559 /* FALL THROUGH */
1560 case '0': case '1': case '2': case '3': case '4':
1561 case '5': case '6': case '7':
1562 i <<= shift;
1563 i += *s++ & 15;
1564 break;
1565 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1566 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
1567 if (shift != 4)
1568 goto out;
1569 i <<= 4;
1570 i += (*s++ & 7) + 9;
1571 break;
1572 }
1573 }
1574 out:
1575 sprintf(tokenbuf,"%d",i);
1576 arg[1].arg_ptr.arg_str = str_make(tokenbuf);
1577 }
1578 break;
1579 case '1': case '2': case '3': case '4': case '5':
1580 case '6': case '7': case '8': case '9': case '.':
1581 decimal:
1582 arg[1].arg_type = A_SINGLE;
1583 d = tokenbuf;
1584 while (isdigit(*s) || *s == '_')
1585 *d++ = *s++;
1586 if (*s == '.' && index("0123456789eE",s[1]))
1587 *d++ = *s++;
1588 while (isdigit(*s) || *s == '_')
1589 *d++ = *s++;
1590 if (index("eE",*s) && index("+-0123456789",s[1]))
1591 *d++ = *s++;
1592 if (*s == '+' || *s == '-')
1593 *d++ = *s++;
1594 while (isdigit(*s))
1595 *d++ = *s++;
1596 *d = '\0';
1597 arg[1].arg_ptr.arg_str = str_make(tokenbuf);
1598 break;
1599 case '\'':
1600 arg[1].arg_type = A_SINGLE;
1601 term = *s;
1602 leave = Nullch;
1603 goto snarf_it;
1604
1605 case '<':
1606 arg[1].arg_type = A_READ;
1607 s = cpytill(tokenbuf,s+1,'>');
1608 if (!*tokenbuf)
1609 strcpy(tokenbuf,"ARGV");
1610 if (*s)
1611 s++;
1612 if (rsfp == stdin && strEQ(tokenbuf,"stdin"))
1613 fatal("Can't get both program and data from <stdin>\n");
1614 arg[1].arg_ptr.arg_stab = stabent(tokenbuf,TRUE);
1615 arg[1].arg_ptr.arg_stab->stab_io = stio_new();
1616 if (strEQ(tokenbuf,"ARGV")) {
1617 aadd(arg[1].arg_ptr.arg_stab);
1618 arg[1].arg_ptr.arg_stab->stab_io->flags |= IOF_ARGV|IOF_START;
1619 }
1620 break;
1621 case '"':
1622 arg[1].arg_type = A_DOUBLE;
1623 makesingle = TRUE; /* maybe disable runtime scanning */
1624 term = *s;
1625 goto snarf_it;
1626 case '`':
1627 arg[1].arg_type = A_BACKTICK;
1628 term = *s;
1629 snarf_it:
1630 {
1631 STR *tmpstr;
1632 int sqstart = line;
1633 char *tmps;
1634
1635 tmpstr = str_new(strlen(s));
1636 s = str_append_till(tmpstr,s+1,term,leave);
1637 while (!*s) { /* multiple line string? */
1638 s = str_gets(linestr, rsfp);
1639 if (!*s)
1640 fatal("EOF in string at line %d\n",sqstart);
1641 line++;
1642 s = str_append_till(tmpstr,s,term,leave);
1643 }
1644 s++;
1645 if (term == '\'') {
1646 arg[1].arg_ptr.arg_str = tmpstr;
1647 break;
1648 }
1649 tmps = s;
1650 s = d = tmpstr->str_ptr; /* assuming shrinkage only */
1651 while (*s) {
1652 if (*s == '$' && s[1]) {
1653 makesingle = FALSE; /* force interpretation */
1654 if (!isalpha(s[1])) { /* an internal register? */
1655 int len;
1656
1657 len = scanreg(s,tokenbuf) - s;
1658 stabent(tokenbuf,TRUE); /* make sure it's created */
1659 while (len--)
1660 *d++ = *s++;
1661 continue;
1662 }
1663 }
1664 else if (*s == '\\' && s[1]) {
1665 s++;
1666 switch (*s) {
1667 default:
1668 defchar:
1669 if (!leave || index(leave,*s))
1670 *d++ = '\\';
1671 *d++ = *s++;
1672 continue;
1673 case '0': case '1': case '2': case '3':
1674 case '4': case '5': case '6': case '7':
1675 *d = *s++ - '0';
1676 if (index("01234567",*s)) {
1677 *d <<= 3;
1678 *d += *s++ - '0';
1679 }
135863df 1680 else if (!index("`\"",term)) { /* oops, a subpattern */
8d063cd8
LW		 1681 s--;
1682 goto defchar;
1683 }
1684 if (index("01234567",*s)) {
1685 *d <<= 3;
1686 *d += *s++ - '0';
1687 }
1688 d++;
1689 continue;
1690 case 'b':
1691 *d++ = '\b';
1692 break;
1693 case 'n':
1694 *d++ = '\n';
1695 break;
1696 case 'r':
1697 *d++ = '\r';
1698 break;
1699 case 'f':
1700 *d++ = '\f';
1701 break;
1702 case 't':
1703 *d++ = '\t';
1704 break;
1705 }
1706 s++;
1707 continue;
1708 }
1709 *d++ = *s++;
1710 }
1711 *d = '\0';
1712 if (arg[1].arg_type == A_DOUBLE) {
1713 if (makesingle)
1714 arg[1].arg_type = A_SINGLE; /* now we can optimize on it */
1715 else
1716 leave = "\\";
1717 for (d = s = tmpstr->str_ptr; *s; *d++ = *s++) {
1718 if (*s == '\\' && (!leave || index(leave,s[1])))
1719 s++;
1720 }
1721 *d = '\0';
1722 }
1723 tmpstr->str_cur = d - tmpstr->str_ptr; /* XXX cheat */
1724 arg[1].arg_ptr.arg_str = tmpstr;
1725 s = tmps;
1726 break;
1727 }
1728 }
1729 return s;
1730}
1731
1732ARG *
1733make_op(type,newlen,arg1,arg2,arg3,dolist)
1734int type;
1735int newlen;
1736ARG *arg1;
1737ARG *arg2;
1738ARG *arg3;
1739int dolist;
1740{
1741 register ARG *arg;
1742 register ARG *chld;
1743 register int doarg;
1744
1745 arg = op_new(newlen);
1746 arg->arg_type = type;
1747 doarg = opargs[type];
1748 if (chld = arg1) {
1749 if (!(doarg & 1))
1750 arg[1].arg_flags |= AF_SPECIAL;
1751 if (doarg & 16)
1752 arg[1].arg_flags |= AF_NUMERIC;
1753 if (chld->arg_type == O_ITEM &&
1754 (hoistable[chld[1].arg_type] || chld[1].arg_type == A_LVAL) ) {
1755 arg[1].arg_type = chld[1].arg_type;
1756 arg[1].arg_ptr = chld[1].arg_ptr;
1757 arg[1].arg_flags |= chld[1].arg_flags;
1758 free_arg(chld);
1759 }
1760 else {
1761 arg[1].arg_type = A_EXPR;
1762 arg[1].arg_ptr.arg_arg = chld;
1763 if (dolist & 1) {
1764 if (chld->arg_type == O_LIST) {
1765 if (newlen == 1) { /* we can hoist entire list */
1766 chld->arg_type = type;
1767 free_arg(arg);
1768 arg = chld;
1769 }
1770 else {
1771 arg[1].arg_flags |= AF_SPECIAL;
1772 }
1773 }
1774 else if (chld->arg_type == O_ARRAY && chld->arg_len == 1)
1775 arg[1].arg_flags |= AF_SPECIAL;
1776 }
1777 }
1778 }
1779 if (chld = arg2) {
1780 if (!(doarg & 2))
1781 arg[2].arg_flags |= AF_SPECIAL;
1782 if (doarg & 32)
1783 arg[2].arg_flags |= AF_NUMERIC;
1784 if (chld->arg_type == O_ITEM &&
1785 (hoistable[chld[1].arg_type] ||
1786 (type == O_ASSIGN &&
1787 (chld[1].arg_type == A_READ ||
1788 chld[1].arg_type == A_DOUBLE ||
1789 chld[1].arg_type == A_BACKTICK ) ) ) ) {
1790 arg[2].arg_type = chld[1].arg_type;
1791 arg[2].arg_ptr = chld[1].arg_ptr;
1792 free_arg(chld);
1793 }
1794 else {
1795 arg[2].arg_type = A_EXPR;
1796 arg[2].arg_ptr.arg_arg = chld;
1797 if ((dolist & 2) &&
1798 (chld->arg_type == O_LIST ||
1799 (chld->arg_type == O_ARRAY && chld->arg_len == 1) ))
1800 arg[2].arg_flags |= AF_SPECIAL;
1801 }
1802 }
1803 if (chld = arg3) {
1804 if (!(doarg & 4))
1805 arg[3].arg_flags |= AF_SPECIAL;
1806 if (doarg & 64)
1807 arg[3].arg_flags |= AF_NUMERIC;
1808 if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
1809 arg[3].arg_type = chld[1].arg_type;
1810 arg[3].arg_ptr = chld[1].arg_ptr;
1811 free_arg(chld);
1812 }
1813 else {
1814 arg[3].arg_type = A_EXPR;
1815 arg[3].arg_ptr.arg_arg = chld;
1816 if ((dolist & 4) &&
1817 (chld->arg_type == O_LIST ||
1818 (chld->arg_type == O_ARRAY && chld->arg_len == 1) ))
1819 arg[3].arg_flags |= AF_SPECIAL;
1820 }
1821 }
1822#ifdef DEBUGGING
1823 if (debug & 16) {
1824 fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
1825 if (arg1)
1826 fprintf(stderr,",%s=%lx",
1827 argname[arg[1].arg_type],arg[1].arg_ptr.arg_arg);
1828 if (arg2)
1829 fprintf(stderr,",%s=%lx",
1830 argname[arg[2].arg_type],arg[2].arg_ptr.arg_arg);
1831 if (arg3)
1832 fprintf(stderr,",%s=%lx",
1833 argname[arg[3].arg_type],arg[3].arg_ptr.arg_arg);
1834 fprintf(stderr,")\n");
1835 }
1836#endif
1837 evalstatic(arg); /* see if we can consolidate anything */
1838 return arg;
1839}
1840
1841/* turn 123 into 123 == $. */
1842
1843ARG *
1844flipflip(arg)
1845register ARG *arg;
1846{
1847 if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_SINGLE) {
1848 arg = (ARG*)saferealloc((char*)arg,3*sizeof(ARG));
1849 arg->arg_type = O_EQ;
1850 arg->arg_len = 2;
1851 arg[2].arg_type = A_STAB;
1852 arg[2].arg_flags = 0;
1853 arg[2].arg_ptr.arg_stab = stabent(".",TRUE);
1854 }
1855 return arg;
1856}
1857
1858void
1859evalstatic(arg)
1860register ARG *arg;
1861{
1862 register STR *str;
1863 register STR *s1;
1864 register STR *s2;
1865 double value; /* must not be register */
1866 register char *tmps;
1867 int i;
1868 double exp(), log(), sqrt(), modf();
1869 char *crypt();
1870
1871 if (!arg || !arg->arg_len)
1872 return;
1873
1874 if (arg[1].arg_type == A_SINGLE &&
1875 (arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) {
1876 str = str_new(0);
1877 s1 = arg[1].arg_ptr.arg_str;
1878 if (arg->arg_len > 1)
1879 s2 = arg[2].arg_ptr.arg_str;
1880 else
1881 s2 = Nullstr;
1882 switch (arg->arg_type) {
1883 default:
1884 str_free(str);
1885 str = Nullstr; /* can't be evaluated yet */
1886 break;
1887 case O_CONCAT:
1888 str_sset(str,s1);
1889 str_scat(str,s2);
1890 break;
1891 case O_REPEAT:
1892 i = (int)str_gnum(s2);
1893 while (i--)
1894 str_scat(str,s1);
1895 break;
1896 case O_MULTIPLY:
1897 value = str_gnum(s1);
1898 str_numset(str,value * str_gnum(s2));
1899 break;
1900 case O_DIVIDE:
1901 value = str_gnum(s1);
1902 str_numset(str,value / str_gnum(s2));
1903 break;
1904 case O_MODULO:
1905 value = str_gnum(s1);
1906 str_numset(str,(double)(((long)value) % ((long)str_gnum(s2))));
1907 break;
1908 case O_ADD:
1909 value = str_gnum(s1);
1910 str_numset(str,value + str_gnum(s2));
1911 break;
1912 case O_SUBTRACT:
1913 value = str_gnum(s1);
1914 str_numset(str,value - str_gnum(s2));
1915 break;
1916 case O_LEFT_SHIFT:
1917 value = str_gnum(s1);
1918 str_numset(str,(double)(((long)value) << ((long)str_gnum(s2))));
1919 break;
1920 case O_RIGHT_SHIFT:
1921 value = str_gnum(s1);
1922 str_numset(str,(double)(((long)value) >> ((long)str_gnum(s2))));
1923 break;
1924 case O_LT:
1925 value = str_gnum(s1);
1926 str_numset(str,(double)(value < str_gnum(s2)));
1927 break;
1928 case O_GT:
1929 value = str_gnum(s1);
1930 str_numset(str,(double)(value > str_gnum(s2)));
1931 break;
1932 case O_LE:
1933 value = str_gnum(s1);
1934 str_numset(str,(double)(value <= str_gnum(s2)));
1935 break;
1936 case O_GE:
1937 value = str_gnum(s1);
1938 str_numset(str,(double)(value >= str_gnum(s2)));
1939 break;
1940 case O_EQ:
1941 value = str_gnum(s1);
1942 str_numset(str,(double)(value == str_gnum(s2)));
1943 break;
1944 case O_NE:
1945 value = str_gnum(s1);
1946 str_numset(str,(double)(value != str_gnum(s2)));
1947 break;
1948 case O_BIT_AND:
1949 value = str_gnum(s1);
1950 str_numset(str,(double)(((long)value) & ((long)str_gnum(s2))));
1951 break;
1952 case O_XOR:
1953 value = str_gnum(s1);
1954 str_numset(str,(double)(((long)value) ^ ((long)str_gnum(s2))));
1955 break;
1956 case O_BIT_OR:
1957 value = str_gnum(s1);
1958 str_numset(str,(double)(((long)value) | ((long)str_gnum(s2))));
1959 break;
1960 case O_AND:
1961 if (str_true(s1))
1962 str = str_make(str_get(s2));
1963 else
1964 str = str_make(str_get(s1));
1965 break;
1966 case O_OR:
1967 if (str_true(s1))
1968 str = str_make(str_get(s1));
1969 else
1970 str = str_make(str_get(s2));
1971 break;
1972 case O_COND_EXPR:
1973 if (arg[3].arg_type != A_SINGLE) {
1974 str_free(str);
1975 str = Nullstr;
1976 }
1977 else {
1978 str = str_make(str_get(str_true(s1) ? s2 : arg[3].arg_ptr.arg_str));
1979 str_free(arg[3].arg_ptr.arg_str);
1980 }
1981 break;
1982 case O_NEGATE:
1983 str_numset(str,(double)(-str_gnum(s1)));
1984 break;
1985 case O_NOT:
1986 str_numset(str,(double)(!str_true(s1)));
1987 break;
1988 case O_COMPLEMENT:
1989 str_numset(str,(double)(~(long)str_gnum(s1)));
1990 break;
1991 case O_LENGTH:
1992 str_numset(str, (double)str_len(s1));
1993 break;
1994 case O_SUBSTR:
a559c259 1995 if (arg[3].arg_type != A_SINGLE || stabent("[",allstabs)) {
8d063cd8
LW		 1996 str_free(str); /* making the fallacious assumption */
1997 str = Nullstr; /* that any $[ occurs before substr()*/
1998 }
1999 else {
2000 char *beg;
2001 int len = (int)str_gnum(s2);
2002 int tmp;
2003
2004 for (beg = str_get(s1); *beg && len > 0; beg++,len--) ;
2005 len = (int)str_gnum(arg[3].arg_ptr.arg_str);
2006 str_free(arg[3].arg_ptr.arg_str);
2007 if (len > (tmp = strlen(beg)))
2008 len = tmp;
2009 str_nset(str,beg,len);
2010 }
2011 break;
2012 case O_SLT:
2013 tmps = str_get(s1);
2014 str_numset(str,(double)(strLT(tmps,str_get(s2))));
2015 break;
2016 case O_SGT:
2017 tmps = str_get(s1);
2018 str_numset(str,(double)(strGT(tmps,str_get(s2))));
2019 break;
2020 case O_SLE:
2021 tmps = str_get(s1);
2022 str_numset(str,(double)(strLE(tmps,str_get(s2))));
2023 break;
2024 case O_SGE:
2025 tmps = str_get(s1);
2026 str_numset(str,(double)(strGE(tmps,str_get(s2))));
2027 break;
2028 case O_SEQ:
2029 tmps = str_get(s1);
2030 str_numset(str,(double)(strEQ(tmps,str_get(s2))));
2031 break;
2032 case O_SNE:
2033 tmps = str_get(s1);
2034 str_numset(str,(double)(strNE(tmps,str_get(s2))));
2035 break;
2036 case O_CRYPT:
2037 tmps = str_get(s1);
2038 str_set(str,crypt(tmps,str_get(s2)));
2039 break;
2040 case O_EXP:
2041 str_numset(str,exp(str_gnum(s1)));
2042 break;
2043 case O_LOG:
2044 str_numset(str,log(str_gnum(s1)));
2045 break;
2046 case O_SQRT:
2047 str_numset(str,sqrt(str_gnum(s1)));
2048 break;
2049 case O_INT:
2050 modf(str_gnum(s1),&value);
2051 str_numset(str,value);
2052 break;
2053 case O_ORD:
2054 str_numset(str,(double)(*str_get(s1)));
2055 break;
2056 }
2057 if (str) {
2058 arg->arg_type = O_ITEM; /* note arg1 type is already SINGLE */
2059 str_free(s1);
2060 str_free(s2);
2061 arg[1].arg_ptr.arg_str = str;
2062 }
2063 }
2064}
2065
2066ARG *
2067l(arg)
2068register ARG *arg;
2069{
2070 register int i;
2071 register ARG *arg1;
2072
2073 arg->arg_flags |= AF_COMMON; /* XXX should cross-match */
2074
2075 /* see if it's an array reference */
2076
2077 if (arg[1].arg_type == A_EXPR) {
2078 arg1 = arg[1].arg_ptr.arg_arg;
2079
2080 if (arg1->arg_type == O_LIST && arg->arg_type != O_ITEM) {
2081 /* assign to list */
2082 arg[1].arg_flags |= AF_SPECIAL;
2083 arg[2].arg_flags |= AF_SPECIAL;
2084 for (i = arg1->arg_len; i >= 1; i--) {
2085 switch (arg1[i].arg_type) {
2086 case A_STAB: case A_LVAL:
2087 arg1[i].arg_type = A_LVAL;
2088 break;
2089 case A_EXPR: case A_LEXPR:
2090 arg1[i].arg_type = A_LEXPR;
2091 if (arg1[i].arg_ptr.arg_arg->arg_type == O_ARRAY)
2092 arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY;
2093 else if (arg1[i].arg_ptr.arg_arg->arg_type == O_HASH)
2094 arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH;
2095 if (arg1[i].arg_ptr.arg_arg->arg_type == O_LARRAY)
2096 break;
2097 if (arg1[i].arg_ptr.arg_arg->arg_type == O_LHASH)
2098 break;
2099 /* FALL THROUGH */
2100 default:
2101 sprintf(tokenbuf,
2102 "Illegal item (%s) as lvalue",argname[arg1[i].arg_type]);
2103 yyerror(tokenbuf);
2104 }
2105 }
2106 }
2107 else if (arg1->arg_type == O_ARRAY) {
2108 if (arg1->arg_len == 1 && arg->arg_type != O_ITEM) {
2109 /* assign to array */
2110 arg[1].arg_flags |= AF_SPECIAL;
2111 arg[2].arg_flags |= AF_SPECIAL;
2112 }
2113 else
2114 arg1->arg_type = O_LARRAY; /* assign to array elem */
2115 }
2116 else if (arg1->arg_type == O_HASH)
2117 arg1->arg_type = O_LHASH;
2118 else {
2119 sprintf(tokenbuf,
2120 "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
2121 yyerror(tokenbuf);
2122 }
2123 arg[1].arg_type = A_LEXPR;
2124#ifdef DEBUGGING
2125 if (debug & 16)
2126 fprintf(stderr,"lval LEXPR\n");
2127#endif
2128 return arg;
2129 }
2130
2131 /* not an array reference, should be a register name */
2132
2133 if (arg[1].arg_type != A_STAB && arg[1].arg_type != A_LVAL) {
2134 sprintf(tokenbuf,
2135 "Illegal item (%s) as lvalue",argname[arg[1].arg_type]);
2136 yyerror(tokenbuf);
2137 }
2138 arg[1].arg_type = A_LVAL;
2139#ifdef DEBUGGING
2140 if (debug & 16)
2141 fprintf(stderr,"lval LVAL\n");
2142#endif
2143 return arg;
2144}
2145
2146ARG *
2147addflags(i,flags,arg)
2148register ARG *arg;
2149{
2150 arg[i].arg_flags |= flags;
2151 return arg;
2152}
2153
2154ARG *
2155hide_ary(arg)
2156ARG *arg;
2157{
2158 if (arg->arg_type == O_ARRAY)
2159 return make_op(O_ITEM,1,arg,Nullarg,Nullarg,0);
2160 return arg;
2161}
2162
2163ARG *
2164make_list(arg)
2165register ARG *arg;
2166{
2167 register int i;
2168 register ARG *node;
2169 register ARG *nxtnode;
2170 register int j;
2171 STR *tmpstr;
2172
2173 if (!arg) {
2174 arg = op_new(0);
2175 arg->arg_type = O_LIST;
2176 }
2177 if (arg->arg_type != O_COMMA) {
2178 arg->arg_flags |= AF_LISTISH; /* see listish() below */
2179 return arg;
2180 }
2181 for (i = 2, node = arg; ; i++) {
2182 if (node->arg_len < 2)
2183 break;
2184 if (node[2].arg_type != A_EXPR)
2185 break;
2186 node = node[2].arg_ptr.arg_arg;
2187 if (node->arg_type != O_COMMA)
2188 break;
2189 }
2190 if (i > 2) {
2191 node = arg;
2192 arg = op_new(i);
2193 tmpstr = arg->arg_ptr.arg_str;
2194 *arg = *node; /* copy everything except the STR */
2195 arg->arg_ptr.arg_str = tmpstr;
2196 for (j = 1; ; ) {
2197 arg[j++] = node[1];
2198 if (j >= i) {
2199 arg[j] = node[2];
2200 free_arg(node);
2201 break;
2202 }
2203 nxtnode = node[2].arg_ptr.arg_arg;
2204 free_arg(node);
2205 node = nxtnode;
2206 }
2207 }
2208 arg->arg_type = O_LIST;
2209 arg->arg_len = i;
2210 return arg;
2211}
2212
2213/* turn a single item into a list */
2214
2215ARG *
2216listish(arg)
2217ARG *arg;
2218{
2219 if (arg->arg_flags & AF_LISTISH)
2220 arg = make_op(O_LIST,1,arg,Nullarg,Nullarg,0);
2221 return arg;
2222}
2223
2224ARG *
2225stab_to_arg(atype,stab)
2226int atype;
2227register STAB *stab;
2228{
2229 register ARG *arg;
2230
2231 arg = op_new(1);
2232 arg->arg_type = O_ITEM;
2233 arg[1].arg_type = atype;
2234 arg[1].arg_ptr.arg_stab = stab;
2235 return arg;
2236}
2237
2238ARG *
2239cval_to_arg(cval)
2240register char *cval;
2241{
2242 register ARG *arg;
2243
2244 arg = op_new(1);
2245 arg->arg_type = O_ITEM;
2246 arg[1].arg_type = A_SINGLE;
2247 arg[1].arg_ptr.arg_str = str_make(cval);
2248 safefree(cval);
2249 return arg;
2250}
2251
2252ARG *
2253op_new(numargs)
2254int numargs;
2255{
2256 register ARG *arg;
2257
2258 arg = (ARG*)safemalloc((numargs + 1) * sizeof (ARG));
2259 bzero((char *)arg, (numargs + 1) * sizeof (ARG));
2260 arg->arg_ptr.arg_str = str_new(0);
2261 arg->arg_len = numargs;
2262 return arg;
2263}
2264
2265void
2266free_arg(arg)
2267ARG *arg;
2268{
2269 str_free(arg->arg_ptr.arg_str);
2270 safefree((char*)arg);
2271}
2272
2273ARG *
2274make_match(type,expr,spat)
2275int type;
2276ARG *expr;
2277SPAT *spat;
2278{
2279 register ARG *arg;
2280
2281 arg = make_op(type,2,expr,Nullarg,Nullarg,0);
2282
2283 arg[2].arg_type = A_SPAT;
2284 arg[2].arg_ptr.arg_spat = spat;
2285#ifdef DEBUGGING
2286 if (debug & 16)
2287 fprintf(stderr,"make_match SPAT=%lx\n",spat);
2288#endif
2289
2290 if (type == O_SUBST || type == O_NSUBST) {
2291 if (arg[1].arg_type != A_STAB)
2292 yyerror("Illegal lvalue");
2293 arg[1].arg_type = A_LVAL;
2294 }
2295 return arg;
2296}
2297
2298ARG *
2299cmd_to_arg(cmd)
2300CMD *cmd;
2301{
2302 register ARG *arg;
2303
2304 arg = op_new(1);
2305 arg->arg_type = O_ITEM;
2306 arg[1].arg_type = A_CMD;
2307 arg[1].arg_ptr.arg_cmd = cmd;
2308 return arg;
2309}
2310
2311CMD *
2312wopt(cmd)
2313register CMD *cmd;
2314{
2315 register CMD *tail;
2316 register ARG *arg = cmd->c_expr;
2317 char *tmps; /* used by True macro */
2318
2319 /* hoist "while (<channel>)" up into command block */
2320
2321 if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
2322 cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
2323 cmd->c_flags |= CFT_GETS; /* and set it to do the input */
2324 cmd->c_stab = arg[1].arg_ptr.arg_stab;
2325 if (arg[1].arg_ptr.arg_stab->stab_io->flags & IOF_ARGV) {
2326 cmd->c_expr = l(make_op(O_ASSIGN, 2, /* fake up "$_ =" */
2327 stab_to_arg(A_LVAL,defstab), arg, Nullarg,1 ));
2328 }
2329 else {
2330 free_arg(arg);
2331 cmd->c_expr = Nullarg;
2332 }
2333 }
2334
2335 /* First find the end of the true list */
2336
2337 if (cmd->ucmd.ccmd.cc_true == Nullcmd)
2338 return cmd;
2339 for (tail = cmd->ucmd.ccmd.cc_true; tail->c_next; tail = tail->c_next) ;
2340
2341 /* if there's a continue block, link it to true block and find end */
2342
2343 if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
2344 tail->c_next = cmd->ucmd.ccmd.cc_alt;
2345 for ( ; tail->c_next; tail = tail->c_next) ;
2346 }
2347
2348 /* Here's the real trick: link the end of the list back to the beginning,
2349 * inserting a "last" block to break out of the loop. This saves one or
2350 * two procedure calls every time through the loop, because of how cmd_exec
2351 * does tail recursion.
2352 */
2353
2354 tail->c_next = (CMD *) safemalloc(sizeof (CMD));
2355 tail = tail->c_next;
2356 if (!cmd->ucmd.ccmd.cc_alt)
2357 cmd->ucmd.ccmd.cc_alt = tail; /* every loop has a continue now */
2358
2359 bcopy((char *)cmd, (char *)tail, sizeof(CMD));
2360 tail->c_type = C_EXPR;
2361 tail->c_flags ^= CF_INVERT; /* turn into "last unless" */
2362 tail->c_next = tail->ucmd.ccmd.cc_true; /* loop directly back to top */
2363 tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg,0);
2364 tail->ucmd.acmd.ac_stab = Nullstab;
2365 return cmd;
2366}
2367
2368FCMD *
2369load_format()
2370{
2371 FCMD froot;
2372 FCMD *flinebeg;
2373 register FCMD *fprev = &froot;
2374 register FCMD *fcmd;
2375 register char *s;
2376 register char *t;
2377 register char tmpchar;
2378 bool noblank;
2379
2380 while ((s = str_gets(linestr,rsfp)) != Nullch) {
2381 line++;
2382 if (strEQ(s,".\n")) {
2383 bufptr = s;
2384 return froot.f_next;
2385 }
2386 if (*s == '#')
2387 continue;
2388 flinebeg = Nullfcmd;
2389 noblank = FALSE;
2390 while (*s) {
2391 fcmd = (FCMD *)safemalloc(sizeof (FCMD));
2392 bzero((char*)fcmd, sizeof (FCMD));
2393 fprev->f_next = fcmd;
2394 fprev = fcmd;
2395 for (t=s; *t && *t != '@' && *t != '^'; t++) {
2396 if (*t == '~') {
2397 noblank = TRUE;
2398 *t = ' ';
2399 }
2400 }
2401 tmpchar = *t;
2402 *t = '\0';
2403 fcmd->f_pre = savestr(s);
2404 fcmd->f_presize = strlen(s);
2405 *t = tmpchar;
2406 s = t;
2407 if (!*s) {
2408 if (noblank)
2409 fcmd->f_flags |= FC_NOBLANK;
2410 break;
2411 }
2412 if (!flinebeg)
2413 flinebeg = fcmd; /* start values here */
2414 if (*s++ == '^')
2415 fcmd->f_flags |= FC_CHOP; /* for doing text filling */
2416 switch (*s) {
2417 case '*':
2418 fcmd->f_type = F_LINES;
2419 *s = '\0';
2420 break;
2421 case '<':
2422 fcmd->f_type = F_LEFT;
2423 while (*s == '<')
2424 s++;
2425 break;
2426 case '>':
2427 fcmd->f_type = F_RIGHT;
2428 while (*s == '>')
2429 s++;
2430 break;
2431 case '|':
2432 fcmd->f_type = F_CENTER;
2433 while (*s == '|')
2434 s++;
2435 break;
2436 default:
2437 fcmd->f_type = F_LEFT;
2438 break;
2439 }
2440 if (fcmd->f_flags & FC_CHOP && *s == '.') {
2441 fcmd->f_flags |= FC_MORE;
2442 while (*s == '.')
2443 s++;
2444 }
2445 fcmd->f_size = s-t;
2446 }
2447 if (flinebeg) {
2448 again:
2449 if ((bufptr = str_gets(linestr ,rsfp)) == Nullch)
2450 goto badform;
2451 line++;
2452 if (strEQ(bufptr,".\n")) {
2453 yyerror("Missing values line");
2454 return froot.f_next;
2455 }
2456 if (*bufptr == '#')
2457 goto again;
2458 lex_newlines = TRUE;
2459 while (flinebeg || *bufptr) {
2460 switch(yylex()) {
2461 default:
2462 yyerror("Bad value in format");
2463 *bufptr = '\0';
2464 break;
2465 case '\n':
2466 if (flinebeg)
2467 yyerror("Missing value in format");
2468 *bufptr = '\0';
2469 break;
2470 case REG:
2471 yylval.arg = stab_to_arg(A_LVAL,yylval.stabval);
2472 /* FALL THROUGH */
2473 case RSTRING:
2474 if (!flinebeg)
2475 yyerror("Extra value in format");
2476 else {
2477 flinebeg->f_expr = yylval.arg;
2478 do {
2479 flinebeg = flinebeg->f_next;
2480 } while (flinebeg && flinebeg->f_size == 0);
2481 }
2482 break;
2483 case ',': case ';':
2484 continue;
2485 }
2486 }
2487 lex_newlines = FALSE;
2488 }
2489 }
2490 badform:
2491 bufptr = str_get(linestr);
2492 yyerror("Format not terminated");
2493 return froot.f_next;
2494}
a559c259
LW		 2495
2496STR *
2497do_eval(str)
2498STR *str;
2499{
2500 int retval;
2501 CMD *myroot;
2502
2503 in_eval++;
2504 str_set(stabent("@",TRUE)->stab_val,"");
2505 line = 1;
2506 str_sset(linestr,str);
2507 bufptr = str_get(linestr);
2508 if (setjmp(eval_env))
2509 retval = 1;
2510 else
2511 retval = yyparse();
2512 myroot = eval_root; /* in case cmd_exec does another eval! */
2513 if (retval)
2514 str = &str_no;
2515 else {
2516 str = cmd_exec(eval_root);
2517 cmd_free(myroot); /* can't free on error, for some reason */
2518 }
2519 in_eval--;
2520 return str;
2521}
2522
2523cmd_free(cmd)
2524register CMD *cmd;
2525{
2526 register CMD *tofree;
2527 register CMD *head = cmd;
2528
2529 while (cmd) {
2530 if (cmd->c_label)
2531 safefree(cmd->c_label);
2532 if (cmd->c_first)
2533 str_free(cmd->c_first);
2534 if (cmd->c_spat)
2535 spat_free(cmd->c_spat);
2536 if (cmd->c_expr)
2537 arg_free(cmd->c_expr);
2538 switch (cmd->c_type) {
2539 case C_WHILE:
2540 case C_BLOCK:
2541 case C_IF:
2542 if (cmd->ucmd.ccmd.cc_true)
2543 cmd_free(cmd->ucmd.ccmd.cc_true);
2544 if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt)
2545 cmd_free(cmd->ucmd.ccmd.cc_alt,Nullcmd);
2546 break;
2547 case C_EXPR:
2548 if (cmd->ucmd.acmd.ac_stab)
2549 arg_free(cmd->ucmd.acmd.ac_stab);
2550 if (cmd->ucmd.acmd.ac_expr)
2551 arg_free(cmd->ucmd.acmd.ac_expr);
2552 break;
2553 }
2554 tofree = cmd;
2555 cmd = cmd->c_next;
2556 safefree((char*)tofree);
2557 if (cmd && cmd == head) /* reached end of while loop */
2558 break;
2559 }
2560}
2561
2562arg_free(arg)
2563register ARG *arg;
2564{
2565 register int i;
2566
2567 for (i = 1; i <= arg->arg_len; i++) {
2568 switch (arg[i].arg_type) {
2569 case A_NULL:
2570 break;
2571 case A_LEXPR:
2572 case A_EXPR:
2573 arg_free(arg[i].arg_ptr.arg_arg);
2574 break;
2575 case A_CMD:
2576 cmd_free(arg[i].arg_ptr.arg_cmd);
2577 break;
2578 case A_STAB:
2579 case A_LVAL:
2580 case A_READ:
2581 case A_ARYLEN:
2582 break;
2583 case A_SINGLE:
2584 case A_DOUBLE:
2585 case A_BACKTICK:
2586 str_free(arg[i].arg_ptr.arg_str);
2587 break;
2588 case A_SPAT:
2589 spat_free(arg[i].arg_ptr.arg_spat);
2590 break;
2591 case A_NUMBER:
2592 break;
2593 }
2594 }
2595 free_arg(arg);
2596}
2597
2598spat_free(spat)
2599register SPAT *spat;
2600{
2601 register SPAT *sp;
2602
2603 if (spat->spat_runtime)
2604 arg_free(spat->spat_runtime);
2605 if (spat->spat_repl) {
2606 arg_free(spat->spat_repl);
2607 }
2608 free_compex(&spat->spat_compex);
2609
2610 /* now unlink from spat list */
2611 if (spat_root == spat)
2612 spat_root = spat->spat_next;
2613 else {
2614 for (sp = spat_root; sp->spat_next != spat; sp = sp->spat_next) ;
2615 sp->spat_next = spat->spat_next;
2616 }
2617
2618 safefree((char*)spat);
2619}
Unnamed repository; edit this file 'description' to name the repository.