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