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