x2p/a2py.c

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