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