x2p/a2py.c

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