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