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