x2p/a2py.c

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