contrib/perl5/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, version 5.0, patchlevel %d\n", PATCHLEVEL);
  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             XTERM(SPRINTF);
 710         if (strEQ(d,"sqrt")) {
 711             yylval = OSQRT;
 712             XTERM(FUN1);
 713         }
 714         if (strEQ(d,"SUBSEP")) {
 715             d = ";";
 716         }
 717         if (strEQ(d,"sin")) {
 718             yylval = OSIN;
 719             XTERM(FUN1);
 720         }
 721         if (strEQ(d,"srand")) {
 722             yylval = OSRAND;
 723             XTERM(FUN1);
 724         }
 725         if (strEQ(d,"system")) {
 726             yylval = OSYSTEM;
 727             XTERM(FUN1);
 728         }
 729         if (strEQ(d,"s"))
 730             *d = toupper(*d);
 731         else if (strEQ(d,"shift"))
 732             *d = toupper(*d);
 733         else if (strEQ(d,"select"))
 734             *d = toupper(*d);
 735         else if (strEQ(d,"seek"))
 736             *d = toupper(*d);
 737         else if (strEQ(d,"stat"))
 738             *d = toupper(*d);
 739         else if (strEQ(d,"study"))
 740             *d = toupper(*d);
 741         else if (strEQ(d,"sleep"))
 742             *d = toupper(*d);
 743         else if (strEQ(d,"symlink"))
 744             *d = toupper(*d);
 745         else if (strEQ(d,"sort"))
 746             *d = toupper(*d);
 747         ID(d);
 748     case 't': case 'T':
 749         SNARFWORD;
 750         if (strEQ(d,"tr"))
 751             *d = toupper(*d);
 752         else if (strEQ(d,"tell"))
 753             *d = toupper(*d);
 754         else if (strEQ(d,"time"))
 755             *d = toupper(*d);
 756         else if (strEQ(d,"times"))
 757             *d = toupper(*d);
 758         ID(d);
 759     case 'u': case 'U':
 760         SNARFWORD;
 761         if (strEQ(d,"until"))
 762             *d = toupper(*d);
 763         else if (strEQ(d,"unless"))
 764             *d = toupper(*d);
 765         else if (strEQ(d,"umask"))
 766             *d = toupper(*d);
 767         else if (strEQ(d,"unshift"))
 768             *d = toupper(*d);
 769         else if (strEQ(d,"unlink"))
 770             *d = toupper(*d);
 771         else if (strEQ(d,"utime"))
 772             *d = toupper(*d);
 773         ID(d);
 774     case 'v': case 'V':
 775         SNARFWORD;
 776         if (strEQ(d,"values"))
 777             *d = toupper(*d);
 778         ID(d);
 779     case 'w': case 'W':
 780         SNARFWORD;
 781         if (strEQ(d,"while"))
 782             XTERM(WHILE);
 783         if (strEQ(d,"write"))
 784             *d = toupper(*d);
 785         else if (strEQ(d,"wait"))
 786             *d = toupper(*d);
 787         ID(d);
 788     case 'x': case 'X':
 789         SNARFWORD;
 790         if (strEQ(d,"x"))
 791             *d = toupper(*d);
 792         ID(d);
 793     case 'y': case 'Y':
 794         SNARFWORD;
 795         if (strEQ(d,"y"))
 796             *d = toupper(*d);
 797         ID(d);
 798     case 'z': case 'Z':
 799         SNARFWORD;
 800         ID(d);
 801     }
 802 }
 803
 804 char *
 805 scanpat(register char *s)
 806 {
 807     register char *d;
 808
 809     switch (*s++) {
 810     case '/':
 811         break;
 812     default:
 813         fatal("Search pattern not found:\n%s",str_get(linestr));
 814     }
 815
 816     d = tokenbuf;
 817     for (; *s; s++,d++) {
 818         if (*s == '\\') {
 819             if (s[1] == '/')
 820                 *d++ = *s++;
 821             else if (s[1] == '\\')
 822                 *d++ = *s++;
 823             else if (s[1] == '[')
 824                 *d++ = *s++;
 825         }
 826         else if (*s == '[') {
 827             *d++ = *s++;
 828             do {
 829                 if (*s == '\\' && s[1])
 830                     *d++ = *s++;
 831                 if (*s == '/' || (*s == '-' && s[1] == ']'))
 832                     *d++ = '\\';
 833                 *d++ = *s++;
 834             } while (*s && *s != ']');
 835         }
 836         else if (*s == '/')
 837             break;
 838         *d = *s;
 839     }
 840     *d = '\0';
 841
 842     if (!*s)
 843         fatal("Search pattern not terminated:\n%s",str_get(linestr));
 844     s++;
 845     yylval = string(tokenbuf,0);
 846     return s;
 847 }
 848
 849 void
 850 yyerror(char *s)
 851 {
 852     fprintf(stderr,"%s in file %s at line %d\n",
 853       s,filename,line);
 854 }
 855
 856 char *
 857 scannum(register char *s)
 858 {
 859     register char *d;
 860
 861     switch (*s) {
 862     case '1': case '2': case '3': case '4': case '5':
 863     case '6': case '7': case '8': case '9': case '0' : case '.':
 864         d = tokenbuf;
 865         while (isdigit(*s)) {
 866             *d++ = *s++;
 867         }
 868         if (*s == '.') {
 869             if (isdigit(s[1])) {
 870                 *d++ = *s++;
 871                 while (isdigit(*s)) {
 872                     *d++ = *s++;
 873                 }
 874             }
 875             else
 876                 s++;
 877         }
 878         if (strchr("eE",*s) && strchr("+-0123456789",s[1])) {
 879             *d++ = *s++;
 880             if (*s == '+' || *s == '-')
 881                 *d++ = *s++;
 882             while (isdigit(*s))
 883                 *d++ = *s++;
 884         }
 885         *d = '\0';
 886         yylval = string(tokenbuf,0);
 887         break;
 888     }
 889     return s;
 890 }
 891
 892 int
 893 string(char *ptr, int len)
 894 {
 895     int retval = mop;
 896
 897     ops[mop++].ival = OSTRING + (1<<8);
 898     if (!len)
 899         len = strlen(ptr);
 900     ops[mop].cval = (char *) safemalloc(len+1);
 901     strncpy(ops[mop].cval,ptr,len);
 902     ops[mop++].cval[len] = '\0';
 903     if (mop >= OPSMAX)
 904         fatal("Recompile a2p with larger OPSMAX\n");
 905     return retval;
 906 }
 907
 908 int
 909 oper0(int type)
 910 {
 911     int retval = mop;
 912
 913     if (type > 255)
 914         fatal("type > 255 (%d)\n",type);
 915     ops[mop++].ival = type;
 916     if (mop >= OPSMAX)
 917         fatal("Recompile a2p with larger OPSMAX\n");
 918     return retval;
 919 }
 920
 921 int
 922 oper1(int type, int arg1)
 923 {
 924     int retval = mop;
 925
 926     if (type > 255)
 927         fatal("type > 255 (%d)\n",type);
 928     ops[mop++].ival = type + (1<<8);
 929     ops[mop++].ival = arg1;
 930     if (mop >= OPSMAX)
 931         fatal("Recompile a2p with larger OPSMAX\n");
 932     return retval;
 933 }
 934
 935 int
 936 oper2(int type, int arg1, int arg2)
 937 {
 938     int retval = mop;
 939
 940     if (type > 255)
 941         fatal("type > 255 (%d)\n",type);
 942     ops[mop++].ival = type + (2<<8);
 943     ops[mop++].ival = arg1;
 944     ops[mop++].ival = arg2;
 945     if (mop >= OPSMAX)
 946         fatal("Recompile a2p with larger OPSMAX\n");
 947     return retval;
 948 }
 949
 950 int
 951 oper3(int type, int arg1, int arg2, int arg3)
 952 {
 953     int retval = mop;
 954
 955     if (type > 255)
 956         fatal("type > 255 (%d)\n",type);
 957     ops[mop++].ival = type + (3<<8);
 958     ops[mop++].ival = arg1;
 959     ops[mop++].ival = arg2;
 960     ops[mop++].ival = arg3;
 961     if (mop >= OPSMAX)
 962         fatal("Recompile a2p with larger OPSMAX\n");
 963     return retval;
 964 }
 965
 966 int
 967 oper4(int type, int arg1, int arg2, int arg3, int arg4)
 968 {
 969     int retval = mop;
 970
 971     if (type > 255)
 972         fatal("type > 255 (%d)\n",type);
 973     ops[mop++].ival = type + (4<<8);
 974     ops[mop++].ival = arg1;
 975     ops[mop++].ival = arg2;
 976     ops[mop++].ival = arg3;
 977     ops[mop++].ival = arg4;
 978     if (mop >= OPSMAX)
 979         fatal("Recompile a2p with larger OPSMAX\n");
 980     return retval;
 981 }
 982
 983 int
 984 oper5(int type, int arg1, int arg2, int arg3, int arg4, int arg5)
 985 {
 986     int retval = mop;
 987
 988     if (type > 255)
 989         fatal("type > 255 (%d)\n",type);
 990     ops[mop++].ival = type + (5<<8);
 991     ops[mop++].ival = arg1;
 992     ops[mop++].ival = arg2;
 993     ops[mop++].ival = arg3;
 994     ops[mop++].ival = arg4;
 995     ops[mop++].ival = arg5;
 996     if (mop >= OPSMAX)
 997         fatal("Recompile a2p with larger OPSMAX\n");
 998     return retval;
 999 }
1000
1001 int depth = 0;
1002
1003 void
1004 dump(int branch)
1005 {
1006     register int type;
1007     register int len;
1008     register int i;
1009
1010     type = ops[branch].ival;
1011     len = type >> 8;
1012     type &= 255;
1013     for (i=depth; i; i--)
1014         printf(" ");
1015     if (type == OSTRING) {
1016         printf("%-5d\"%s\"\n",branch,ops[branch+1].cval);
1017     }
1018     else {
1019         printf("(%-5d%s %d\n",branch,opname[type],len);
1020         depth++;
1021         for (i=1; i<=len; i++)
1022             dump(ops[branch+i].ival);
1023         depth--;
1024         for (i=depth; i; i--)
1025             printf(" ");
1026         printf(")\n");
1027     }
1028 }
1029
1030 int
1031 bl(int arg, int maybe)
1032 {
1033     if (!arg)
1034         return 0;
1035     else if ((ops[arg].ival & 255) != OBLOCK)
1036         return oper2(OBLOCK,arg,maybe);
1037     else if ((ops[arg].ival >> 8) < 2)
1038         return oper2(OBLOCK,ops[arg+1].ival,maybe);
1039     else
1040         return arg;
1041 }
1042
1043 void
1044 fixup(STR *str)
1045 {
1046     register char *s;
1047     register char *t;
1048
1049     for (s = str->str_ptr; *s; s++) {
1050         if (*s == ';' && s[1] == ' ' && s[2] == '\n') {
1051             strcpy(s+1,s+2);
1052             s++;
1053         }
1054         else if (*s == '\n') {
1055             for (t = s+1; isspace(*t & 127); t++) ;
1056             t--;
1057             while (isspace(*t & 127) && *t != '\n') t--;
1058             if (*t == '\n' && t-s > 1) {
1059                 if (s[-1] == '{')
1060                     s--;
1061                 strcpy(s+1,t);
1062             }
1063             s++;
1064         }
1065     }
1066 }
1067
1068 void
1069 putlines(STR *str)
1070 {
1071     register char *d, *s, *t, *e;
1072     register int pos, newpos;
1073
1074     d = tokenbuf;
1075     pos = 0;
1076     for (s = str->str_ptr; *s; s++) {
1077         *d++ = *s;
1078         pos++;
1079         if (*s == '\n') {
1080             *d = '\0';
1081             d = tokenbuf;
1082             pos = 0;
1083             putone();
1084         }
1085         else if (*s == '\t')
1086             pos += 7;
1087         if (pos > 78) {         /* split a long line? */
1088             *d-- = '\0';
1089             newpos = 0;
1090             for (t = tokenbuf; isspace(*t & 127); t++) {
1091                 if (*t == '\t')
1092                     newpos += 8;
1093                 else
1094                     newpos += 1;
1095             }
1096             e = d;
1097             while (d > tokenbuf && (*d != ' ' || d[-1] != ';'))
1098                 d--;
1099             if (d < t+10) {
1100                 d = e;
1101                 while (d > tokenbuf &&
1102                   (*d != ' ' || d[-1] != '|' || d[-2] != '|') )
1103                     d--;
1104             }
1105             if (d < t+10) {
1106                 d = e;
1107                 while (d > tokenbuf &&
1108                   (*d != ' ' || d[-1] != '&' || d[-2] != '&') )
1109                     d--;
1110             }
1111             if (d < t+10) {
1112                 d = e;
1113                 while (d > tokenbuf && (*d != ' ' || d[-1] != ','))
1114                     d--;
1115             }
1116             if (d < t+10) {
1117                 d = e;
1118                 while (d > tokenbuf && *d != ' ')
1119                     d--;
1120             }
1121             if (d > t+3) {
1122                 char save[2048];
1123                 strcpy(save, d);
1124                 *d = '\n';
1125                 d[1] = '\0';
1126                 putone();
1127                 putchar('\n');
1128                 if (d[-1] != ';' && !(newpos % 4)) {
1129                     *t++ = ' ';
1130                     *t++ = ' ';
1131                     newpos += 2;
1132                 }
1133                 strcpy(t,save+1);
1134                 newpos += strlen(t);
1135                 d = t + strlen(t);
1136                 pos = newpos;
1137             }
1138             else
1139                 d = e + 1;
1140         }
1141     }
1142 }
1143
1144 void
1145 putone(void)
1146 {
1147     register char *t;
1148
1149     for (t = tokenbuf; *t; t++) {
1150         *t &= 127;
1151         if (*t == 127) {
1152             *t = ' ';
1153             strcpy(t+strlen(t)-1, "\t#???\n");
1154             checkers++;
1155         }
1156     }
1157     t = tokenbuf;
1158     if (*t == '#') {
1159         if (strnEQ(t,"#!/bin/awk",10) || strnEQ(t,"#! /bin/awk",11))
1160             return;
1161         if (strnEQ(t,"#!/usr/bin/awk",14) || strnEQ(t,"#! /usr/bin/awk",15))
1162             return;
1163     }
1164     fputs(tokenbuf,stdout);
1165 }
1166
1167 int
1168 numary(int arg)
1169 {
1170     STR *key;
1171     int dummy;
1172
1173     key = walk(0,0,arg,&dummy,P_MIN);
1174     str_cat(key,"[]");
1175     hstore(symtab,key->str_ptr,str_make("1"));
1176     str_free(key);
1177     set_array_base = TRUE;
1178     return arg;
1179 }
1180
1181 int
1182 rememberargs(int arg)
1183 {
1184     int type;
1185     STR *str;
1186
1187     if (!arg)
1188         return arg;
1189     type = ops[arg].ival & 255;
1190     if (type == OCOMMA) {
1191         rememberargs(ops[arg+1].ival);
1192         rememberargs(ops[arg+3].ival);
1193     }
1194     else if (type == OVAR) {
1195         str = str_new(0);
1196         hstore(curarghash,ops[ops[arg+1].ival+1].cval,str);
1197     }
1198     else
1199         fatal("panic: unknown argument type %d, line %d\n",type,line);
1200     return arg;
1201 }
1202
1203 int
1204 aryrefarg(int arg)
1205 {
1206     int type = ops[arg].ival & 255;
1207     STR *str;
1208
1209     if (type != OSTRING)
1210         fatal("panic: aryrefarg %d, line %d\n",type,line);
1211     str = hfetch(curarghash,ops[arg+1].cval);
1212     if (str)
1213         str_set(str,"*");
1214     return arg;
1215 }
1216
1217 int
1218 fixfargs(int name, int arg, int prevargs)
1219 {
1220     int type;
1221     STR *str;
1222     int numargs;
1223
1224     if (!arg)
1225         return prevargs;
1226     type = ops[arg].ival & 255;
1227     if (type == OCOMMA) {
1228         numargs = fixfargs(name,ops[arg+1].ival,prevargs);
1229         numargs = fixfargs(name,ops[arg+3].ival,numargs);
1230     }
1231     else if (type == OVAR) {
1232         str = hfetch(curarghash,ops[ops[arg+1].ival+1].cval);
1233         if (strEQ(str_get(str),"*")) {
1234             char tmpbuf[128];
1235
1236             str_set(str,"");            /* in case another routine has this */
1237             ops[arg].ival &= ~255;
1238             ops[arg].ival |= OSTAR;
1239             sprintf(tmpbuf,"%s:%d",ops[name+1].cval,prevargs);
1240             fprintf(stderr,"Adding %s\n",tmpbuf);
1241             str = str_new(0);
1242             str_set(str,"*");
1243             hstore(curarghash,tmpbuf,str);
1244         }
1245         numargs = prevargs + 1;
1246     }
1247     else
1248         fatal("panic: unknown argument type %d, arg %d, line %d\n",
1249           type,prevargs+1,line);
1250     return numargs;
1251 }
1252
1253 int
1254 fixrargs(char *name, int arg, int prevargs)
1255 {
1256     int type;
1257     STR *str;
1258     int numargs;
1259
1260     if (!arg)
1261         return prevargs;
1262     type = ops[arg].ival & 255;
1263     if (type == OCOMMA) {
1264         numargs = fixrargs(name,ops[arg+1].ival,prevargs);
1265         numargs = fixrargs(name,ops[arg+3].ival,numargs);
1266     }
1267     else {
1268         char *tmpbuf = (char *) safemalloc(strlen(name) + (sizeof(prevargs) * 3) + 5);
1269         sprintf(tmpbuf,"%s:%d",name,prevargs);
1270         str = hfetch(curarghash,tmpbuf);
1271         safefree(tmpbuf);
1272         if (str && strEQ(str->str_ptr,"*")) {
1273             if (type == OVAR || type == OSTAR) {
1274                 ops[arg].ival &= ~255;
1275                 ops[arg].ival |= OSTAR;
1276             }
1277             else
1278                 fatal("Can't pass expression by reference as arg %d of %s\n",
1279                     prevargs+1, name);
1280         }
1281         numargs = prevargs + 1;
1282     }
1283     return numargs;
1284 }