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