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