d53fb16216cb1dd678fcde8baa77b93ff43f6a56
[perl.git] / x2p / a2py.c
1 /* $Header: a2py.c,v 3.0.1.1 90/08/09 05:48:53 lwall Locked $
2  *
3  *    Copyright (c) 1989, Larry Wall
4  *
5  *    You may distribute under the terms of the GNU General Public License
6  *    as specified in the README file that comes with the perl 3.0 kit.
7  *
8  * $Log:        a2py.c,v $
9  * Revision 3.0.1.1  90/08/09  05:48:53  lwall
10  * patch19: a2p didn't emit a chop when NF was referenced though split needs it
11  * 
12  * Revision 3.0  89/10/18  15:34:35  lwall
13  * 3.0 baseline
14  * 
15  */
16
17 #include "util.h"
18 char *index();
19
20 char *filename;
21
22 int checkers = 0;
23 STR *walk();
24
25 main(argc,argv,env)
26 register int argc;
27 register char **argv;
28 register char **env;
29 {
30     register STR *str;
31     register char *s;
32     int i;
33     STR *tmpstr;
34
35     linestr = str_new(80);
36     str = str_new(0);           /* first used for -I flags */
37     for (argc--,argv++; argc; argc--,argv++) {
38         if (argv[0][0] != '-' || !argv[0][1])
39             break;
40       reswitch:
41         switch (argv[0][1]) {
42 #ifdef DEBUGGING
43         case 'D':
44             debug = atoi(argv[0]+2);
45 #ifdef YYDEBUG
46             yydebug = (debug & 1);
47 #endif
48             break;
49 #endif
50         case '0': case '1': case '2': case '3': case '4':
51         case '5': case '6': case '7': case '8': case '9':
52             maxfld = atoi(argv[0]+1);
53             absmaxfld = TRUE;
54             break;
55         case 'F':
56             fswitch = argv[0][2];
57             break;
58         case 'n':
59             namelist = savestr(argv[0]+2);
60             break;
61         case '-':
62             argc--,argv++;
63             goto switch_end;
64         case 0:
65             break;
66         default:
67             fatal("Unrecognized switch: %s\n",argv[0]);
68         }
69     }
70   switch_end:
71
72     /* open script */
73
74     if (argv[0] == Nullch)
75         argv[0] = "-";
76     filename = savestr(argv[0]);
77     if (strEQ(filename,"-"))
78         argv[0] = "";
79     if (!*argv[0])
80         rsfp = stdin;
81     else
82         rsfp = fopen(argv[0],"r");
83     if (rsfp == Nullfp)
84         fatal("Awk script \"%s\" doesn't seem to exist.\n",filename);
85
86     /* init tokener */
87
88     bufptr = str_get(linestr);
89     symtab = hnew();
90     curarghash = hnew();
91
92     /* now parse the report spec */
93
94     if (yyparse())
95         fatal("Translation aborted due to syntax errors.\n");
96
97 #ifdef DEBUGGING
98     if (debug & 2) {
99         int type, len;
100
101         for (i=1; i<mop;) {
102             type = ops[i].ival;
103             len = type >> 8;
104             type &= 255;
105             printf("%d\t%d\t%d\t%-10s",i++,type,len,opname[type]);
106             if (type == OSTRING)
107                 printf("\t\"%s\"\n",ops[i].cval),i++;
108             else {
109                 while (len--) {
110                     printf("\t%d",ops[i].ival),i++;
111                 }
112                 putchar('\n');
113             }
114         }
115     }
116     if (debug & 8)
117         dump(root);
118 #endif
119
120     /* first pass to look for numeric variables */
121
122     prewalk(0,0,root,&i);
123
124     /* second pass to produce new program */
125
126     tmpstr = walk(0,0,root,&i,P_MIN);
127     str = str_make("#!");
128     str_cat(str, BIN);
129     str_cat(str, "/perl\neval \"exec ");
130     str_cat(str, BIN);
131     str_cat(str, "/perl -S $0 $*\"\n\
132     if $running_under_some_shell;\n\
133                         # this emulates #! processing on NIH machines.\n\
134                         # (remove #! line above if indigestible)\n\n");
135     str_cat(str,
136       "eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;\n");
137     str_cat(str,
138       "                 # process any FOO=bar switches\n\n");
139     if (do_opens && opens) {
140         str_scat(str,opens);
141         str_free(opens);
142         str_cat(str,"\n");
143     }
144     str_scat(str,tmpstr);
145     str_free(tmpstr);
146 #ifdef DEBUGGING
147     if (!(debug & 16))
148 #endif
149     fixup(str);
150     putlines(str);
151     if (checkers) {
152         fprintf(stderr,
153           "Please check my work on the %d line%s I've marked with \"#???\".\n",
154                 checkers, checkers == 1 ? "" : "s" );
155         fprintf(stderr,
156           "The operation I've selected may be wrong for the operand types.\n");
157     }
158     exit(0);
159 }
160
161 #define RETURN(retval) return (bufptr = s,retval)
162 #define XTERM(retval) return (expectterm = TRUE,bufptr = s,retval)
163 #define XOP(retval) return (expectterm = FALSE,bufptr = s,retval)
164 #define ID(x) return (yylval=string(x,0),expectterm = FALSE,bufptr = s,idtype)
165
166 int idtype;
167
168 yylex()
169 {
170     register char *s = bufptr;
171     register char *d;
172     register int tmp;
173
174   retry:
175 #ifdef YYDEBUG
176     if (yydebug)
177         if (index(s,'\n'))
178             fprintf(stderr,"Tokener at %s",s);
179         else
180             fprintf(stderr,"Tokener at %s\n",s);
181 #endif
182     switch (*s) {
183     default:
184         fprintf(stderr,
185             "Unrecognized character %c in file %s line %d--ignoring.\n",
186              *s++,filename,line);
187         goto retry;
188     case '\\':
189     case 0:
190         s = str_get(linestr);
191         *s = '\0';
192         if (!rsfp)
193             RETURN(0);
194         line++;
195         if ((s = str_gets(linestr, rsfp)) == Nullch) {
196             if (rsfp != stdin)
197                 fclose(rsfp);
198             rsfp = Nullfp;
199             s = str_get(linestr);
200             RETURN(0);
201         }
202         goto retry;
203     case ' ': case '\t':
204         s++;
205         goto retry;
206     case '\n':
207         *s = '\0';
208         XTERM(NEWLINE);
209     case '#':
210         yylval = string(s,0);
211         *s = '\0';
212         XTERM(COMMENT);
213     case ';':
214         tmp = *s++;
215         if (*s == '\n') {
216             s++;
217             XTERM(SEMINEW);
218         }
219         XTERM(tmp);
220     case '(':
221         tmp = *s++;
222         XTERM(tmp);
223     case '{':
224     case '[':
225     case ')':
226     case ']':
227     case '?':
228     case ':':
229         tmp = *s++;
230         XOP(tmp);
231     case 127:
232         s++;
233         XTERM('}');
234     case '}':
235         for (d = s + 1; isspace(*d); d++) ;
236         if (!*d)
237             s = d - 1;
238         *s = 127;
239         XTERM(';');
240     case ',':
241         tmp = *s++;
242         XTERM(tmp);
243     case '~':
244         s++;
245         yylval = string("~",1);
246         XTERM(MATCHOP);
247     case '+':
248     case '-':
249         if (s[1] == *s) {
250             s++;
251             if (*s++ == '+')
252                 XTERM(INCR);
253             else
254                 XTERM(DECR);
255         }
256         /* FALL THROUGH */
257     case '*':
258     case '%':
259     case '^':
260         tmp = *s++;
261         if (*s == '=') {
262             if (tmp == '^')
263                 yylval = string("**=",3);
264             else
265                 yylval = string(s-1,2);
266             s++;
267             XTERM(ASGNOP);
268         }
269         XTERM(tmp);
270     case '&':
271         s++;
272         tmp = *s++;
273         if (tmp == '&')
274             XTERM(ANDAND);
275         s--;
276         XTERM('&');
277     case '|':
278         s++;
279         tmp = *s++;
280         if (tmp == '|')
281             XTERM(OROR);
282         s--;
283         while (*s == ' ' || *s == '\t')
284             s++;
285         if (strnEQ(s,"getline",7))
286             XTERM('p');
287         else
288             XTERM('|');
289     case '=':
290         s++;
291         tmp = *s++;
292         if (tmp == '=') {
293             yylval = string("==",2);
294             XTERM(RELOP);
295         }
296         s--;
297         yylval = string("=",1);
298         XTERM(ASGNOP);
299     case '!':
300         s++;
301         tmp = *s++;
302         if (tmp == '=') {
303             yylval = string("!=",2);
304             XTERM(RELOP);
305         }
306         if (tmp == '~') {
307             yylval = string("!~",2);
308             XTERM(MATCHOP);
309         }
310         s--;
311         XTERM(NOT);
312     case '<':
313         s++;
314         tmp = *s++;
315         if (tmp == '=') {
316             yylval = string("<=",2);
317             XTERM(RELOP);
318         }
319         s--;
320         XTERM('<');
321     case '>':
322         s++;
323         tmp = *s++;
324         if (tmp == '>') {
325             yylval = string(">>",2);
326             XTERM(GRGR);
327         }
328         if (tmp == '=') {
329             yylval = string(">=",2);
330             XTERM(RELOP);
331         }
332         s--;
333         XTERM('>');
334
335 #define SNARFWORD \
336         d = tokenbuf; \
337         while (isalpha(*s) || isdigit(*s) || *s == '_') \
338             *d++ = *s++; \
339         *d = '\0'; \
340         d = tokenbuf; \
341         if (*s == '(') \
342             idtype = USERFUN; \
343         else \
344             idtype = VAR;
345
346     case '$':
347         s++;
348         if (*s == '0') {
349             s++;
350             do_chop = TRUE;
351             need_entire = TRUE;
352             idtype = VAR;
353             ID("0");
354         }
355         do_split = TRUE;
356         if (isdigit(*s)) {
357             for (d = s; isdigit(*s); s++) ;
358             yylval = string(d,s-d);
359             tmp = atoi(d);
360             if (tmp > maxfld)
361                 maxfld = tmp;
362             XOP(FIELD);
363         }
364         split_to_array = set_array_base = TRUE;
365         XOP(VFIELD);
366
367     case '/':                   /* may either be division or pattern */
368         if (expectterm) {
369             s = scanpat(s);
370             XTERM(REGEX);
371         }
372         tmp = *s++;
373         if (*s == '=') {
374             yylval = string("/=",2);
375             s++;
376             XTERM(ASGNOP);
377         }
378         XTERM(tmp);
379
380     case '0': case '1': case '2': case '3': case '4':
381     case '5': case '6': case '7': case '8': case '9': case '.':
382         s = scannum(s);
383         XOP(NUMBER);
384     case '"':
385         s++;
386         s = cpy2(tokenbuf,s,s[-1]);
387         if (!*s)
388             fatal("String not terminated:\n%s",str_get(linestr));
389         s++;
390         yylval = string(tokenbuf,0);
391         XOP(STRING);
392
393     case 'a': case 'A':
394         SNARFWORD;
395         if (strEQ(d,"ARGC"))
396             set_array_base = TRUE;
397         if (strEQ(d,"ARGV")) {
398             yylval=numary(string("ARGV",0));
399             XOP(VAR);
400         }
401         if (strEQ(d,"atan2")) {
402             yylval = OATAN2;
403             XTERM(FUNN);
404         }
405         ID(d);
406     case 'b': case 'B':
407         SNARFWORD;
408         if (strEQ(d,"break"))
409             XTERM(BREAK);
410         if (strEQ(d,"BEGIN"))
411             XTERM(BEGIN);
412         ID(d);
413     case 'c': case 'C':
414         SNARFWORD;
415         if (strEQ(d,"continue"))
416             XTERM(CONTINUE);
417         if (strEQ(d,"cos")) {
418             yylval = OCOS;
419             XTERM(FUN1);
420         }
421         if (strEQ(d,"close")) {
422             do_fancy_opens = 1;
423             yylval = OCLOSE;
424             XTERM(FUN1);
425         }
426         if (strEQ(d,"chdir"))
427             *d = toupper(*d);
428         else if (strEQ(d,"crypt"))
429             *d = toupper(*d);
430         else if (strEQ(d,"chop"))
431             *d = toupper(*d);
432         else if (strEQ(d,"chmod"))
433             *d = toupper(*d);
434         else if (strEQ(d,"chown"))
435             *d = toupper(*d);
436         ID(d);
437     case 'd': case 'D':
438         SNARFWORD;
439         if (strEQ(d,"do"))
440             XTERM(DO);
441         if (strEQ(d,"delete"))
442             XTERM(DELETE);
443         if (strEQ(d,"die"))
444             *d = toupper(*d);
445         ID(d);
446     case 'e': case 'E':
447         SNARFWORD;
448         if (strEQ(d,"END"))
449             XTERM(END);
450         if (strEQ(d,"else"))
451             XTERM(ELSE);
452         if (strEQ(d,"exit")) {
453             saw_line_op = TRUE;
454             XTERM(EXIT);
455         }
456         if (strEQ(d,"exp")) {
457             yylval = OEXP;
458             XTERM(FUN1);
459         }
460         if (strEQ(d,"elsif"))
461             *d = toupper(*d);
462         else if (strEQ(d,"eq"))
463             *d = toupper(*d);
464         else if (strEQ(d,"eval"))
465             *d = toupper(*d);
466         else if (strEQ(d,"eof"))
467             *d = toupper(*d);
468         else if (strEQ(d,"each"))
469             *d = toupper(*d);
470         else if (strEQ(d,"exec"))
471             *d = toupper(*d);
472         ID(d);
473     case 'f': case 'F':
474         SNARFWORD;
475         if (strEQ(d,"FS")) {
476             saw_FS++;
477             if (saw_FS == 1 && in_begin) {
478                 for (d = s; *d && isspace(*d); d++) ;
479                 if (*d == '=') {
480                     for (d++; *d && isspace(*d); d++) ;
481                     if (*d == '"' && d[2] == '"')
482                         const_FS = d[1];
483                 }
484             }
485             ID(tokenbuf);
486         }
487         if (strEQ(d,"for"))
488             XTERM(FOR);
489         else if (strEQ(d,"function"))
490             XTERM(FUNCTION);
491         if (strEQ(d,"FILENAME"))
492             d = "ARGV";
493         if (strEQ(d,"foreach"))
494             *d = toupper(*d);
495         else if (strEQ(d,"format"))
496             *d = toupper(*d);
497         else if (strEQ(d,"fork"))
498             *d = toupper(*d);
499         else if (strEQ(d,"fh"))
500             *d = toupper(*d);
501         ID(d);
502     case 'g': case 'G':
503         SNARFWORD;
504         if (strEQ(d,"getline"))
505             XTERM(GETLINE);
506         if (strEQ(d,"gsub"))
507             XTERM(GSUB);
508         if (strEQ(d,"ge"))
509             *d = toupper(*d);
510         else if (strEQ(d,"gt"))
511             *d = toupper(*d);
512         else if (strEQ(d,"goto"))
513             *d = toupper(*d);
514         else if (strEQ(d,"gmtime"))
515             *d = toupper(*d);
516         ID(d);
517     case 'h': case 'H':
518         SNARFWORD;
519         if (strEQ(d,"hex"))
520             *d = toupper(*d);
521         ID(d);
522     case 'i': case 'I':
523         SNARFWORD;
524         if (strEQ(d,"if"))
525             XTERM(IF);
526         if (strEQ(d,"in"))
527             XTERM(IN);
528         if (strEQ(d,"index")) {
529             set_array_base = TRUE;
530             XTERM(INDEX);
531         }
532         if (strEQ(d,"int")) {
533             yylval = OINT;
534             XTERM(FUN1);
535         }
536         ID(d);
537     case 'j': case 'J':
538         SNARFWORD;
539         if (strEQ(d,"join"))
540             *d = toupper(*d);
541         ID(d);
542     case 'k': case 'K':
543         SNARFWORD;
544         if (strEQ(d,"keys"))
545             *d = toupper(*d);
546         else if (strEQ(d,"kill"))
547             *d = toupper(*d);
548         ID(d);
549     case 'l': case 'L':
550         SNARFWORD;
551         if (strEQ(d,"length")) {
552             yylval = OLENGTH;
553             XTERM(FUN1);
554         }
555         if (strEQ(d,"log")) {
556             yylval = OLOG;
557             XTERM(FUN1);
558         }
559         if (strEQ(d,"last"))
560             *d = toupper(*d);
561         else if (strEQ(d,"local"))
562             *d = toupper(*d);
563         else if (strEQ(d,"lt"))
564             *d = toupper(*d);
565         else if (strEQ(d,"le"))
566             *d = toupper(*d);
567         else if (strEQ(d,"locatime"))
568             *d = toupper(*d);
569         else if (strEQ(d,"link"))
570             *d = toupper(*d);
571         ID(d);
572     case 'm': case 'M':
573         SNARFWORD;
574         if (strEQ(d,"match")) {
575             set_array_base = TRUE;
576             XTERM(MATCH);
577         }
578         if (strEQ(d,"m"))
579             *d = toupper(*d);
580         ID(d);
581     case 'n': case 'N':
582         SNARFWORD;
583         if (strEQ(d,"NF"))
584             do_chop = do_split = split_to_array = set_array_base = TRUE;
585         if (strEQ(d,"next")) {
586             saw_line_op = TRUE;
587             XTERM(NEXT);
588         }
589         if (strEQ(d,"ne"))
590             *d = toupper(*d);
591         ID(d);
592     case 'o': case 'O':
593         SNARFWORD;
594         if (strEQ(d,"ORS")) {
595             saw_ORS = TRUE;
596             d = "\\";
597         }
598         if (strEQ(d,"OFS")) {
599             saw_OFS = TRUE;
600             d = ",";
601         }
602         if (strEQ(d,"OFMT")) {
603             d = "#";
604         }
605         if (strEQ(d,"open"))
606             *d = toupper(*d);
607         else if (strEQ(d,"ord"))
608             *d = toupper(*d);
609         else if (strEQ(d,"oct"))
610             *d = toupper(*d);
611         ID(d);
612     case 'p': case 'P':
613         SNARFWORD;
614         if (strEQ(d,"print")) {
615             XTERM(PRINT);
616         }
617         if (strEQ(d,"printf")) {
618             XTERM(PRINTF);
619         }
620         if (strEQ(d,"push"))
621             *d = toupper(*d);
622         else if (strEQ(d,"pop"))
623             *d = toupper(*d);
624         ID(d);
625     case 'q': case 'Q':
626         SNARFWORD;
627         ID(d);
628     case 'r': case 'R':
629         SNARFWORD;
630         if (strEQ(d,"RS")) {
631             d = "/";
632             saw_RS = TRUE;
633         }
634         if (strEQ(d,"rand")) {
635             yylval = ORAND;
636             XTERM(FUN1);
637         }
638         if (strEQ(d,"return"))
639             XTERM(RET);
640         if (strEQ(d,"reset"))
641             *d = toupper(*d);
642         else if (strEQ(d,"redo"))
643             *d = toupper(*d);
644         else if (strEQ(d,"rename"))
645             *d = toupper(*d);
646         ID(d);
647     case 's': case 'S':
648         SNARFWORD;
649         if (strEQ(d,"split")) {
650             set_array_base = TRUE;
651             XOP(SPLIT);
652         }
653         if (strEQ(d,"substr")) {
654             set_array_base = TRUE;
655             XTERM(SUBSTR);
656         }
657         if (strEQ(d,"sub"))
658             XTERM(SUB);
659         if (strEQ(d,"sprintf"))
660             XTERM(SPRINTF);
661         if (strEQ(d,"sqrt")) {
662             yylval = OSQRT;
663             XTERM(FUN1);
664         }
665         if (strEQ(d,"SUBSEP")) {
666             d = ";";
667         }
668         if (strEQ(d,"sin")) {
669             yylval = OSIN;
670             XTERM(FUN1);
671         }
672         if (strEQ(d,"srand")) {
673             yylval = OSRAND;
674             XTERM(FUN1);
675         }
676         if (strEQ(d,"system")) {
677             yylval = OSYSTEM;
678             XTERM(FUN1);
679         }
680         if (strEQ(d,"s"))
681             *d = toupper(*d);
682         else if (strEQ(d,"shift"))
683             *d = toupper(*d);
684         else if (strEQ(d,"select"))
685             *d = toupper(*d);
686         else if (strEQ(d,"seek"))
687             *d = toupper(*d);
688         else if (strEQ(d,"stat"))
689             *d = toupper(*d);
690         else if (strEQ(d,"study"))
691             *d = toupper(*d);
692         else if (strEQ(d,"sleep"))
693             *d = toupper(*d);
694         else if (strEQ(d,"symlink"))
695             *d = toupper(*d);
696         else if (strEQ(d,"sort"))
697             *d = toupper(*d);
698         ID(d);
699     case 't': case 'T':
700         SNARFWORD;
701         if (strEQ(d,"tr"))
702             *d = toupper(*d);
703         else if (strEQ(d,"tell"))
704             *d = toupper(*d);
705         else if (strEQ(d,"time"))
706             *d = toupper(*d);
707         else if (strEQ(d,"times"))
708             *d = toupper(*d);
709         ID(d);
710     case 'u': case 'U':
711         SNARFWORD;
712         if (strEQ(d,"until"))
713             *d = toupper(*d);
714         else if (strEQ(d,"unless"))
715             *d = toupper(*d);
716         else if (strEQ(d,"umask"))
717             *d = toupper(*d);
718         else if (strEQ(d,"unshift"))
719             *d = toupper(*d);
720         else if (strEQ(d,"unlink"))
721             *d = toupper(*d);
722         else if (strEQ(d,"utime"))
723             *d = toupper(*d);
724         ID(d);
725     case 'v': case 'V':
726         SNARFWORD;
727         if (strEQ(d,"values"))
728             *d = toupper(*d);
729         ID(d);
730     case 'w': case 'W':
731         SNARFWORD;
732         if (strEQ(d,"while"))
733             XTERM(WHILE);
734         if (strEQ(d,"write"))
735             *d = toupper(*d);
736         else if (strEQ(d,"wait"))
737             *d = toupper(*d);
738         ID(d);
739     case 'x': case 'X':
740         SNARFWORD;
741         if (strEQ(d,"x"))
742             *d = toupper(*d);
743         ID(d);
744     case 'y': case 'Y':
745         SNARFWORD;
746         if (strEQ(d,"y"))
747             *d = toupper(*d);
748         ID(d);
749     case 'z': case 'Z':
750         SNARFWORD;
751         ID(d);
752     }
753 }
754
755 char *
756 scanpat(s)
757 register char *s;
758 {
759     register char *d;
760
761     switch (*s++) {
762     case '/':
763         break;
764     default:
765         fatal("Search pattern not found:\n%s",str_get(linestr));
766     }
767
768     d = tokenbuf;
769     for (; *s; s++,d++) {
770         if (*s == '\\') {
771             if (s[1] == '/')
772                 *d++ = *s++;
773             else if (s[1] == '\\')
774                 *d++ = *s++;
775         }
776         else if (*s == '[') {
777             *d++ = *s++;
778             do {
779                 if (*s == '\\' && s[1])
780                     *d++ = *s++;
781                 if (*s == '/' || (*s == '-' && s[1] == ']'))
782                     *d++ = '\\';
783                 *d++ = *s++;
784             } while (*s && *s != ']');
785         }
786         else if (*s == '/')
787             break;
788         *d = *s;
789     }
790     *d = '\0';
791
792     if (!*s)
793         fatal("Search pattern not terminated:\n%s",str_get(linestr));
794     s++;
795     yylval = string(tokenbuf,0);
796     return s;
797 }
798
799 yyerror(s)
800 char *s;
801 {
802     fprintf(stderr,"%s in file %s at line %d\n",
803       s,filename,line);
804 }
805
806 char *
807 scannum(s)
808 register char *s;
809 {
810     register char *d;
811
812     switch (*s) {
813     case '1': case '2': case '3': case '4': case '5':
814     case '6': case '7': case '8': case '9': case '0' : case '.':
815         d = tokenbuf;
816         while (isdigit(*s)) {
817             *d++ = *s++;
818         }
819         if (*s == '.' && index("0123456789eE",s[1])) {
820             *d++ = *s++;
821             while (isdigit(*s)) {
822                 *d++ = *s++;
823             }
824         }
825         if (index("eE",*s) && index("+-0123456789",s[1])) {
826             *d++ = *s++;
827             if (*s == '+' || *s == '-')
828                 *d++ = *s++;
829             while (isdigit(*s))
830                 *d++ = *s++;
831         }
832         *d = '\0';
833         yylval = string(tokenbuf,0);
834         break;
835     }
836     return s;
837 }
838
839 string(ptr,len)
840 char *ptr;
841 {
842     int retval = mop;
843
844     ops[mop++].ival = OSTRING + (1<<8);
845     if (!len)
846         len = strlen(ptr);
847     ops[mop].cval = safemalloc(len+1);
848     strncpy(ops[mop].cval,ptr,len);
849     ops[mop++].cval[len] = '\0';
850     if (mop >= OPSMAX)
851         fatal("Recompile a2p with larger OPSMAX\n");
852     return retval;
853 }
854
855 oper0(type)
856 int type;
857 {
858     int retval = mop;
859
860     if (type > 255)
861         fatal("type > 255 (%d)\n",type);
862     ops[mop++].ival = type;
863     if (mop >= OPSMAX)
864         fatal("Recompile a2p with larger OPSMAX\n");
865     return retval;
866 }
867
868 oper1(type,arg1)
869 int type;
870 int arg1;
871 {
872     int retval = mop;
873
874     if (type > 255)
875         fatal("type > 255 (%d)\n",type);
876     ops[mop++].ival = type + (1<<8);
877     ops[mop++].ival = arg1;
878     if (mop >= OPSMAX)
879         fatal("Recompile a2p with larger OPSMAX\n");
880     return retval;
881 }
882
883 oper2(type,arg1,arg2)
884 int type;
885 int arg1;
886 int arg2;
887 {
888     int retval = mop;
889
890     if (type > 255)
891         fatal("type > 255 (%d)\n",type);
892     ops[mop++].ival = type + (2<<8);
893     ops[mop++].ival = arg1;
894     ops[mop++].ival = arg2;
895     if (mop >= OPSMAX)
896         fatal("Recompile a2p with larger OPSMAX\n");
897     return retval;
898 }
899
900 oper3(type,arg1,arg2,arg3)
901 int type;
902 int arg1;
903 int arg2;
904 int arg3;
905 {
906     int retval = mop;
907
908     if (type > 255)
909         fatal("type > 255 (%d)\n",type);
910     ops[mop++].ival = type + (3<<8);
911     ops[mop++].ival = arg1;
912     ops[mop++].ival = arg2;
913     ops[mop++].ival = arg3;
914     if (mop >= OPSMAX)
915         fatal("Recompile a2p with larger OPSMAX\n");
916     return retval;
917 }
918
919 oper4(type,arg1,arg2,arg3,arg4)
920 int type;
921 int arg1;
922 int arg2;
923 int arg3;
924 int arg4;
925 {
926     int retval = mop;
927
928     if (type > 255)
929         fatal("type > 255 (%d)\n",type);
930     ops[mop++].ival = type + (4<<8);
931     ops[mop++].ival = arg1;
932     ops[mop++].ival = arg2;
933     ops[mop++].ival = arg3;
934     ops[mop++].ival = arg4;
935     if (mop >= OPSMAX)
936         fatal("Recompile a2p with larger OPSMAX\n");
937     return retval;
938 }
939
940 oper5(type,arg1,arg2,arg3,arg4,arg5)
941 int type;
942 int arg1;
943 int arg2;
944 int arg3;
945 int arg4;
946 int arg5;
947 {
948     int retval = mop;
949
950     if (type > 255)
951         fatal("type > 255 (%d)\n",type);
952     ops[mop++].ival = type + (5<<8);
953     ops[mop++].ival = arg1;
954     ops[mop++].ival = arg2;
955     ops[mop++].ival = arg3;
956     ops[mop++].ival = arg4;
957     ops[mop++].ival = arg5;
958     if (mop >= OPSMAX)
959         fatal("Recompile a2p with larger OPSMAX\n");
960     return retval;
961 }
962
963 int depth = 0;
964
965 dump(branch)
966 int branch;
967 {
968     register int type;
969     register int len;
970     register int i;
971
972     type = ops[branch].ival;
973     len = type >> 8;
974     type &= 255;
975     for (i=depth; i; i--)
976         printf(" ");
977     if (type == OSTRING) {
978         printf("%-5d\"%s\"\n",branch,ops[branch+1].cval);
979     }
980     else {
981         printf("(%-5d%s %d\n",branch,opname[type],len);
982         depth++;
983         for (i=1; i<=len; i++)
984             dump(ops[branch+i].ival);
985         depth--;
986         for (i=depth; i; i--)
987             printf(" ");
988         printf(")\n");
989     }
990 }
991
992 bl(arg,maybe)
993 int arg;
994 int maybe;
995 {
996     if (!arg)
997         return 0;
998     else if ((ops[arg].ival & 255) != OBLOCK)
999         return oper2(OBLOCK,arg,maybe);
1000     else if ((ops[arg].ival >> 8) < 2)
1001         return oper2(OBLOCK,ops[arg+1].ival,maybe);
1002     else
1003         return arg;
1004 }
1005
1006 fixup(str)
1007 STR *str;
1008 {
1009     register char *s;
1010     register char *t;
1011
1012     for (s = str->str_ptr; *s; s++) {
1013         if (*s == ';' && s[1] == ' ' && s[2] == '\n') {
1014             strcpy(s+1,s+2);
1015             s++;
1016         }
1017         else if (*s == '\n') {
1018             for (t = s+1; isspace(*t & 127); t++) ;
1019             t--;
1020             while (isspace(*t & 127) && *t != '\n') t--;
1021             if (*t == '\n' && t-s > 1) {
1022                 if (s[-1] == '{')
1023                     s--;
1024                 strcpy(s+1,t);
1025             }
1026             s++;
1027         }
1028     }
1029 }
1030
1031 putlines(str)
1032 STR *str;
1033 {
1034     register char *d, *s, *t, *e;
1035     register int pos, newpos;
1036
1037     d = tokenbuf;
1038     pos = 0;
1039     for (s = str->str_ptr; *s; s++) {
1040         *d++ = *s;
1041         pos++;
1042         if (*s == '\n') {
1043             *d = '\0';
1044             d = tokenbuf;
1045             pos = 0;
1046             putone();
1047         }
1048         else if (*s == '\t')
1049             pos += 7;
1050         if (pos > 78) {         /* split a long line? */
1051             *d-- = '\0';
1052             newpos = 0;
1053             for (t = tokenbuf; isspace(*t & 127); t++) {
1054                 if (*t == '\t')
1055                     newpos += 8;
1056                 else
1057                     newpos += 1;
1058             }
1059             e = d;
1060             while (d > tokenbuf && (*d != ' ' || d[-1] != ';'))
1061                 d--;
1062             if (d < t+10) {
1063                 d = e;
1064                 while (d > tokenbuf &&
1065                   (*d != ' ' || d[-1] != '|' || d[-2] != '|') )
1066                     d--;
1067             }
1068             if (d < t+10) {
1069                 d = e;
1070                 while (d > tokenbuf &&
1071                   (*d != ' ' || d[-1] != '&' || d[-2] != '&') )
1072                     d--;
1073             }
1074             if (d < t+10) {
1075                 d = e;
1076                 while (d > tokenbuf && (*d != ' ' || d[-1] != ','))
1077                     d--;
1078             }
1079             if (d < t+10) {
1080                 d = e;
1081                 while (d > tokenbuf && *d != ' ')
1082                     d--;
1083             }
1084             if (d > t+3) {
1085                 *d = '\0';
1086                 putone();
1087                 putchar('\n');
1088                 if (d[-1] != ';' && !(newpos % 4)) {
1089                     *t++ = ' ';
1090                     *t++ = ' ';
1091                     newpos += 2;
1092                 }
1093                 strcpy(t,d+1);
1094                 newpos += strlen(t);
1095                 d = t + strlen(t);
1096                 pos = newpos;
1097             }
1098             else
1099                 d = e + 1;
1100         }
1101     }
1102 }
1103
1104 putone()
1105 {
1106     register char *t;
1107
1108     for (t = tokenbuf; *t; t++) {
1109         *t &= 127;
1110         if (*t == 127) {
1111             *t = ' ';
1112             strcpy(t+strlen(t)-1, "\t#???\n");
1113             checkers++;
1114         }
1115     }
1116     t = tokenbuf;
1117     if (*t == '#') {
1118         if (strnEQ(t,"#!/bin/awk",10) || strnEQ(t,"#! /bin/awk",11))
1119             return;
1120         if (strnEQ(t,"#!/usr/bin/awk",14) || strnEQ(t,"#! /usr/bin/awk",15))
1121             return;
1122     }
1123     fputs(tokenbuf,stdout);
1124 }
1125
1126 numary(arg)
1127 int arg;
1128 {
1129     STR *key;
1130     int dummy;
1131
1132     key = walk(0,0,arg,&dummy,P_MIN);
1133     str_cat(key,"[]");
1134     hstore(symtab,key->str_ptr,str_make("1"));
1135     str_free(key);
1136     set_array_base = TRUE;
1137     return arg;
1138 }
1139
1140 rememberargs(arg)
1141 int arg;
1142 {
1143     int type;
1144     STR *str;
1145
1146     if (!arg)
1147         return arg;
1148     type = ops[arg].ival & 255;
1149     if (type == OCOMMA) {
1150         rememberargs(ops[arg+1].ival);
1151         rememberargs(ops[arg+3].ival);
1152     }
1153     else if (type == OVAR) {
1154         str = str_new(0);
1155         hstore(curarghash,ops[ops[arg+1].ival+1].cval,str);
1156     }
1157     else
1158         fatal("panic: unknown argument type %d, line %d\n",type,line);
1159     return arg;
1160 }
1161
1162 aryrefarg(arg)
1163 int arg;
1164 {
1165     int type = ops[arg].ival & 255;
1166     STR *str;
1167
1168     if (type != OSTRING)
1169         fatal("panic: aryrefarg %d, line %d\n",type,line);
1170     str = hfetch(curarghash,ops[arg+1].cval);
1171     if (str)
1172         str_set(str,"*");
1173     return arg;
1174 }
1175
1176 fixfargs(name,arg,prevargs)
1177 int name;
1178 int arg;
1179 int prevargs;
1180 {
1181     int type;
1182     STR *str;
1183     int numargs;
1184
1185     if (!arg)
1186         return prevargs;
1187     type = ops[arg].ival & 255;
1188     if (type == OCOMMA) {
1189         numargs = fixfargs(name,ops[arg+1].ival,prevargs);
1190         numargs = fixfargs(name,ops[arg+3].ival,numargs);
1191     }
1192     else if (type == OVAR) {
1193         str = hfetch(curarghash,ops[ops[arg+1].ival+1].cval);
1194         if (strEQ(str_get(str),"*")) {
1195             char tmpbuf[128];
1196
1197             str_set(str,"");            /* in case another routine has this */
1198             ops[arg].ival &= ~255;
1199             ops[arg].ival |= OSTAR;
1200             sprintf(tmpbuf,"%s:%d",ops[name+1].cval,prevargs);
1201             fprintf(stderr,"Adding %s\n",tmpbuf);
1202             str = str_new(0);
1203             str_set(str,"*");
1204             hstore(curarghash,tmpbuf,str);
1205         }
1206         numargs = prevargs + 1;
1207     }
1208     else
1209         fatal("panic: unknown argument type %d, arg %d, line %d\n",
1210           type,numargs+1,line);
1211     return numargs;
1212 }
1213
1214 fixrargs(name,arg,prevargs)
1215 char *name;
1216 int arg;
1217 int prevargs;
1218 {
1219     int type;
1220     STR *str;
1221     int numargs;
1222
1223     if (!arg)
1224         return prevargs;
1225     type = ops[arg].ival & 255;
1226     if (type == OCOMMA) {
1227         numargs = fixrargs(name,ops[arg+1].ival,prevargs);
1228         numargs = fixrargs(name,ops[arg+3].ival,numargs);
1229     }
1230     else {
1231         char tmpbuf[128];
1232
1233         sprintf(tmpbuf,"%s:%d",name,prevargs);
1234         str = hfetch(curarghash,tmpbuf);
1235         fprintf(stderr,"Looking for %s\n",tmpbuf);
1236         if (str && strEQ(str->str_ptr,"*")) {
1237             if (type == OVAR || type == OSTAR) {
1238                 ops[arg].ival &= ~255;
1239                 ops[arg].ival |= OSTAR;
1240             }
1241             else
1242                 fatal("Can't pass expression by reference as arg %d of %s\n",
1243                     prevargs+1, name);
1244         }
1245         numargs = prevargs + 1;
1246     }
1247     return numargs;
1248 }
1249