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