x2p/a2py.c

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