This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Comment nit by Vadim Konovalov
[perl5.git] / x2p / a2py.c
CommitLineData
79072805 1/* $RCSfile: a2py.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:14 $
a687059c 2 *
4bb101f2
JH
3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4 * 2000, 2001, 2002, by Larry Wall and others
a687059c 5 *
2b317908
LW
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
LW
8 *
9 * $Log: a2py.c,v $
8d063cd8
LW
10 */
11
2986a63f 12#if defined(OS2) || defined(WIN32) || defined(NETWARE)
2c5424a7
GS
13#if defined(WIN32)
14#include <io.h>
15#endif
2986a63f
JH
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
LW
22
23char *filename;
39c3038c 24char *myname;
8d063cd8 25
378cc40b 26int checkers = 0;
748a9306 27
f0f333f4
NIS
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
JH
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
GS
41static void usage(void);
42
9607fc9c 43static void
39c3038c
LW
44usage()
45{
cceca5ed 46 printf("\nThis is the AWK to PERL translator, revision %d.0, version %d\n", PERL_REVISION, PERL_VERSION);
39c3038c
LW
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
JH
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
LW
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
JH
73 #endif /* NETWARE */
74
39c3038c 75 myname = argv[0];
8d063cd8
LW
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
LW
81 switch (argv[0][1]) {
82#ifdef DEBUGGING
83 case 'D':
84 debug = atoi(argv[0]+2);
9d116dd7 85#if YYDEBUG
8d063cd8
LW
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
CS
101 case 'o':
102 old_awk = TRUE;
103 break;
8d063cd8
LW
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
GS
113#else
114 fatal("Unrecognized switch: %s\n",argv[0]);
39c3038c 115#endif
8d063cd8
LW
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
LW
124 if ( isatty(fileno(stdin)) )
125 usage();
126#endif
127 argv[0] = "-";
128 }
129 filename = savestr(argv[0]);
130
8d063cd8
LW
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
LW
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
LW
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
LW
191 str_cat(str,
192 " # process any FOO=bar switches\n\n");
8d063cd8
LW
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
LW
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
NK
213 /* by ANSI specs return is needed. This also shuts up VC++ and his warnings */
214 return(0);
8d063cd8
LW
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
LW
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
LW
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
LW
235 fprintf(stderr,"Tokener at %s",s);
236 else
237 fprintf(stderr,"Tokener at %s\n",s);
b7953727 238 }
8d063cd8
LW
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
LW
247 s++;
248 if (*s && *s != '\n') {
249 yyerror("Ignoring spurious backslash");
250 goto retry;
251 }
252 /*FALLSTHROUGH*/
8d063cd8
LW
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
LW
285 tmp = *s++;
286 XTERM(tmp);
8d063cd8
LW
287 case '{':
288 case '[':
289 case ')':
290 case ']':
a687059c
LW
291 case '?':
292 case ':':
8d063cd8
LW
293 tmp = *s++;
294 XOP(tmp);
9d116dd7
JH
295#ifdef EBCDIC
296 case 7:
297#else
8d063cd8 298 case 127:
9d116dd7 299#endif
8d063cd8
LW
300 s++;
301 XTERM('}');
302 case '}':
3f939f22 303 for (d = s + 1; isSPACE(*d); d++) ;
8d063cd8
LW
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
LW
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
LW
328 tmp = *s++;
329 if (*s == '=') {
a687059c
LW
330 if (tmp == '^')
331 yylval = string("**=",3);
332 else
333 yylval = string(s-1,2);
8d063cd8
LW
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
LW
351 while (*s == ' ' || *s == '\t')
352 s++;
353 if (strnEQ(s,"getline",7))
354 XTERM('p');
355 else
356 XTERM('|');
8d063cd8
LW
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
LW
389 case '>':
390 s++;
391 tmp = *s++;
378cc40b
LW
392 if (tmp == '>') {
393 yylval = string(">>",2);
394 XTERM(GRGR);
395 }
8d063cd8
LW
396 if (tmp == '=') {
397 yylval = string(">=",2);
398 XTERM(RELOP);
399 }
400 s--;
a687059c 401 XTERM('>');
8d063cd8
LW
402
403#define SNARFWORD \
404 d = tokenbuf; \
3f939f22 405 while (isALPHA(*s) || isDIGIT(*s) || *s == '_') \
8d063cd8
LW
406 *d++ = *s++; \
407 *d = '\0'; \
a687059c
LW
408 d = tokenbuf; \
409 if (*s == '(') \
410 idtype = USERFUN; \
411 else \
412 idtype = VAR;
8d063cd8
LW
413
414 case '$':
415 s++;
416 if (*s == '0') {
417 s++;
418 do_chop = TRUE;
419 need_entire = TRUE;
a687059c 420 idtype = VAR;
8d063cd8
LW
421 ID("0");
422 }
423 do_split = TRUE;
3f939f22
JH
424 if (isDIGIT(*s)) {
425 for (d = s; isDIGIT(*s); s++) ;
8d063cd8
LW
426 yylval = string(d,s-d);
427 tmp = atoi(d);
428 if (tmp > maxfld)
429 maxfld = tmp;
430 XOP(FIELD);
431 }
4cec2b33
BD
432 for (d = s; isALPHA(*s) || isDIGIT(*s) || *s == '_'; )
433 s++;
8d063cd8 434 split_to_array = set_array_base = TRUE;
4cec2b33
BD
435 if (d != s)
436 {
437 yylval = string(d,s-d);
438 XTERM(SVFIELD);
439 }
8d063cd8
LW
440 XOP(VFIELD);
441
442 case '/': /* may either be division or pattern */
443 if (expectterm) {
444 s = scanpat(s);
445 XTERM(REGEX);
446 }
447 tmp = *s++;
448 if (*s == '=') {
449 yylval = string("/=",2);
450 s++;
451 XTERM(ASGNOP);
452 }
453 XTERM(tmp);
454
455 case '0': case '1': case '2': case '3': case '4':
a687059c 456 case '5': case '6': case '7': case '8': case '9': case '.':
8d063cd8
LW
457 s = scannum(s);
458 XOP(NUMBER);
459 case '"':
460 s++;
461 s = cpy2(tokenbuf,s,s[-1]);
462 if (!*s)
463 fatal("String not terminated:\n%s",str_get(linestr));
464 s++;
465 yylval = string(tokenbuf,0);
466 XOP(STRING);
467
468 case 'a': case 'A':
469 SNARFWORD;
a687059c
LW
470 if (strEQ(d,"ARGC"))
471 set_array_base = TRUE;
472 if (strEQ(d,"ARGV")) {
473 yylval=numary(string("ARGV",0));
474 XOP(VAR);
475 }
476 if (strEQ(d,"atan2")) {
477 yylval = OATAN2;
478 XTERM(FUNN);
479 }
8d063cd8
LW
480 ID(d);
481 case 'b': case 'B':
482 SNARFWORD;
483 if (strEQ(d,"break"))
484 XTERM(BREAK);
485 if (strEQ(d,"BEGIN"))
486 XTERM(BEGIN);
487 ID(d);
488 case 'c': case 'C':
489 SNARFWORD;
490 if (strEQ(d,"continue"))
491 XTERM(CONTINUE);
a687059c
LW
492 if (strEQ(d,"cos")) {
493 yylval = OCOS;
494 XTERM(FUN1);
495 }
496 if (strEQ(d,"close")) {
497 do_fancy_opens = 1;
498 yylval = OCLOSE;
499 XTERM(FUN1);
500 }
501 if (strEQ(d,"chdir"))
3f939f22 502 *d = toUPPER(*d);
a687059c 503 else if (strEQ(d,"crypt"))
3f939f22 504 *d = toUPPER(*d);
a687059c 505 else if (strEQ(d,"chop"))
3f939f22 506 *d = toUPPER(*d);
a687059c 507 else if (strEQ(d,"chmod"))
3f939f22 508 *d = toUPPER(*d);
a687059c 509 else if (strEQ(d,"chown"))
3f939f22 510 *d = toUPPER(*d);
8d063cd8
LW
511 ID(d);
512 case 'd': case 'D':
513 SNARFWORD;
a687059c
LW
514 if (strEQ(d,"do"))
515 XTERM(DO);
516 if (strEQ(d,"delete"))
517 XTERM(DELETE);
518 if (strEQ(d,"die"))
3f939f22 519 *d = toUPPER(*d);
8d063cd8
LW
520 ID(d);
521 case 'e': case 'E':
522 SNARFWORD;
523 if (strEQ(d,"END"))
524 XTERM(END);
525 if (strEQ(d,"else"))
526 XTERM(ELSE);
527 if (strEQ(d,"exit")) {
528 saw_line_op = TRUE;
529 XTERM(EXIT);
530 }
531 if (strEQ(d,"exp")) {
532 yylval = OEXP;
533 XTERM(FUN1);
534 }
a687059c 535 if (strEQ(d,"elsif"))
3f939f22 536 *d = toUPPER(*d);
a687059c 537 else if (strEQ(d,"eq"))
3f939f22 538 *d = toUPPER(*d);
a687059c 539 else if (strEQ(d,"eval"))
3f939f22 540 *d = toUPPER(*d);
a687059c 541 else if (strEQ(d,"eof"))
3f939f22 542 *d = toUPPER(*d);
a687059c 543 else if (strEQ(d,"each"))
3f939f22 544 *d = toUPPER(*d);
a687059c 545 else if (strEQ(d,"exec"))
3f939f22 546 *d = toUPPER(*d);
8d063cd8
LW
547 ID(d);
548 case 'f': case 'F':
549 SNARFWORD;
550 if (strEQ(d,"FS")) {
551 saw_FS++;
552 if (saw_FS == 1 && in_begin) {
3f939f22 553 for (d = s; *d && isSPACE(*d); d++) ;
8d063cd8 554 if (*d == '=') {
3f939f22 555 for (d++; *d && isSPACE(*d); d++) ;
8d063cd8
LW
556 if (*d == '"' && d[2] == '"')
557 const_FS = d[1];
558 }
559 }
560 ID(tokenbuf);
561 }
8d063cd8
LW
562 if (strEQ(d,"for"))
563 XTERM(FOR);
a687059c
LW
564 else if (strEQ(d,"function"))
565 XTERM(FUNCTION);
566 if (strEQ(d,"FILENAME"))
567 d = "ARGV";
568 if (strEQ(d,"foreach"))
3f939f22 569 *d = toUPPER(*d);
a687059c 570 else if (strEQ(d,"format"))
3f939f22 571 *d = toUPPER(*d);
a687059c 572 else if (strEQ(d,"fork"))
3f939f22 573 *d = toUPPER(*d);
a687059c 574 else if (strEQ(d,"fh"))
3f939f22 575 *d = toUPPER(*d);
8d063cd8
LW
576 ID(d);
577 case 'g': case 'G':
578 SNARFWORD;
579 if (strEQ(d,"getline"))
580 XTERM(GETLINE);
a687059c
LW
581 if (strEQ(d,"gsub"))
582 XTERM(GSUB);
583 if (strEQ(d,"ge"))
3f939f22 584 *d = toUPPER(*d);
a687059c 585 else if (strEQ(d,"gt"))
3f939f22 586 *d = toUPPER(*d);
a687059c 587 else if (strEQ(d,"goto"))
3f939f22 588 *d = toUPPER(*d);
a687059c 589 else if (strEQ(d,"gmtime"))
3f939f22 590 *d = toUPPER(*d);
8d063cd8
LW
591 ID(d);
592 case 'h': case 'H':
593 SNARFWORD;
a687059c 594 if (strEQ(d,"hex"))
3f939f22 595 *d = toUPPER(*d);
8d063cd8
LW
596 ID(d);
597 case 'i': case 'I':
598 SNARFWORD;
599 if (strEQ(d,"if"))
600 XTERM(IF);
601 if (strEQ(d,"in"))
602 XTERM(IN);
603 if (strEQ(d,"index")) {
604 set_array_base = TRUE;
605 XTERM(INDEX);
606 }
607 if (strEQ(d,"int")) {
608 yylval = OINT;
609 XTERM(FUN1);
610 }
611 ID(d);
612 case 'j': case 'J':
613 SNARFWORD;
a687059c 614 if (strEQ(d,"join"))
3f939f22 615 *d = toUPPER(*d);
8d063cd8
LW
616 ID(d);
617 case 'k': case 'K':
618 SNARFWORD;
a687059c 619 if (strEQ(d,"keys"))
3f939f22 620 *d = toUPPER(*d);
a687059c 621 else if (strEQ(d,"kill"))
3f939f22 622 *d = toUPPER(*d);
8d063cd8
LW
623 ID(d);
624 case 'l': case 'L':
625 SNARFWORD;
626 if (strEQ(d,"length")) {
627 yylval = OLENGTH;
628 XTERM(FUN1);
629 }
630 if (strEQ(d,"log")) {
631 yylval = OLOG;
632 XTERM(FUN1);
633 }
a687059c 634 if (strEQ(d,"last"))
3f939f22 635 *d = toUPPER(*d);
a687059c 636 else if (strEQ(d,"local"))
3f939f22 637 *d = toUPPER(*d);
a687059c 638 else if (strEQ(d,"lt"))
3f939f22 639 *d = toUPPER(*d);
a687059c 640 else if (strEQ(d,"le"))
3f939f22 641 *d = toUPPER(*d);
a687059c 642 else if (strEQ(d,"locatime"))
3f939f22 643 *d = toUPPER(*d);
a687059c 644 else if (strEQ(d,"link"))
3f939f22 645 *d = toUPPER(*d);
8d063cd8
LW
646 ID(d);
647 case 'm': case 'M':
648 SNARFWORD;
a687059c
LW
649 if (strEQ(d,"match")) {
650 set_array_base = TRUE;
651 XTERM(MATCH);
652 }
653 if (strEQ(d,"m"))
3f939f22 654 *d = toUPPER(*d);
8d063cd8
LW
655 ID(d);
656 case 'n': case 'N':
657 SNARFWORD;
658 if (strEQ(d,"NF"))
87250799 659 do_chop = do_split = split_to_array = set_array_base = TRUE;
8d063cd8
LW
660 if (strEQ(d,"next")) {
661 saw_line_op = TRUE;
662 XTERM(NEXT);
663 }
a687059c 664 if (strEQ(d,"ne"))
3f939f22 665 *d = toUPPER(*d);
8d063cd8
LW
666 ID(d);
667 case 'o': case 'O':
668 SNARFWORD;
669 if (strEQ(d,"ORS")) {
670 saw_ORS = TRUE;
a687059c 671 d = "\\";
8d063cd8
LW
672 }
673 if (strEQ(d,"OFS")) {
674 saw_OFS = TRUE;
a687059c 675 d = ",";
8d063cd8
LW
676 }
677 if (strEQ(d,"OFMT")) {
a687059c 678 d = "#";
8d063cd8 679 }
a687059c 680 if (strEQ(d,"open"))
3f939f22 681 *d = toUPPER(*d);
a687059c 682 else if (strEQ(d,"ord"))
3f939f22 683 *d = toUPPER(*d);
a687059c 684 else if (strEQ(d,"oct"))
3f939f22 685 *d = toUPPER(*d);
8d063cd8
LW
686 ID(d);
687 case 'p': case 'P':
688 SNARFWORD;
689 if (strEQ(d,"print")) {
690 XTERM(PRINT);
691 }
692 if (strEQ(d,"printf")) {
693 XTERM(PRINTF);
694 }
a687059c 695 if (strEQ(d,"push"))
3f939f22 696 *d = toUPPER(*d);
a687059c 697 else if (strEQ(d,"pop"))
3f939f22 698 *d = toUPPER(*d);
8d063cd8
LW
699 ID(d);
700 case 'q': case 'Q':
701 SNARFWORD;
702 ID(d);
703 case 'r': case 'R':
704 SNARFWORD;
705 if (strEQ(d,"RS")) {
a687059c 706 d = "/";
8d063cd8
LW
707 saw_RS = TRUE;
708 }
a687059c
LW
709 if (strEQ(d,"rand")) {
710 yylval = ORAND;
711 XTERM(FUN1);
712 }
713 if (strEQ(d,"return"))
714 XTERM(RET);
715 if (strEQ(d,"reset"))
3f939f22 716 *d = toUPPER(*d);
a687059c 717 else if (strEQ(d,"redo"))
3f939f22 718 *d = toUPPER(*d);
a687059c 719 else if (strEQ(d,"rename"))
3f939f22 720 *d = toUPPER(*d);
8d063cd8
LW
721 ID(d);
722 case 's': case 'S':
723 SNARFWORD;
724 if (strEQ(d,"split")) {
725 set_array_base = TRUE;
726 XOP(SPLIT);
727 }
728 if (strEQ(d,"substr")) {
729 set_array_base = TRUE;
730 XTERM(SUBSTR);
731 }
a687059c
LW
732 if (strEQ(d,"sub"))
733 XTERM(SUB);
2efaeb47
AD
734 if (strEQ(d,"sprintf")) {
735 /* In old awk, { print sprintf("str%sg"),"in" } prints
736 * "string"; in new awk, "in" is not considered an argument to
737 * sprintf, so the statement breaks. To support both, the
738 * grammar treats arguments to SPRINTF_OLD like old awk,
739 * SPRINTF_NEW like new. Here we return the appropriate one.
740 */
741 XTERM(old_awk ? SPRINTF_OLD : SPRINTF_NEW);
742 }
8d063cd8
LW
743 if (strEQ(d,"sqrt")) {
744 yylval = OSQRT;
745 XTERM(FUN1);
746 }
a687059c
LW
747 if (strEQ(d,"SUBSEP")) {
748 d = ";";
749 }
750 if (strEQ(d,"sin")) {
751 yylval = OSIN;
752 XTERM(FUN1);
753 }
754 if (strEQ(d,"srand")) {
755 yylval = OSRAND;
756 XTERM(FUN1);
757 }
758 if (strEQ(d,"system")) {
759 yylval = OSYSTEM;
760 XTERM(FUN1);
761 }
762 if (strEQ(d,"s"))
3f939f22 763 *d = toUPPER(*d);
a687059c 764 else if (strEQ(d,"shift"))
3f939f22 765 *d = toUPPER(*d);
a687059c 766 else if (strEQ(d,"select"))
3f939f22 767 *d = toUPPER(*d);
a687059c 768 else if (strEQ(d,"seek"))
3f939f22 769 *d = toUPPER(*d);
a687059c 770 else if (strEQ(d,"stat"))
3f939f22 771 *d = toUPPER(*d);
a687059c 772 else if (strEQ(d,"study"))
3f939f22 773 *d = toUPPER(*d);
a687059c 774 else if (strEQ(d,"sleep"))
3f939f22 775 *d = toUPPER(*d);
a687059c 776 else if (strEQ(d,"symlink"))
3f939f22 777 *d = toUPPER(*d);
a687059c 778 else if (strEQ(d,"sort"))
3f939f22 779 *d = toUPPER(*d);
8d063cd8
LW
780 ID(d);
781 case 't': case 'T':
782 SNARFWORD;
a687059c 783 if (strEQ(d,"tr"))
3f939f22 784 *d = toUPPER(*d);
a687059c 785 else if (strEQ(d,"tell"))
3f939f22 786 *d = toUPPER(*d);
a687059c 787 else if (strEQ(d,"time"))
3f939f22 788 *d = toUPPER(*d);
a687059c 789 else if (strEQ(d,"times"))
3f939f22 790 *d = toUPPER(*d);
8d063cd8
LW
791 ID(d);
792 case 'u': case 'U':
793 SNARFWORD;
a687059c 794 if (strEQ(d,"until"))
3f939f22 795 *d = toUPPER(*d);
a687059c 796 else if (strEQ(d,"unless"))
3f939f22 797 *d = toUPPER(*d);
a687059c 798 else if (strEQ(d,"umask"))
3f939f22 799 *d = toUPPER(*d);
a687059c 800 else if (strEQ(d,"unshift"))
3f939f22 801 *d = toUPPER(*d);
a687059c 802 else if (strEQ(d,"unlink"))
3f939f22 803 *d = toUPPER(*d);
a687059c 804 else if (strEQ(d,"utime"))
3f939f22 805 *d = toUPPER(*d);
8d063cd8
LW
806 ID(d);
807 case 'v': case 'V':
808 SNARFWORD;
a687059c 809 if (strEQ(d,"values"))
3f939f22 810 *d = toUPPER(*d);
8d063cd8
LW
811 ID(d);
812 case 'w': case 'W':
813 SNARFWORD;
814 if (strEQ(d,"while"))
815 XTERM(WHILE);
a687059c 816 if (strEQ(d,"write"))
3f939f22 817 *d = toUPPER(*d);
a687059c 818 else if (strEQ(d,"wait"))
3f939f22 819 *d = toUPPER(*d);
8d063cd8
LW
820 ID(d);
821 case 'x': case 'X':
822 SNARFWORD;
a687059c 823 if (strEQ(d,"x"))
3f939f22 824 *d = toUPPER(*d);
8d063cd8
LW
825 ID(d);
826 case 'y': case 'Y':
827 SNARFWORD;
a687059c 828 if (strEQ(d,"y"))
3f939f22 829 *d = toUPPER(*d);
8d063cd8
LW
830 ID(d);
831 case 'z': case 'Z':
832 SNARFWORD;
833 ID(d);
834 }
835}
836
837char *
f0f333f4 838scanpat(register char *s)
8d063cd8
LW
839{
840 register char *d;
841
842 switch (*s++) {
843 case '/':
844 break;
845 default:
846 fatal("Search pattern not found:\n%s",str_get(linestr));
847 }
378cc40b
LW
848
849 d = tokenbuf;
850 for (; *s; s++,d++) {
851 if (*s == '\\') {
852 if (s[1] == '/')
853 *d++ = *s++;
854 else if (s[1] == '\\')
855 *d++ = *s++;
bf10efe7
LW
856 else if (s[1] == '[')
857 *d++ = *s++;
378cc40b
LW
858 }
859 else if (*s == '[') {
860 *d++ = *s++;
861 do {
862 if (*s == '\\' && s[1])
863 *d++ = *s++;
864 if (*s == '/' || (*s == '-' && s[1] == ']'))
865 *d++ = '\\';
866 *d++ = *s++;
867 } while (*s && *s != ']');
868 }
869 else if (*s == '/')
870 break;
871 *d = *s;
872 }
873 *d = '\0';
874
8d063cd8
LW
875 if (!*s)
876 fatal("Search pattern not terminated:\n%s",str_get(linestr));
877 s++;
878 yylval = string(tokenbuf,0);
879 return s;
880}
881
75f92628 882void
f0f333f4 883yyerror(char *s)
8d063cd8
LW
884{
885 fprintf(stderr,"%s in file %s at line %d\n",
886 s,filename,line);
887}
888
889char *
f0f333f4 890scannum(register char *s)
8d063cd8
LW
891{
892 register char *d;
893
894 switch (*s) {
895 case '1': case '2': case '3': case '4': case '5':
896 case '6': case '7': case '8': case '9': case '0' : case '.':
897 d = tokenbuf;
3f939f22 898 while (isDIGIT(*s)) {
8d063cd8 899 *d++ = *s++;
378cc40b 900 }
bf10efe7 901 if (*s == '.') {
3f939f22 902 if (isDIGIT(s[1])) {
378cc40b 903 *d++ = *s++;
3f939f22 904 while (isDIGIT(*s)) {
bf10efe7
LW
905 *d++ = *s++;
906 }
378cc40b 907 }
bf10efe7
LW
908 else
909 s++;
378cc40b 910 }
a0d0e21e 911 if (strchr("eE",*s) && strchr("+-0123456789",s[1])) {
8d063cd8 912 *d++ = *s++;
378cc40b
LW
913 if (*s == '+' || *s == '-')
914 *d++ = *s++;
3f939f22 915 while (isDIGIT(*s))
378cc40b
LW
916 *d++ = *s++;
917 }
8d063cd8
LW
918 *d = '\0';
919 yylval = string(tokenbuf,0);
920 break;
921 }
922 return s;
923}
924
748a9306 925int
f0f333f4 926string(char *ptr, int len)
8d063cd8
LW
927{
928 int retval = mop;
929
930 ops[mop++].ival = OSTRING + (1<<8);
931 if (!len)
932 len = strlen(ptr);
f0f333f4 933 ops[mop].cval = (char *) safemalloc(len+1);
8d063cd8
LW
934 strncpy(ops[mop].cval,ptr,len);
935 ops[mop++].cval[len] = '\0';
a687059c
LW
936 if (mop >= OPSMAX)
937 fatal("Recompile a2p with larger OPSMAX\n");
8d063cd8
LW
938 return retval;
939}
940
748a9306 941int
f0f333f4 942oper0(int type)
8d063cd8
LW
943{
944 int retval = mop;
945
946 if (type > 255)
947 fatal("type > 255 (%d)\n",type);
948 ops[mop++].ival = type;
a687059c
LW
949 if (mop >= OPSMAX)
950 fatal("Recompile a2p with larger OPSMAX\n");
8d063cd8
LW
951 return retval;
952}
953
748a9306 954int
f0f333f4 955oper1(int type, int arg1)
8d063cd8
LW
956{
957 int retval = mop;
958
959 if (type > 255)
960 fatal("type > 255 (%d)\n",type);
961 ops[mop++].ival = type + (1<<8);
962 ops[mop++].ival = arg1;
a687059c
LW
963 if (mop >= OPSMAX)
964 fatal("Recompile a2p with larger OPSMAX\n");
8d063cd8
LW
965 return retval;
966}
967
748a9306 968int
f0f333f4 969oper2(int type, int arg1, int arg2)
8d063cd8
LW
970{
971 int retval = mop;
972
973 if (type > 255)
974 fatal("type > 255 (%d)\n",type);
975 ops[mop++].ival = type + (2<<8);
976 ops[mop++].ival = arg1;
977 ops[mop++].ival = arg2;
a687059c
LW
978 if (mop >= OPSMAX)
979 fatal("Recompile a2p with larger OPSMAX\n");
8d063cd8
LW
980 return retval;
981}
982
748a9306 983int
f0f333f4 984oper3(int type, int arg1, int arg2, int arg3)
8d063cd8
LW
985{
986 int retval = mop;
987
988 if (type > 255)
989 fatal("type > 255 (%d)\n",type);
990 ops[mop++].ival = type + (3<<8);
991 ops[mop++].ival = arg1;
992 ops[mop++].ival = arg2;
993 ops[mop++].ival = arg3;
a687059c
LW
994 if (mop >= OPSMAX)
995 fatal("Recompile a2p with larger OPSMAX\n");
8d063cd8
LW
996 return retval;
997}
998
748a9306 999int
f0f333f4 1000oper4(int type, int arg1, int arg2, int arg3, int arg4)
8d063cd8
LW
1001{
1002 int retval = mop;
1003
1004 if (type > 255)
1005 fatal("type > 255 (%d)\n",type);
1006 ops[mop++].ival = type + (4<<8);
1007 ops[mop++].ival = arg1;
1008 ops[mop++].ival = arg2;
1009 ops[mop++].ival = arg3;
1010 ops[mop++].ival = arg4;
a687059c
LW
1011 if (mop >= OPSMAX)
1012 fatal("Recompile a2p with larger OPSMAX\n");
8d063cd8
LW
1013 return retval;
1014}
1015
748a9306 1016int
f0f333f4 1017oper5(int type, int arg1, int arg2, int arg3, int arg4, int arg5)
8d063cd8
LW
1018{
1019 int retval = mop;
1020
1021 if (type > 255)
1022 fatal("type > 255 (%d)\n",type);
1023 ops[mop++].ival = type + (5<<8);
1024 ops[mop++].ival = arg1;
1025 ops[mop++].ival = arg2;
1026 ops[mop++].ival = arg3;
1027 ops[mop++].ival = arg4;
1028 ops[mop++].ival = arg5;
a687059c
LW
1029 if (mop >= OPSMAX)
1030 fatal("Recompile a2p with larger OPSMAX\n");
8d063cd8
LW
1031 return retval;
1032}
1033
1034int depth = 0;
1035
75f92628 1036void
f0f333f4 1037dump(int branch)
8d063cd8
LW
1038{
1039 register int type;
1040 register int len;
1041 register int i;
1042
1043 type = ops[branch].ival;
1044 len = type >> 8;
1045 type &= 255;
1046 for (i=depth; i; i--)
1047 printf(" ");
1048 if (type == OSTRING) {
1049 printf("%-5d\"%s\"\n",branch,ops[branch+1].cval);
1050 }
1051 else {
1052 printf("(%-5d%s %d\n",branch,opname[type],len);
1053 depth++;
1054 for (i=1; i<=len; i++)
1055 dump(ops[branch+i].ival);
1056 depth--;
1057 for (i=depth; i; i--)
1058 printf(" ");
1059 printf(")\n");
1060 }
1061}
1062
748a9306 1063int
f0f333f4 1064bl(int arg, int maybe)
8d063cd8
LW
1065{
1066 if (!arg)
1067 return 0;
1068 else if ((ops[arg].ival & 255) != OBLOCK)
1069 return oper2(OBLOCK,arg,maybe);
378cc40b 1070 else if ((ops[arg].ival >> 8) < 2)
8d063cd8
LW
1071 return oper2(OBLOCK,ops[arg+1].ival,maybe);
1072 else
1073 return arg;
1074}
1075
75f92628 1076void
f0f333f4 1077fixup(STR *str)
8d063cd8
LW
1078{
1079 register char *s;
1080 register char *t;
1081
1082 for (s = str->str_ptr; *s; s++) {
1083 if (*s == ';' && s[1] == ' ' && s[2] == '\n') {
1084 strcpy(s+1,s+2);
1085 s++;
1086 }
1087 else if (*s == '\n') {
3f939f22 1088 for (t = s+1; isSPACE(*t & 127); t++) ;
8d063cd8 1089 t--;
3f939f22 1090 while (isSPACE(*t & 127) && *t != '\n') t--;
8d063cd8
LW
1091 if (*t == '\n' && t-s > 1) {
1092 if (s[-1] == '{')
1093 s--;
1094 strcpy(s+1,t);
1095 }
1096 s++;
1097 }
1098 }
1099}
1100
75f92628 1101void
f0f333f4 1102putlines(STR *str)
8d063cd8
LW
1103{
1104 register char *d, *s, *t, *e;
1105 register int pos, newpos;
1106
1107 d = tokenbuf;
1108 pos = 0;
1109 for (s = str->str_ptr; *s; s++) {
1110 *d++ = *s;
1111 pos++;
1112 if (*s == '\n') {
1113 *d = '\0';
1114 d = tokenbuf;
1115 pos = 0;
1116 putone();
1117 }
1118 else if (*s == '\t')
1119 pos += 7;
1120 if (pos > 78) { /* split a long line? */
1121 *d-- = '\0';
1122 newpos = 0;
3f939f22 1123 for (t = tokenbuf; isSPACE(*t & 127); t++) {
8d063cd8
LW
1124 if (*t == '\t')
1125 newpos += 8;
1126 else
1127 newpos += 1;
1128 }
1129 e = d;
1130 while (d > tokenbuf && (*d != ' ' || d[-1] != ';'))
1131 d--;
1132 if (d < t+10) {
1133 d = e;
1134 while (d > tokenbuf &&
1135 (*d != ' ' || d[-1] != '|' || d[-2] != '|') )
1136 d--;
1137 }
1138 if (d < t+10) {
1139 d = e;
1140 while (d > tokenbuf &&
1141 (*d != ' ' || d[-1] != '&' || d[-2] != '&') )
1142 d--;
1143 }
1144 if (d < t+10) {
1145 d = e;
1146 while (d > tokenbuf && (*d != ' ' || d[-1] != ','))
1147 d--;
1148 }
1149 if (d < t+10) {
1150 d = e;
1151 while (d > tokenbuf && *d != ' ')
1152 d--;
1153 }
1154 if (d > t+3) {
fe14fcc3
LW
1155 char save[2048];
1156 strcpy(save, d);
1157 *d = '\n';
1158 d[1] = '\0';
8d063cd8
LW
1159 putone();
1160 putchar('\n');
1161 if (d[-1] != ';' && !(newpos % 4)) {
1162 *t++ = ' ';
1163 *t++ = ' ';
1164 newpos += 2;
1165 }
fe14fcc3 1166 strcpy(t,save+1);
8d063cd8
LW
1167 newpos += strlen(t);
1168 d = t + strlen(t);
1169 pos = newpos;
1170 }
1171 else
1172 d = e + 1;
1173 }
1174 }
1175}
1176
75f92628 1177void
f0f333f4 1178putone(void)
8d063cd8
LW
1179{
1180 register char *t;
1181
1182 for (t = tokenbuf; *t; t++) {
1183 *t &= 127;
1184 if (*t == 127) {
1185 *t = ' ';
1186 strcpy(t+strlen(t)-1, "\t#???\n");
378cc40b 1187 checkers++;
8d063cd8
LW
1188 }
1189 }
1190 t = tokenbuf;
1191 if (*t == '#') {
1192 if (strnEQ(t,"#!/bin/awk",10) || strnEQ(t,"#! /bin/awk",11))
1193 return;
378cc40b
LW
1194 if (strnEQ(t,"#!/usr/bin/awk",14) || strnEQ(t,"#! /usr/bin/awk",15))
1195 return;
8d063cd8
LW
1196 }
1197 fputs(tokenbuf,stdout);
1198}
1199
748a9306 1200int
f0f333f4 1201numary(int arg)
8d063cd8
LW
1202{
1203 STR *key;
1204 int dummy;
1205
a687059c 1206 key = walk(0,0,arg,&dummy,P_MIN);
8d063cd8
LW
1207 str_cat(key,"[]");
1208 hstore(symtab,key->str_ptr,str_make("1"));
1209 str_free(key);
1210 set_array_base = TRUE;
1211 return arg;
1212}
a687059c 1213
748a9306 1214int
f0f333f4 1215rememberargs(int arg)
a687059c
LW
1216{
1217 int type;
1218 STR *str;
1219
1220 if (!arg)
1221 return arg;
1222 type = ops[arg].ival & 255;
1223 if (type == OCOMMA) {
1224 rememberargs(ops[arg+1].ival);
1225 rememberargs(ops[arg+3].ival);
1226 }
1227 else if (type == OVAR) {
1228 str = str_new(0);
1229 hstore(curarghash,ops[ops[arg+1].ival+1].cval,str);
1230 }
1231 else
1232 fatal("panic: unknown argument type %d, line %d\n",type,line);
1233 return arg;
1234}
1235
748a9306 1236int
f0f333f4 1237aryrefarg(int arg)
a687059c
LW
1238{
1239 int type = ops[arg].ival & 255;
1240 STR *str;
1241
1242 if (type != OSTRING)
1243 fatal("panic: aryrefarg %d, line %d\n",type,line);
1244 str = hfetch(curarghash,ops[arg+1].cval);
1245 if (str)
1246 str_set(str,"*");
1247 return arg;
1248}
1249
748a9306 1250int
f0f333f4 1251fixfargs(int name, int arg, int prevargs)
a687059c
LW
1252{
1253 int type;
1254 STR *str;
b7953727 1255 int numargs = 0;
a687059c
LW
1256
1257 if (!arg)
1258 return prevargs;
1259 type = ops[arg].ival & 255;
1260 if (type == OCOMMA) {
1261 numargs = fixfargs(name,ops[arg+1].ival,prevargs);
1262 numargs = fixfargs(name,ops[arg+3].ival,numargs);
1263 }
1264 else if (type == OVAR) {
1265 str = hfetch(curarghash,ops[ops[arg+1].ival+1].cval);
1266 if (strEQ(str_get(str),"*")) {
1267 char tmpbuf[128];
1268
1269 str_set(str,""); /* in case another routine has this */
1270 ops[arg].ival &= ~255;
1271 ops[arg].ival |= OSTAR;
1272 sprintf(tmpbuf,"%s:%d",ops[name+1].cval,prevargs);
1273 fprintf(stderr,"Adding %s\n",tmpbuf);
1274 str = str_new(0);
1275 str_set(str,"*");
1276 hstore(curarghash,tmpbuf,str);
1277 }
1278 numargs = prevargs + 1;
1279 }
1280 else
1281 fatal("panic: unknown argument type %d, arg %d, line %d\n",
39c3038c 1282 type,prevargs+1,line);
a687059c
LW
1283 return numargs;
1284}
1285
748a9306 1286int
f0f333f4 1287fixrargs(char *name, int arg, int prevargs)
a687059c
LW
1288{
1289 int type;
1290 STR *str;
1291 int numargs;
1292
1293 if (!arg)
1294 return prevargs;
1295 type = ops[arg].ival & 255;
1296 if (type == OCOMMA) {
1297 numargs = fixrargs(name,ops[arg+1].ival,prevargs);
1298 numargs = fixrargs(name,ops[arg+3].ival,numargs);
1299 }
1300 else {
f0f333f4 1301 char *tmpbuf = (char *) safemalloc(strlen(name) + (sizeof(prevargs) * 3) + 5);
a687059c
LW
1302 sprintf(tmpbuf,"%s:%d",name,prevargs);
1303 str = hfetch(curarghash,tmpbuf);
ece629c6 1304 safefree(tmpbuf);
a687059c
LW
1305 if (str && strEQ(str->str_ptr,"*")) {
1306 if (type == OVAR || type == OSTAR) {
1307 ops[arg].ival &= ~255;
1308 ops[arg].ival |= OSTAR;
1309 }
1310 else
1311 fatal("Can't pass expression by reference as arg %d of %s\n",
1312 prevargs+1, name);
1313 }
1314 numargs = prevargs + 1;
1315 }
1316 return numargs;
1317}