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