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