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