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