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