a "replacement" for awk and sed
[perl.git] / perly.c
1 char 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
9 bool preprocess = FALSE;
10 bool assume_n = FALSE;
11 bool assume_p = FALSE;
12 bool doswitches = FALSE;
13 char *filename;
14 char *e_tmpname = "/tmp/perl-eXXXXXX";
15 FILE *e_fp = Nullfp;
16 ARG *l();
17
18 main(argc,argv,env)
19 register int argc;
20 register char **argv;
21 register 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
214 magicalize(list)
215 register 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
240 yylex()
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
750 STAB *
751 stabent(name,add)
752 register char *name;
753 int 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
776 STIO *
777 stio_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
786 char *
787 scanreg(s,dest)
788 register char *s;
789 char *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
818 STR *
819 scanconst(string)
820 char *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
873 char *
874 scanpat(s)
875 register 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
924 char *
925 scansubst(s)
926 register 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);
963 get_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
978 ARG *
979 make_split(stab,arg)
980 register STAB *stab;
981 register 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
1000 char *
1001 expand_charset(s)
1002 register 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
1021 char *
1022 scantrans(s)
1023 register 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
1062 CMD *
1063 block_head(tail)
1064 register CMD *tail;
1065 {
1066     if (tail == Nullcmd) {
1067         return tail;
1068     }
1069     return tail->c_head;
1070 }
1071
1072 CMD *
1073 append_line(head,tail)
1074 register CMD *head;
1075 register 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
1099 CMD *
1100 make_acmd(type,stab,cond,arg)
1101 int type;
1102 STAB *stab;
1103 ARG *cond;
1104 ARG *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
1120 CMD *
1121 make_ccmd(type,arg,cblock)
1122 int type;
1123 register ARG *arg;
1124 struct 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
1140 void
1141 opt_arg(cmd,fliporflop)
1142 register CMD *cmd;
1143 int 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
1339 ARG *
1340 mod_match(type,left,pat)
1341 register ARG *left;
1342 register 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
1405 CMD *
1406 add_label(lbl,cmd)
1407 char *lbl;
1408 register CMD *cmd;
1409 {
1410     if (cmd)
1411         cmd->c_label = lbl;
1412     return cmd;
1413 }
1414
1415 CMD *
1416 addcond(cmd, arg)
1417 register CMD *cmd;
1418 register ARG *arg;
1419 {
1420     cmd->c_expr = arg;
1421     opt_arg(cmd,1);
1422     cmd->c_flags |= CF_COND;
1423     return cmd;
1424 }
1425
1426 CMD *
1427 addloop(cmd, arg)
1428 register CMD *cmd;
1429 register 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
1446 CMD *
1447 invert(cmd)
1448 register CMD *cmd;
1449 {
1450     cmd->c_flags ^= CF_INVERT;
1451     return cmd;
1452 }
1453
1454 yyerror(s)
1455 char *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
1481 char *
1482 scanstr(s)
1483 register 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
1698 ARG *
1699 make_op(type,newlen,arg1,arg2,arg3,dolist)
1700 int type;
1701 int newlen;
1702 ARG *arg1;
1703 ARG *arg2;
1704 ARG *arg3;
1705 int 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
1809 ARG *
1810 flipflip(arg)
1811 register 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
1824 void
1825 evalstatic(arg)
1826 register 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
2032 ARG *
2033 l(arg)
2034 register 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
2112 ARG *
2113 addflags(i,flags,arg)
2114 register ARG *arg;
2115 {
2116     arg[i].arg_flags |= flags;
2117     return arg;
2118 }
2119
2120 ARG *
2121 hide_ary(arg)
2122 ARG *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
2129 ARG *
2130 make_list(arg)
2131 register 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
2181 ARG *
2182 listish(arg)
2183 ARG *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
2190 ARG *
2191 stab_to_arg(atype,stab)
2192 int atype;
2193 register 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
2204 ARG *
2205 cval_to_arg(cval)
2206 register 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
2218 ARG *
2219 op_new(numargs)
2220 int 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
2231 void
2232 free_arg(arg)
2233 ARG *arg;
2234 {
2235     str_free(arg->arg_ptr.arg_str);
2236     safefree((char*)arg);
2237 }
2238
2239 ARG *
2240 make_match(type,expr,spat)
2241 int type;
2242 ARG *expr;
2243 SPAT *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
2264 ARG *
2265 cmd_to_arg(cmd)
2266 CMD *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
2277 CMD *
2278 wopt(cmd)
2279 register 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
2334 FCMD *
2335 load_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 }