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