x2p/a2py.c

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