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