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