x2p/a2py.c

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