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