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