x2p/a2py.c

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