x2p/a2py.c

   1 /* $RCSfile: a2py.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:14 $
   2  *
   3  *    Copyright (c) 1991-1997, 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 static void
  31 usage()
  32 {
  33     printf("\nThis is the AWK to PERL translator, version 5.0, patchlevel %d\n", PATCHLEVEL);
  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
  45
  46 int
  47 main(argc,argv,env)
  48 register int argc;
  49 register char **argv;
  50 register char **env;
  51 {
  52     register STR *str;
  53     int i;
  54     STR *tmpstr;
  55
  56     myname = argv[0];
  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]);
  90 #ifdef OS2
  91             usage();
  92 #endif
  93         }
  94     }
  95   switch_end:
  96
  97     /* open script */
  98
  99     if (argv[0] == Nullch) {
 100 #ifdef OS2
 101         if ( isatty(fileno(stdin)) )
 102             usage();
 103 #endif
 104         argv[0] = "-";
 105     }
 106     filename = savestr(argv[0]);
 107
 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();
 122     curarghash = hnew();
 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
 158     tmpstr = walk(0,0,root,&i,P_MIN);
 159     str = str_make(STARTPERL);
 160     str_cat(str, "\neval 'exec ");
 161     str_cat(str, BIN);
 162     str_cat(str, "/perl -S $0 ${1+\"$@\"}'\n\
 163     if $running_under_some_shell;\n\
 164                         # this emulates #! processing on NIH machines.\n\
 165                         # (remove #! line above if indigestible)\n\n");
 166     str_cat(str,
 167       "eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;\n");
 168     str_cat(str,
 169       "                 # process any FOO=bar switches\n\n");
 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);
 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     }
 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)
 195 #define ID(x) return (yylval=string(x,0),expectterm = FALSE,bufptr = s,idtype)
 196
 197 int idtype;
 198
 199 int
 200 yylex()
 201 {
 202     register char *s = bufptr;
 203     register char *d;
 204     register int tmp;
 205
 206   retry:
 207 #ifdef YYDEBUG
 208     if (yydebug)
 209         if (strchr(s,'\n'))
 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 '\\':
 221         s++;
 222         if (*s && *s != '\n') {
 223             yyerror("Ignoring spurious backslash");
 224             goto retry;
 225         }
 226         /*FALLSTHROUGH*/
 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 '(':
 259         tmp = *s++;
 260         XTERM(tmp);
 261     case '{':
 262     case '[':
 263     case ')':
 264     case ']':
 265     case '?':
 266     case ':':
 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++;
 283         yylval = string("~",1);
 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 '%':
 297     case '^':
 298         tmp = *s++;
 299         if (*s == '=') {
 300             if (tmp == '^')
 301                 yylval = string("**=",3);
 302             else
 303                 yylval = string(s-1,2);
 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--;
 321         while (*s == ' ' || *s == '\t')
 322             s++;
 323         if (strnEQ(s,"getline",7))
 324             XTERM('p');
 325         else
 326             XTERM('|');
 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--;
 358         XTERM('<');
 359     case '>':
 360         s++;
 361         tmp = *s++;
 362         if (tmp == '>') {
 363             yylval = string(">>",2);
 364             XTERM(GRGR);
 365         }
 366         if (tmp == '=') {
 367             yylval = string(">=",2);
 368             XTERM(RELOP);
 369         }
 370         s--;
 371         XTERM('>');
 372
 373 #define SNARFWORD \
 374         d = tokenbuf; \
 375         while (isalpha(*s) || isdigit(*s) || *s == '_') \
 376             *d++ = *s++; \
 377         *d = '\0'; \
 378         d = tokenbuf; \
 379         if (*s == '(') \
 380             idtype = USERFUN; \
 381         else \
 382             idtype = VAR;
 383
 384     case '$':
 385         s++;
 386         if (*s == '0') {
 387             s++;
 388             do_chop = TRUE;
 389             need_entire = TRUE;
 390             idtype = VAR;
 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':
 419     case '5': case '6': case '7': case '8': case '9': case '.':
 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;
 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         }
 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);
 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);
 474         ID(d);
 475     case 'd': case 'D':
 476         SNARFWORD;
 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);
 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         }
 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);
 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         }
 525         if (strEQ(d,"for"))
 526             XTERM(FOR);
 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);
 539         ID(d);
 540     case 'g': case 'G':
 541         SNARFWORD;
 542         if (strEQ(d,"getline"))
 543             XTERM(GETLINE);
 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);
 554         ID(d);
 555     case 'h': case 'H':
 556         SNARFWORD;
 557         if (strEQ(d,"hex"))
 558             *d = toupper(*d);
 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;
 577         if (strEQ(d,"join"))
 578             *d = toupper(*d);
 579         ID(d);
 580     case 'k': case 'K':
 581         SNARFWORD;
 582         if (strEQ(d,"keys"))
 583             *d = toupper(*d);
 584         else if (strEQ(d,"kill"))
 585             *d = toupper(*d);
 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         }
 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);
 609         ID(d);
 610     case 'm': case 'M':
 611         SNARFWORD;
 612         if (strEQ(d,"match")) {
 613             set_array_base = TRUE;
 614             XTERM(MATCH);
 615         }
 616         if (strEQ(d,"m"))
 617             *d = toupper(*d);
 618         ID(d);
 619     case 'n': case 'N':
 620         SNARFWORD;
 621         if (strEQ(d,"NF"))
 622             do_chop = do_split = split_to_array = set_array_base = TRUE;
 623         if (strEQ(d,"next")) {
 624             saw_line_op = TRUE;
 625             XTERM(NEXT);
 626         }
 627         if (strEQ(d,"ne"))
 628             *d = toupper(*d);
 629         ID(d);
 630     case 'o': case 'O':
 631         SNARFWORD;
 632         if (strEQ(d,"ORS")) {
 633             saw_ORS = TRUE;
 634             d = "\\";
 635         }
 636         if (strEQ(d,"OFS")) {
 637             saw_OFS = TRUE;
 638             d = ",";
 639         }
 640         if (strEQ(d,"OFMT")) {
 641             d = "#";
 642         }
 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);
 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         }
 658         if (strEQ(d,"push"))
 659             *d = toupper(*d);
 660         else if (strEQ(d,"pop"))
 661             *d = toupper(*d);
 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")) {
 669             d = "/";
 670             saw_RS = TRUE;
 671         }
 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);
 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         }
 695         if (strEQ(d,"sub"))
 696             XTERM(SUB);
 697         if (strEQ(d,"sprintf"))
 698             XTERM(SPRINTF);
 699         if (strEQ(d,"sqrt")) {
 700             yylval = OSQRT;
 701             XTERM(FUN1);
 702         }
 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);
 736         ID(d);
 737     case 't': case 'T':
 738         SNARFWORD;
 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);
 747         ID(d);
 748     case 'u': case 'U':
 749         SNARFWORD;
 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);
 762         ID(d);
 763     case 'v': case 'V':
 764         SNARFWORD;
 765         if (strEQ(d,"values"))
 766             *d = toupper(*d);
 767         ID(d);
 768     case 'w': case 'W':
 769         SNARFWORD;
 770         if (strEQ(d,"while"))
 771             XTERM(WHILE);
 772         if (strEQ(d,"write"))
 773             *d = toupper(*d);
 774         else if (strEQ(d,"wait"))
 775             *d = toupper(*d);
 776         ID(d);
 777     case 'x': case 'X':
 778         SNARFWORD;
 779         if (strEQ(d,"x"))
 780             *d = toupper(*d);
 781         ID(d);
 782     case 'y': case 'Y':
 783         SNARFWORD;
 784         if (strEQ(d,"y"))
 785             *d = toupper(*d);
 786         ID(d);
 787     case 'z': case 'Z':
 788         SNARFWORD;
 789         ID(d);
 790     }
 791 }
 792
 793 char *
 794 scanpat(s)
 795 register 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     }
 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++;
 813             else if (s[1] == '[')
 814                 *d++ = *s++;
 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
 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
 839 void
 840 yyerror(s)
 841 char *s;
 842 {
 843     fprintf(stderr,"%s in file %s at line %d\n",
 844       s,filename,line);
 845 }
 846
 847 char *
 848 scannum(s)
 849 register 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;
 857         while (isdigit(*s)) {
 858             *d++ = *s++;
 859         }
 860         if (*s == '.') {
 861             if (isdigit(s[1])) {
 862                 *d++ = *s++;
 863                 while (isdigit(*s)) {
 864                     *d++ = *s++;
 865                 }
 866             }
 867             else
 868                 s++;
 869         }
 870         if (strchr("eE",*s) && strchr("+-0123456789",s[1])) {
 871             *d++ = *s++;
 872             if (*s == '+' || *s == '-')
 873                 *d++ = *s++;
 874             while (isdigit(*s))
 875                 *d++ = *s++;
 876         }
 877         *d = '\0';
 878         yylval = string(tokenbuf,0);
 879         break;
 880     }
 881     return s;
 882 }
 883
 884 int
 885 string(ptr,len)
 886 char *ptr;
 887 int len;
 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';
 897     if (mop >= OPSMAX)
 898         fatal("Recompile a2p with larger OPSMAX\n");
 899     return retval;
 900 }
 901
 902 int
 903 oper0(type)
 904 int type;
 905 {
 906     int retval = mop;
 907
 908     if (type > 255)
 909         fatal("type > 255 (%d)\n",type);
 910     ops[mop++].ival = type;
 911     if (mop >= OPSMAX)
 912         fatal("Recompile a2p with larger OPSMAX\n");
 913     return retval;
 914 }
 915
 916 int
 917 oper1(type,arg1)
 918 int type;
 919 int 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;
 927     if (mop >= OPSMAX)
 928         fatal("Recompile a2p with larger OPSMAX\n");
 929     return retval;
 930 }
 931
 932 int
 933 oper2(type,arg1,arg2)
 934 int type;
 935 int arg1;
 936 int 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;
 945     if (mop >= OPSMAX)
 946         fatal("Recompile a2p with larger OPSMAX\n");
 947     return retval;
 948 }
 949
 950 int
 951 oper3(type,arg1,arg2,arg3)
 952 int type;
 953 int arg1;
 954 int arg2;
 955 int 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;
 965     if (mop >= OPSMAX)
 966         fatal("Recompile a2p with larger OPSMAX\n");
 967     return retval;
 968 }
 969
 970 int
 971 oper4(type,arg1,arg2,arg3,arg4)
 972 int type;
 973 int arg1;
 974 int arg2;
 975 int arg3;
 976 int 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;
 987     if (mop >= OPSMAX)
 988         fatal("Recompile a2p with larger OPSMAX\n");
 989     return retval;
 990 }
 991
 992 int
 993 oper5(type,arg1,arg2,arg3,arg4,arg5)
 994 int type;
 995 int arg1;
 996 int arg2;
 997 int arg3;
 998 int arg4;
 999 int 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;
1011     if (mop >= OPSMAX)
1012         fatal("Recompile a2p with larger OPSMAX\n");
1013     return retval;
1014 }
1015
1016 int depth = 0;
1017
1018 void
1019 dump(branch)
1020 int 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
1046 int
1047 bl(arg,maybe)
1048 int arg;
1049 int maybe;
1050 {
1051     if (!arg)
1052         return 0;
1053     else if ((ops[arg].ival & 255) != OBLOCK)
1054         return oper2(OBLOCK,arg,maybe);
1055     else if ((ops[arg].ival >> 8) < 2)
1056         return oper2(OBLOCK,ops[arg+1].ival,maybe);
1057     else
1058         return arg;
1059 }
1060
1061 void
1062 fixup(str)
1063 STR *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
1087 void
1088 putlines(str)
1089 STR *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) {
1142                 char save[2048];
1143                 strcpy(save, d);
1144                 *d = '\n';
1145                 d[1] = '\0';
1146                 putone();
1147                 putchar('\n');
1148                 if (d[-1] != ';' && !(newpos % 4)) {
1149                     *t++ = ' ';
1150                     *t++ = ' ';
1151                     newpos += 2;
1152                 }
1153                 strcpy(t,save+1);
1154                 newpos += strlen(t);
1155                 d = t + strlen(t);
1156                 pos = newpos;
1157             }
1158             else
1159                 d = e + 1;
1160         }
1161     }
1162 }
1163
1164 void
1165 putone()
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");
1174             checkers++;
1175         }
1176     }
1177     t = tokenbuf;
1178     if (*t == '#') {
1179         if (strnEQ(t,"#!/bin/awk",10) || strnEQ(t,"#! /bin/awk",11))
1180             return;
1181         if (strnEQ(t,"#!/usr/bin/awk",14) || strnEQ(t,"#! /usr/bin/awk",15))
1182             return;
1183     }
1184     fputs(tokenbuf,stdout);
1185 }
1186
1187 int
1188 numary(arg)
1189 int arg;
1190 {
1191     STR *key;
1192     int dummy;
1193
1194     key = walk(0,0,arg,&dummy,P_MIN);
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 }
1201
1202 int
1203 rememberargs(arg)
1204 int 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
1225 int
1226 aryrefarg(arg)
1227 int 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
1240 int
1241 fixfargs(name,arg,prevargs)
1242 int name;
1243 int arg;
1244 int 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",
1275           type,prevargs+1,line);
1276     return numargs;
1277 }
1278
1279 int
1280 fixrargs(name,arg,prevargs)
1281 char *name;
1282 int arg;
1283 int 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);
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 }