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