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