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