x2p/a2py.c

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