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