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