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