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