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