x2p/a2py.c

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