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