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