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