x2p/a2py.c

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