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