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