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