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