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