perly.c

   1 char rcsid[] = "$Header: perly.c,v 1.0.1.2 88/01/24 00:06:03 root Exp $";
   2 /*
   3  * $Log:        perly.c,v $
   4  * Revision 1.0.1.2  88/01/24  00:06:03  root
   5  * patch 2: s/(abc)/\1/ grandfathering didn't work right.
   6  *
   7  * Revision 1.0.1.1  88/01/21  21:25:57  root
   8  * Now uses CPP and CPPMINUS symbols from config.h.
   9  *
  10  * Revision 1.0  87/12/18  15:53:31  root
  11  * Initial revision
  12  *
  13  */
  14
  15 bool preprocess = FALSE;
  16 bool assume_n = FALSE;
  17 bool assume_p = FALSE;
  18 bool doswitches = FALSE;
  19 char *filename;
  20 char *e_tmpname = "/tmp/perl-eXXXXXX";
  21 FILE *e_fp = Nullfp;
  22 ARG *l();
  23
  24 main(argc,argv,env)
  25 register int argc;
  26 register char **argv;
  27 register char **env;
  28 {
  29     register STR *str;
  30     register char *s;
  31     char *index();
  32
  33     linestr = str_new(80);
  34     str = str_make("-I/usr/lib/perl "); /* first used for -I flags */
  35     for (argc--,argv++; argc; argc--,argv++) {
  36         if (argv[0][0] != '-' || !argv[0][1])
  37             break;
  38       reswitch:
  39         switch (argv[0][1]) {
  40 #ifdef DEBUGGING
  41         case 'D':
  42             debug = atoi(argv[0]+2);
  43 #ifdef YYDEBUG
  44             yydebug = (debug & 1);
  45 #endif
  46             break;
  47 #endif
  48         case 'e':
  49             if (!e_fp) {
  50                 mktemp(e_tmpname);
  51                 e_fp = fopen(e_tmpname,"w");
  52             }
  53             if (argv[1])
  54                 fputs(argv[1],e_fp);
  55             putc('\n', e_fp);
  56             argc--,argv++;
  57             break;
  58         case 'i':
  59             inplace = savestr(argv[0]+2);
  60             argvoutstab = stabent("ARGVOUT",TRUE);
  61             break;
  62         case 'I':
  63             str_cat(str,argv[0]);
  64             str_cat(str," ");
  65             if (!argv[0][2]) {
  66                 str_cat(str,argv[1]);
  67                 argc--,argv++;
  68                 str_cat(str," ");
  69             }
  70             break;
  71         case 'n':
  72             assume_n = TRUE;
  73             strcpy(argv[0], argv[0]+1);
  74             goto reswitch;
  75         case 'p':
  76             assume_p = TRUE;
  77             strcpy(argv[0], argv[0]+1);
  78             goto reswitch;
  79         case 'P':
  80             preprocess = TRUE;
  81             strcpy(argv[0], argv[0]+1);
  82             goto reswitch;
  83         case 's':
  84             doswitches = TRUE;
  85             strcpy(argv[0], argv[0]+1);
  86             goto reswitch;
  87         case 'v':
  88             version();
  89             exit(0);
  90         case '-':
  91             argc--,argv++;
  92             goto switch_end;
  93         case 0:
  94             break;
  95         default:
  96             fatal("Unrecognized switch: %s\n",argv[0]);
  97         }
  98     }
  99   switch_end:
 100     if (e_fp) {
 101         fclose(e_fp);
 102         argc++,argv--;
 103         argv[0] = e_tmpname;
 104     }
 105
 106     str_set(&str_no,No);
 107     str_set(&str_yes,Yes);
 108     init_eval();
 109
 110     /* open script */
 111
 112     if (argv[0] == Nullch)
 113         argv[0] = "-";
 114     filename = savestr(argv[0]);
 115     if (strEQ(filename,"-"))
 116         argv[0] = "";
 117     if (preprocess) {
 118         sprintf(buf, "\
 119 /bin/sed -e '/^[^#]/b' \
 120  -e '/^#[       ]*include[      ]/b' \
 121  -e '/^#[       ]*define[       ]/b' \
 122  -e '/^#[       ]*if[   ]/b' \
 123  -e '/^#[       ]*ifdef[        ]/b' \
 124  -e '/^#[       ]*else/b' \
 125  -e '/^#[       ]*endif/b' \
 126  -e 's/^#.*//' \
 127  %s | %s -C %s%s",
 128           argv[0], CPP, str_get(str), CPPMINUS);
 129         rsfp = popen(buf,"r");
 130     }
 131     else if (!*argv[0])
 132         rsfp = stdin;
 133     else
 134         rsfp = fopen(argv[0],"r");
 135     if (rsfp == Nullfp)
 136         fatal("Perl script \"%s\" doesn't seem to exist.\n",filename);
 137     str_free(str);              /* free -I directories */
 138
 139     defstab = stabent("_",TRUE);
 140
 141     /* init tokener */
 142
 143     bufptr = str_get(linestr);
 144
 145     /* now parse the report spec */
 146
 147     if (yyparse())
 148         fatal("Execution aborted due to compilation errors.\n");
 149
 150     if (e_fp) {
 151         e_fp = Nullfp;
 152         UNLINK(e_tmpname);
 153     }
 154     argc--,argv++;      /* skip name of script */
 155     if (doswitches) {
 156         for (; argc > 0 && **argv == '-'; argc--,argv++) {
 157             if (argv[0][1] == '-') {
 158                 argc--,argv++;
 159                 break;
 160             }
 161             str_numset(stabent(argv[0]+1,TRUE)->stab_val,(double)1.0);
 162         }
 163     }
 164     if (argvstab = stabent("ARGV",FALSE)) {
 165         for (; argc > 0; argc--,argv++) {
 166             apush(argvstab->stab_array,str_make(argv[0]));
 167         }
 168     }
 169     if (envstab = stabent("ENV",FALSE)) {
 170         for (; *env; env++) {
 171             if (!(s = index(*env,'=')))
 172                 continue;
 173             *s++ = '\0';
 174             str = str_make(s);
 175             str->str_link.str_magic = envstab;
 176             hstore(envstab->stab_hash,*env,str);
 177             *--s = '=';
 178         }
 179     }
 180     sigstab = stabent("SIG",FALSE);
 181
 182     magicalize("!#?^~=-%0123456789.+&*(),\\/[|");
 183
 184     (tmpstab = stabent("0",FALSE)) && str_set(STAB_STR(tmpstab),filename);
 185     (tmpstab = stabent("$",FALSE)) &&
 186         str_numset(STAB_STR(tmpstab),(double)getpid());
 187
 188     tmpstab = stabent("stdin",TRUE);
 189     tmpstab->stab_io = stio_new();
 190     tmpstab->stab_io->fp = stdin;
 191
 192     tmpstab = stabent("stdout",TRUE);
 193     tmpstab->stab_io = stio_new();
 194     tmpstab->stab_io->fp = stdout;
 195     defoutstab = tmpstab;
 196     curoutstab = tmpstab;
 197
 198     tmpstab = stabent("stderr",TRUE);
 199     tmpstab->stab_io = stio_new();
 200     tmpstab->stab_io->fp = stderr;
 201
 202     setjmp(top_env);    /* sets goto_targ on longjump */
 203
 204 #ifdef DEBUGGING
 205     if (debug & 1024)
 206         dump_cmd(main_root,Nullcmd);
 207     if (debug)
 208         fprintf(stderr,"\nEXECUTING...\n\n");
 209 #endif
 210
 211     /* do it */
 212
 213     (void) cmd_exec(main_root);
 214
 215     if (goto_targ)
 216         fatal("Can't find label \"%s\"--aborting.\n",goto_targ);
 217     exit(0);
 218 }
 219
 220 magicalize(list)
 221 register char *list;
 222 {
 223     register STAB *stab;
 224     char sym[2];
 225
 226     sym[1] = '\0';
 227     while (*sym = *list++) {
 228         if (stab = stabent(sym,FALSE)) {
 229             stab->stab_flags = SF_VMAGIC;
 230             stab->stab_val->str_link.str_magic = stab;
 231         }
 232     }
 233 }
 234
 235 #define RETURN(retval) return (bufptr = s,retval)
 236 #define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,retval)
 237 #define TERM(retval) return (expectterm = FALSE,bufptr = s,retval)
 238 #define LOOPX(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,LOOPEX)
 239 #define UNI(f) return (yylval.ival = f,expectterm = TRUE,bufptr = s,UNIOP)
 240 #define FUN0(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC0)
 241 #define FUN1(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC1)
 242 #define FUN2(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC2)
 243 #define FUN3(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,FUNC3)
 244 #define SFUN(f) return (yylval.ival = f,expectterm = FALSE,bufptr = s,STABFUN)
 245
 246 yylex()
 247 {
 248     register char *s = bufptr;
 249     register char *d;
 250     register int tmp;
 251     static bool in_format = FALSE;
 252     static bool firstline = TRUE;
 253
 254   retry:
 255 #ifdef YYDEBUG
 256     if (yydebug)
 257         if (index(s,'\n'))
 258             fprintf(stderr,"Tokener at %s",s);
 259         else
 260             fprintf(stderr,"Tokener at %s\n",s);
 261 #endif
 262     switch (*s) {
 263     default:
 264         fprintf(stderr,
 265             "Unrecognized character %c in file %s line %d--ignoring.\n",
 266              *s++,filename,line);
 267         goto retry;
 268     case 0:
 269         s = str_get(linestr);
 270         *s = '\0';
 271         if (firstline && (assume_n || assume_p)) {
 272             firstline = FALSE;
 273             str_set(linestr,"while (<>) {");
 274             s = str_get(linestr);
 275             goto retry;
 276         }
 277         if (!rsfp)
 278             RETURN(0);
 279         if (in_format) {
 280             yylval.formval = load_format();     /* leaves . in buffer */
 281             in_format = FALSE;
 282             s = str_get(linestr);
 283             TERM(FORMLIST);
 284         }
 285         line++;
 286         if ((s = str_gets(linestr, rsfp)) == Nullch) {
 287             if (preprocess)
 288                 pclose(rsfp);
 289             else if (rsfp != stdin)
 290                 fclose(rsfp);
 291             rsfp = Nullfp;
 292             if (assume_n || assume_p) {
 293                 str_set(linestr,assume_p ? "}continue{print;" : "");
 294                 str_cat(linestr,"}");
 295                 s = str_get(linestr);
 296                 goto retry;
 297             }
 298             s = str_get(linestr);
 299             RETURN(0);
 300         }
 301 #ifdef DEBUG
 302         else if (firstline) {
 303             char *showinput();
 304             s = showinput();
 305         }
 306 #endif
 307         firstline = FALSE;
 308         goto retry;
 309     case ' ': case '\t':
 310         s++;
 311         goto retry;
 312     case '\n':
 313     case '#':
 314         if (preprocess && s == str_get(linestr) &&
 315                s[1] == ' ' && isdigit(s[2])) {
 316             line = atoi(s+2)-1;
 317             for (s += 2; isdigit(*s); s++) ;
 318             while (*s && isspace(*s)) s++;
 319             if (filename)
 320                 safefree(filename);
 321             s[strlen(s)-1] = '\0';      /* wipe out newline */
 322             filename = savestr(s);
 323             s = str_get(linestr);
 324         }
 325         *s = '\0';
 326         if (lex_newlines)
 327             RETURN('\n');
 328         goto retry;
 329     case '+':
 330     case '-':
 331         if (s[1] == *s) {
 332             s++;
 333             if (*s++ == '+')
 334                 RETURN(INC);
 335             else
 336                 RETURN(DEC);
 337         }
 338         /* FALL THROUGH */
 339     case '*':
 340     case '%':
 341     case '^':
 342     case '~':
 343     case '(':
 344     case ',':
 345     case ':':
 346     case ';':
 347     case '{':
 348     case '[':
 349         tmp = *s++;
 350         OPERATOR(tmp);
 351     case ')':
 352     case ']':
 353     case '}':
 354         tmp = *s++;
 355         TERM(tmp);
 356     case '&':
 357         s++;
 358         tmp = *s++;
 359         if (tmp == '&')
 360             OPERATOR(ANDAND);
 361         s--;
 362         OPERATOR('&');
 363     case '|':
 364         s++;
 365         tmp = *s++;
 366         if (tmp == '|')
 367             OPERATOR(OROR);
 368         s--;
 369         OPERATOR('|');
 370     case '=':
 371         s++;
 372         tmp = *s++;
 373         if (tmp == '=')
 374             OPERATOR(EQ);
 375         if (tmp == '~')
 376             OPERATOR(MATCH);
 377         s--;
 378         OPERATOR('=');
 379     case '!':
 380         s++;
 381         tmp = *s++;
 382         if (tmp == '=')
 383             OPERATOR(NE);
 384         if (tmp == '~')
 385             OPERATOR(NMATCH);
 386         s--;
 387         OPERATOR('!');
 388     case '<':
 389         if (expectterm) {
 390             s = scanstr(s);
 391             TERM(RSTRING);
 392         }
 393         s++;
 394         tmp = *s++;
 395         if (tmp == '<')
 396             OPERATOR(LS);
 397         if (tmp == '=')
 398             OPERATOR(LE);
 399         s--;
 400         OPERATOR('<');
 401     case '>':
 402         s++;
 403         tmp = *s++;
 404         if (tmp == '>')
 405             OPERATOR(RS);
 406         if (tmp == '=')
 407             OPERATOR(GE);
 408         s--;
 409         OPERATOR('>');
 410
 411 #define SNARFWORD \
 412         d = tokenbuf; \
 413         while (isalpha(*s) || isdigit(*s) || *s == '_') \
 414             *d++ = *s++; \
 415         *d = '\0'; \
 416         d = tokenbuf;
 417
 418     case '$':
 419         if (s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) {
 420             s++;
 421             s = scanreg(s,tokenbuf);
 422             yylval.stabval = aadd(stabent(tokenbuf,TRUE));
 423             TERM(ARYLEN);
 424         }
 425         s = scanreg(s,tokenbuf);
 426         yylval.stabval = stabent(tokenbuf,TRUE);
 427         TERM(REG);
 428
 429     case '@':
 430         s = scanreg(s,tokenbuf);
 431         yylval.stabval = aadd(stabent(tokenbuf,TRUE));
 432         TERM(ARY);
 433
 434     case '/':                   /* may either be division or pattern */
 435     case '?':                   /* may either be conditional or pattern */
 436         if (expectterm) {
 437             s = scanpat(s);
 438             TERM(PATTERN);
 439         }
 440         tmp = *s++;
 441         OPERATOR(tmp);
 442
 443     case '.':
 444         if (!expectterm || !isdigit(s[1])) {
 445             s++;
 446             tmp = *s++;
 447             if (tmp == '.')
 448                 OPERATOR(DOTDOT);
 449             s--;
 450             OPERATOR('.');
 451         }
 452         /* FALL THROUGH */
 453     case '0': case '1': case '2': case '3': case '4':
 454     case '5': case '6': case '7': case '8': case '9':
 455     case '\'': case '"': case '`':
 456         s = scanstr(s);
 457         TERM(RSTRING);
 458
 459     case '_':
 460         SNARFWORD;
 461         yylval.cval = savestr(d);
 462         OPERATOR(WORD);
 463     case 'a': case 'A':
 464         SNARFWORD;
 465         yylval.cval = savestr(d);
 466         OPERATOR(WORD);
 467     case 'b': case 'B':
 468         SNARFWORD;
 469         yylval.cval = savestr(d);
 470         OPERATOR(WORD);
 471     case 'c': case 'C':
 472         SNARFWORD;
 473         if (strEQ(d,"continue"))
 474             OPERATOR(CONTINUE);
 475         if (strEQ(d,"chdir"))
 476             UNI(O_CHDIR);
 477         if (strEQ(d,"close"))
 478             OPERATOR(CLOSE);
 479         if (strEQ(d,"crypt"))
 480             FUN2(O_CRYPT);
 481         if (strEQ(d,"chop"))
 482             OPERATOR(CHOP);
 483         if (strEQ(d,"chmod")) {
 484             yylval.ival = O_CHMOD;
 485             OPERATOR(PRINT);
 486         }
 487         if (strEQ(d,"chown")) {
 488             yylval.ival = O_CHOWN;
 489             OPERATOR(PRINT);
 490         }
 491         yylval.cval = savestr(d);
 492         OPERATOR(WORD);
 493     case 'd': case 'D':
 494         SNARFWORD;
 495         if (strEQ(d,"do"))
 496             OPERATOR(DO);
 497         if (strEQ(d,"die"))
 498             UNI(O_DIE);
 499         yylval.cval = savestr(d);
 500         OPERATOR(WORD);
 501     case 'e': case 'E':
 502         SNARFWORD;
 503         if (strEQ(d,"else"))
 504             OPERATOR(ELSE);
 505         if (strEQ(d,"elsif"))
 506             OPERATOR(ELSIF);
 507         if (strEQ(d,"eq") || strEQ(d,"EQ"))
 508             OPERATOR(SEQ);
 509         if (strEQ(d,"exit"))
 510             UNI(O_EXIT);
 511         if (strEQ(d,"eof"))
 512             TERM(FEOF);
 513         if (strEQ(d,"exp"))
 514             FUN1(O_EXP);
 515         if (strEQ(d,"each"))
 516             SFUN(O_EACH);
 517         if (strEQ(d,"exec")) {
 518             yylval.ival = O_EXEC;
 519             OPERATOR(PRINT);
 520         }
 521         yylval.cval = savestr(d);
 522         OPERATOR(WORD);
 523     case 'f': case 'F':
 524         SNARFWORD;
 525         if (strEQ(d,"for"))
 526             OPERATOR(FOR);
 527         if (strEQ(d,"format")) {
 528             in_format = TRUE;
 529             OPERATOR(FORMAT);
 530         }
 531         if (strEQ(d,"fork"))
 532             FUN0(O_FORK);
 533         yylval.cval = savestr(d);
 534         OPERATOR(WORD);
 535     case 'g': case 'G':
 536         SNARFWORD;
 537         if (strEQ(d,"gt") || strEQ(d,"GT"))
 538             OPERATOR(SGT);
 539         if (strEQ(d,"ge") || strEQ(d,"GE"))
 540             OPERATOR(SGE);
 541         if (strEQ(d,"goto"))
 542             LOOPX(O_GOTO);
 543         if (strEQ(d,"gmtime"))
 544             FUN1(O_GMTIME);
 545         yylval.cval = savestr(d);
 546         OPERATOR(WORD);
 547     case 'h': case 'H':
 548         SNARFWORD;
 549         if (strEQ(d,"hex"))
 550             FUN1(O_HEX);
 551         yylval.cval = savestr(d);
 552         OPERATOR(WORD);
 553     case 'i': case 'I':
 554         SNARFWORD;
 555         if (strEQ(d,"if"))
 556             OPERATOR(IF);
 557         if (strEQ(d,"index"))
 558             FUN2(O_INDEX);
 559         if (strEQ(d,"int"))
 560             FUN1(O_INT);
 561         yylval.cval = savestr(d);
 562         OPERATOR(WORD);
 563     case 'j': case 'J':
 564         SNARFWORD;
 565         if (strEQ(d,"join"))
 566             OPERATOR(JOIN);
 567         yylval.cval = savestr(d);
 568         OPERATOR(WORD);
 569     case 'k': case 'K':
 570         SNARFWORD;
 571         if (strEQ(d,"keys"))
 572             SFUN(O_KEYS);
 573         if (strEQ(d,"kill")) {
 574             yylval.ival = O_KILL;
 575             OPERATOR(PRINT);
 576         }
 577         yylval.cval = savestr(d);
 578         OPERATOR(WORD);
 579     case 'l': case 'L':
 580         SNARFWORD;
 581         if (strEQ(d,"last"))
 582             LOOPX(O_LAST);
 583         if (strEQ(d,"length"))
 584             FUN1(O_LENGTH);
 585         if (strEQ(d,"lt") || strEQ(d,"LT"))
 586             OPERATOR(SLT);
 587         if (strEQ(d,"le") || strEQ(d,"LE"))
 588             OPERATOR(SLE);
 589         if (strEQ(d,"localtime"))
 590             FUN1(O_LOCALTIME);
 591         if (strEQ(d,"log"))
 592             FUN1(O_LOG);
 593         if (strEQ(d,"link"))
 594             FUN2(O_LINK);
 595         yylval.cval = savestr(d);
 596         OPERATOR(WORD);
 597     case 'm': case 'M':
 598         SNARFWORD;
 599         if (strEQ(d,"m")) {
 600             s = scanpat(s-1);
 601             TERM(PATTERN);
 602         }
 603         yylval.cval = savestr(d);
 604         OPERATOR(WORD);
 605     case 'n': case 'N':
 606         SNARFWORD;
 607         if (strEQ(d,"next"))
 608             LOOPX(O_NEXT);
 609         if (strEQ(d,"ne") || strEQ(d,"NE"))
 610             OPERATOR(SNE);
 611         yylval.cval = savestr(d);
 612         OPERATOR(WORD);
 613     case 'o': case 'O':
 614         SNARFWORD;
 615         if (strEQ(d,"open"))
 616             OPERATOR(OPEN);
 617         if (strEQ(d,"ord"))
 618             FUN1(O_ORD);
 619         if (strEQ(d,"oct"))
 620             FUN1(O_OCT);
 621         yylval.cval = savestr(d);
 622         OPERATOR(WORD);
 623     case 'p': case 'P':
 624         SNARFWORD;
 625         if (strEQ(d,"print")) {
 626             yylval.ival = O_PRINT;
 627             OPERATOR(PRINT);
 628         }
 629         if (strEQ(d,"printf")) {
 630             yylval.ival = O_PRTF;
 631             OPERATOR(PRINT);
 632         }
 633         if (strEQ(d,"push")) {
 634             yylval.ival = O_PUSH;
 635             OPERATOR(PUSH);
 636         }
 637         if (strEQ(d,"pop"))
 638             OPERATOR(POP);
 639         yylval.cval = savestr(d);
 640         OPERATOR(WORD);
 641     case 'q': case 'Q':
 642         SNARFWORD;
 643         yylval.cval = savestr(d);
 644         OPERATOR(WORD);
 645     case 'r': case 'R':
 646         SNARFWORD;
 647         if (strEQ(d,"reset"))
 648             UNI(O_RESET);
 649         if (strEQ(d,"redo"))
 650             LOOPX(O_REDO);
 651         if (strEQ(d,"rename"))
 652             FUN2(O_RENAME);
 653         yylval.cval = savestr(d);
 654         OPERATOR(WORD);
 655     case 's': case 'S':
 656         SNARFWORD;
 657         if (strEQ(d,"s")) {
 658             s = scansubst(s);
 659             TERM(SUBST);
 660         }
 661         if (strEQ(d,"shift"))
 662             TERM(SHIFT);
 663         if (strEQ(d,"split"))
 664             TERM(SPLIT);
 665         if (strEQ(d,"substr"))
 666             FUN3(O_SUBSTR);
 667         if (strEQ(d,"sprintf"))
 668             OPERATOR(SPRINTF);
 669         if (strEQ(d,"sub"))
 670             OPERATOR(SUB);
 671         if (strEQ(d,"select"))
 672             OPERATOR(SELECT);
 673         if (strEQ(d,"seek"))
 674             OPERATOR(SEEK);
 675         if (strEQ(d,"stat"))
 676             OPERATOR(STAT);
 677         if (strEQ(d,"sqrt"))
 678             FUN1(O_SQRT);
 679         if (strEQ(d,"sleep"))
 680             UNI(O_SLEEP);
 681         if (strEQ(d,"system")) {
 682             yylval.ival = O_SYSTEM;
 683             OPERATOR(PRINT);
 684         }
 685         yylval.cval = savestr(d);
 686         OPERATOR(WORD);
 687     case 't': case 'T':
 688         SNARFWORD;
 689         if (strEQ(d,"tr")) {
 690             s = scantrans(s);
 691             TERM(TRANS);
 692         }
 693         if (strEQ(d,"tell"))
 694             TERM(TELL);
 695         if (strEQ(d,"time"))
 696             FUN0(O_TIME);
 697         if (strEQ(d,"times"))
 698             FUN0(O_TMS);
 699         yylval.cval = savestr(d);
 700         OPERATOR(WORD);
 701     case 'u': case 'U':
 702         SNARFWORD;
 703         if (strEQ(d,"using"))
 704             OPERATOR(USING);
 705         if (strEQ(d,"until"))
 706             OPERATOR(UNTIL);
 707         if (strEQ(d,"unless"))
 708             OPERATOR(UNLESS);
 709         if (strEQ(d,"umask"))
 710             FUN1(O_UMASK);
 711         if (strEQ(d,"unshift")) {
 712             yylval.ival = O_UNSHIFT;
 713             OPERATOR(PUSH);
 714         }
 715         if (strEQ(d,"unlink")) {
 716             yylval.ival = O_UNLINK;
 717             OPERATOR(PRINT);
 718         }
 719         yylval.cval = savestr(d);
 720         OPERATOR(WORD);
 721     case 'v': case 'V':
 722         SNARFWORD;
 723         if (strEQ(d,"values"))
 724             SFUN(O_VALUES);
 725         yylval.cval = savestr(d);
 726         OPERATOR(WORD);
 727     case 'w': case 'W':
 728         SNARFWORD;
 729         if (strEQ(d,"write"))
 730             TERM(WRITE);
 731         if (strEQ(d,"while"))
 732             OPERATOR(WHILE);
 733         yylval.cval = savestr(d);
 734         OPERATOR(WORD);
 735     case 'x': case 'X':
 736         SNARFWORD;
 737         if (!expectterm && strEQ(d,"x"))
 738             OPERATOR('x');
 739         yylval.cval = savestr(d);
 740         OPERATOR(WORD);
 741     case 'y': case 'Y':
 742         SNARFWORD;
 743         if (strEQ(d,"y")) {
 744             s = scantrans(s);
 745             TERM(TRANS);
 746         }
 747         yylval.cval = savestr(d);
 748         OPERATOR(WORD);
 749     case 'z': case 'Z':
 750         SNARFWORD;
 751         yylval.cval = savestr(d);
 752         OPERATOR(WORD);
 753     }
 754 }
 755
 756 STAB *
 757 stabent(name,add)
 758 register char *name;
 759 int add;
 760 {
 761     register STAB *stab;
 762
 763     for (stab = stab_index[*name]; stab; stab = stab->stab_next) {
 764         if (strEQ(name,stab->stab_name))
 765             return stab;
 766     }
 767
 768     /* no entry--should we add one? */
 769
 770     if (add) {
 771         stab = (STAB *) safemalloc(sizeof(STAB));
 772         bzero((char*)stab, sizeof(STAB));
 773         stab->stab_name = savestr(name);
 774         stab->stab_val = str_new(0);
 775         stab->stab_next = stab_index[*name];
 776         stab_index[*name] = stab;
 777         return stab;
 778     }
 779     return Nullstab;
 780 }
 781
 782 STIO *
 783 stio_new()
 784 {
 785     STIO *stio = (STIO *) safemalloc(sizeof(STIO));
 786
 787     bzero((char*)stio, sizeof(STIO));
 788     stio->page_len = 60;
 789     return stio;
 790 }
 791
 792 char *
 793 scanreg(s,dest)
 794 register char *s;
 795 char *dest;
 796 {
 797     register char *d;
 798
 799     s++;
 800     d = dest;
 801     while (isalpha(*s) || isdigit(*s) || *s == '_')
 802         *d++ = *s++;
 803     *d = '\0';
 804     d = dest;
 805     if (!*d) {
 806         *d = *s++;
 807         if (*d == '{') {
 808             d = dest;
 809             while (*s && *s != '}')
 810                 *d++ = *s++;
 811             *d = '\0';
 812             d = dest;
 813             if (*s)
 814                 s++;
 815         }
 816         else
 817             d[1] = '\0';
 818     }
 819     if (*d == '^' && !isspace(*s))
 820         *d = *s++ & 31;
 821     return s;
 822 }
 823
 824 STR *
 825 scanconst(string)
 826 char *string;
 827 {
 828     register STR *retstr;
 829     register char *t;
 830     register char *d;
 831
 832     if (index(string,'|')) {
 833         return Nullstr;
 834     }
 835     retstr = str_make(string);
 836     t = str_get(retstr);
 837     for (d=t; *d; ) {
 838         switch (*d) {
 839         case '.': case '[': case '$': case '(': case ')': case '|':
 840             *d = '\0';
 841             break;
 842         case '\\':
 843             if (index("wWbB0123456789",d[1])) {
 844                 *d = '\0';
 845                 break;
 846             }
 847             strcpy(d,d+1);
 848             switch(*d) {
 849             case 'n':
 850                 *d = '\n';
 851                 break;
 852             case 't':
 853                 *d = '\t';
 854                 break;
 855             case 'f':
 856                 *d = '\f';
 857                 break;
 858             case 'r':
 859                 *d = '\r';
 860                 break;
 861             }
 862             /* FALL THROUGH */
 863         default:
 864             if (d[1] == '*' || d[1] == '+' || d[1] == '?') {
 865                 *d = '\0';
 866                 break;
 867             }
 868             d++;
 869         }
 870     }
 871     if (!*t) {
 872         str_free(retstr);
 873         return Nullstr;
 874     }
 875     retstr->str_cur = strlen(retstr->str_ptr);  /* XXX cheating here */
 876     return retstr;
 877 }
 878
 879 char *
 880 scanpat(s)
 881 register char *s;
 882 {
 883     register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT));
 884     register char *d;
 885
 886     bzero((char *)spat, sizeof(SPAT));
 887     spat->spat_next = spat_root;        /* link into spat list */
 888     spat_root = spat;
 889     init_compex(&spat->spat_compex);
 890
 891     switch (*s++) {
 892     case 'm':
 893         s++;
 894         break;
 895     case '/':
 896         break;
 897     case '?':
 898         spat->spat_flags |= SPAT_USE_ONCE;
 899         break;
 900     default:
 901         fatal("Search pattern not found:\n%s",str_get(linestr));
 902     }
 903     s = cpytill(tokenbuf,s,s[-1]);
 904     if (!*s)
 905         fatal("Search pattern not terminated:\n%s",str_get(linestr));
 906     s++;
 907     if (*tokenbuf == '^') {
 908         spat->spat_first = scanconst(tokenbuf+1);
 909         if (spat->spat_first) {
 910             spat->spat_flen = strlen(spat->spat_first->str_ptr);
 911             if (spat->spat_flen == strlen(tokenbuf+1))
 912                 spat->spat_flags |= SPAT_SCANALL;
 913         }
 914     }
 915     else {
 916         spat->spat_flags |= SPAT_SCANFIRST;
 917         spat->spat_first = scanconst(tokenbuf);
 918         if (spat->spat_first) {
 919             spat->spat_flen = strlen(spat->spat_first->str_ptr);
 920             if (spat->spat_flen == strlen(tokenbuf))
 921                 spat->spat_flags |= SPAT_SCANALL;
 922         }
 923     }
 924     if (d = compile(&spat->spat_compex,tokenbuf,TRUE,FALSE))
 925         fatal(d);
 926     yylval.arg = make_match(O_MATCH,stab_to_arg(A_STAB,defstab),spat);
 927     return s;
 928 }
 929
 930 char *
 931 scansubst(s)
 932 register char *s;
 933 {
 934     register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT));
 935     register char *d;
 936
 937     bzero((char *)spat, sizeof(SPAT));
 938     spat->spat_next = spat_root;        /* link into spat list */
 939     spat_root = spat;
 940     init_compex(&spat->spat_compex);
 941
 942     s = cpytill(tokenbuf,s+1,*s);
 943     if (!*s)
 944         fatal("Substitution pattern not terminated:\n%s",str_get(linestr));
 945     for (d=tokenbuf; *d; d++) {
 946         if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
 947             register ARG *arg;
 948
 949             spat->spat_runtime = arg = op_new(1);
 950             arg->arg_type = O_ITEM;
 951             arg[1].arg_type = A_DOUBLE;
 952             arg[1].arg_ptr.arg_str = str_make(tokenbuf);
 953             goto get_repl;              /* skip compiling for now */
 954         }
 955     }
 956     if (*tokenbuf == '^') {
 957         spat->spat_first = scanconst(tokenbuf+1);
 958         if (spat->spat_first)
 959             spat->spat_flen = strlen(spat->spat_first->str_ptr);
 960     }
 961     else {
 962         spat->spat_flags |= SPAT_SCANFIRST;
 963         spat->spat_first = scanconst(tokenbuf);
 964         if (spat->spat_first)
 965             spat->spat_flen = strlen(spat->spat_first->str_ptr);
 966     }
 967     if (d = compile(&spat->spat_compex,tokenbuf,TRUE,FALSE))
 968         fatal(d);
 969 get_repl:
 970     s = scanstr(s);
 971     if (!*s)
 972         fatal("Substitution replacement not terminated:\n%s",str_get(linestr));
 973     spat->spat_repl = yylval.arg;
 974     if (*s == 'g') {
 975         s++;
 976         spat->spat_flags &= ~SPAT_USE_ONCE;
 977     }
 978     else
 979         spat->spat_flags |= SPAT_USE_ONCE;
 980     yylval.arg = make_match(O_SUBST,stab_to_arg(A_STAB,defstab),spat);
 981     return s;
 982 }
 983
 984 ARG *
 985 make_split(stab,arg)
 986 register STAB *stab;
 987 register ARG *arg;
 988 {
 989     if (arg->arg_type != O_MATCH) {
 990         register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT));
 991         register char *d;
 992
 993         bzero((char *)spat, sizeof(SPAT));
 994         spat->spat_next = spat_root;    /* link into spat list */
 995         spat_root = spat;
 996         init_compex(&spat->spat_compex);
 997
 998         spat->spat_runtime = arg;
 999         arg = make_match(O_MATCH,stab_to_arg(A_STAB,defstab),spat);
1000     }
1001     arg->arg_type = O_SPLIT;
1002     arg[2].arg_ptr.arg_spat->spat_repl = stab_to_arg(A_STAB,aadd(stab));
1003     return arg;
1004 }
1005
1006 char *
1007 expand_charset(s)
1008 register char *s;
1009 {
1010     char t[512];
1011     register char *d = t;
1012     register int i;
1013
1014     while (*s) {
1015         if (s[1] == '-' && s[2]) {
1016             for (i = s[0]; i <= s[2]; i++)
1017                 *d++ = i;
1018             s += 3;
1019         }
1020         else
1021             *d++ = *s++;
1022     }
1023     *d = '\0';
1024     return savestr(t);
1025 }
1026
1027 char *
1028 scantrans(s)
1029 register char *s;
1030 {
1031     ARG *arg =
1032         l(make_op(O_TRANS,2,stab_to_arg(A_STAB,defstab),Nullarg,Nullarg,0));
1033     register char *t;
1034     register char *r;
1035     register char *tbl = safemalloc(256);
1036     register int i;
1037
1038     arg[2].arg_type = A_NULL;
1039     arg[2].arg_ptr.arg_cval = tbl;
1040     for (i=0; i<256; i++)
1041         tbl[i] = 0;
1042     s = scanstr(s);
1043     if (!*s)
1044         fatal("Translation pattern not terminated:\n%s",str_get(linestr));
1045     t = expand_charset(str_get(yylval.arg[1].arg_ptr.arg_str));
1046     free_arg(yylval.arg);
1047     s = scanstr(s-1);
1048     if (!*s)
1049         fatal("Translation replacement not terminated:\n%s",str_get(linestr));
1050     r = expand_charset(str_get(yylval.arg[1].arg_ptr.arg_str));
1051     free_arg(yylval.arg);
1052     yylval.arg = arg;
1053     if (!*r) {
1054         safefree(r);
1055         r = t;
1056     }
1057     for (i = 0; t[i]; i++) {
1058         if (!r[i])
1059             r[i] = r[i-1];
1060         tbl[t[i] & 0377] = r[i];
1061     }
1062     if (r != t)
1063         safefree(r);
1064     safefree(t);
1065     return s;
1066 }
1067
1068 CMD *
1069 block_head(tail)
1070 register CMD *tail;
1071 {
1072     if (tail == Nullcmd) {
1073         return tail;
1074     }
1075     return tail->c_head;
1076 }
1077
1078 CMD *
1079 append_line(head,tail)
1080 register CMD *head;
1081 register CMD *tail;
1082 {
1083     if (tail == Nullcmd)
1084         return head;
1085     if (!tail->c_head)                  /* make sure tail is well formed */
1086         tail->c_head = tail;
1087     if (head != Nullcmd) {
1088         tail = tail->c_head;            /* get to start of tail list */
1089         if (!head->c_head)
1090             head->c_head = head;        /* start a new head list */
1091         while (head->c_next) {
1092             head->c_next->c_head = head->c_head;
1093             head = head->c_next;        /* get to end of head list */
1094         }
1095         head->c_next = tail;            /* link to end of old list */
1096         tail->c_head = head->c_head;    /* propagate head pointer */
1097     }
1098     while (tail->c_next) {
1099         tail->c_next->c_head = tail->c_head;
1100         tail = tail->c_next;
1101     }
1102     return tail;
1103 }
1104
1105 CMD *
1106 make_acmd(type,stab,cond,arg)
1107 int type;
1108 STAB *stab;
1109 ARG *cond;
1110 ARG *arg;
1111 {
1112     register CMD *cmd = (CMD *) safemalloc(sizeof (CMD));
1113
1114     bzero((char *)cmd, sizeof(CMD));
1115     cmd->c_type = type;
1116     cmd->ucmd.acmd.ac_stab = stab;
1117     cmd->ucmd.acmd.ac_expr = arg;
1118     cmd->c_expr = cond;
1119     if (cond) {
1120         opt_arg(cmd,1);
1121         cmd->c_flags |= CF_COND;
1122     }
1123     return cmd;
1124 }
1125
1126 CMD *
1127 make_ccmd(type,arg,cblock)
1128 int type;
1129 register ARG *arg;
1130 struct compcmd cblock;
1131 {
1132     register CMD *cmd = (CMD *) safemalloc(sizeof (CMD));
1133
1134     bzero((char *)cmd, sizeof(CMD));
1135     cmd->c_type = type;
1136     cmd->c_expr = arg;
1137     cmd->ucmd.ccmd.cc_true = cblock.comp_true;
1138     cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
1139     if (arg) {
1140         opt_arg(cmd,1);
1141         cmd->c_flags |= CF_COND;
1142     }
1143     return cmd;
1144 }
1145
1146 void
1147 opt_arg(cmd,fliporflop)
1148 register CMD *cmd;
1149 int fliporflop;
1150 {
1151     register ARG *arg;
1152     int opt = CFT_EVAL;
1153     int sure = 0;
1154     ARG *arg2;
1155     char *tmps; /* for True macro */
1156     int context = 0;    /* 0 = normal, 1 = before &&, 2 = before || */
1157     int flp = fliporflop;
1158
1159     if (!cmd)
1160         return;
1161     arg = cmd->c_expr;
1162
1163     /* Turn "if (!expr)" into "unless (expr)" */
1164
1165     while (arg->arg_type == O_NOT && arg[1].arg_type == A_EXPR) {
1166         cmd->c_flags ^= CF_INVERT;              /* flip sense of cmd */
1167         cmd->c_expr = arg[1].arg_ptr.arg_arg;   /* hoist the rest of expr */
1168         free_arg(arg);
1169         arg = cmd->c_expr;                      /* here we go again */
1170     }
1171
1172     if (!arg->arg_len) {                /* sanity check */
1173         cmd->c_flags |= opt;
1174         return;
1175     }
1176
1177     /* for "cond .. cond" we set up for the initial check */
1178
1179     if (arg->arg_type == O_FLIP)
1180         context |= 4;
1181
1182     /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
1183
1184     if (arg->arg_type == O_AND)
1185         context |= 1;
1186     else if (arg->arg_type == O_OR)
1187         context |= 2;
1188     if (context && arg[flp].arg_type == A_EXPR) {
1189         arg = arg[flp].arg_ptr.arg_arg;
1190         flp = 1;
1191     }
1192
1193     if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
1194         cmd->c_flags |= opt;
1195         return;                         /* side effect, can't optimize */
1196     }
1197
1198     if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
1199       arg->arg_type == O_AND || arg->arg_type == O_OR) {
1200         if (arg[flp].arg_type == A_SINGLE) {
1201             opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
1202             cmd->c_first = arg[flp].arg_ptr.arg_str;
1203             goto literal;
1204         }
1205         else if (arg[flp].arg_type == A_STAB || arg[flp].arg_type == A_LVAL) {
1206             cmd->c_stab  = arg[flp].arg_ptr.arg_stab;
1207             opt = CFT_REG;
1208           literal:
1209             if (!context) {     /* no && or ||? */
1210                 free_arg(arg);
1211                 cmd->c_expr = Nullarg;
1212             }
1213             if (!(context & 1))
1214                 cmd->c_flags |= CF_EQSURE;
1215             if (!(context & 2))
1216                 cmd->c_flags |= CF_NESURE;
1217         }
1218     }
1219     else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
1220              arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
1221         if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
1222                 arg[2].arg_type == A_SPAT &&
1223                 arg[2].arg_ptr.arg_spat->spat_first ) {
1224             cmd->c_stab  = arg[1].arg_ptr.arg_stab;
1225             cmd->c_first = arg[2].arg_ptr.arg_spat->spat_first;
1226             cmd->c_flen  = arg[2].arg_ptr.arg_spat->spat_flen;
1227             if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANALL &&
1228                 (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
1229                 sure |= CF_EQSURE;              /* (SUBST must be forced even */
1230                                                 /* if we know it will work.) */
1231             arg[2].arg_ptr.arg_spat->spat_first = Nullstr;
1232             arg[2].arg_ptr.arg_spat->spat_flen = 0; /* only one chk */
1233             sure |= CF_NESURE;          /* normally only sure if it fails */
1234             if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
1235                 cmd->c_flags |= CF_FIRSTNEG;
1236             if (context & 1) {          /* only sure if thing is false */
1237                 if (cmd->c_flags & CF_FIRSTNEG)
1238                     sure &= ~CF_NESURE;
1239                 else
1240                     sure &= ~CF_EQSURE;
1241             }
1242             else if (context & 2) {     /* only sure if thing is true */
1243                 if (cmd->c_flags & CF_FIRSTNEG)
1244                     sure &= ~CF_EQSURE;
1245                 else
1246                     sure &= ~CF_NESURE;
1247             }
1248             if (sure & (CF_EQSURE|CF_NESURE)) { /* if we know anything*/
1249                 if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
1250                     opt = CFT_SCAN;
1251                 else
1252                     opt = CFT_ANCHOR;
1253                 if (sure == (CF_EQSURE|CF_NESURE)       /* really sure? */
1254                     && arg->arg_type == O_MATCH
1255                     && context & 4
1256                     && fliporflop == 1) {
1257                     arg[2].arg_type = A_SINGLE;         /* don't do twice */
1258                     arg[2].arg_ptr.arg_str = &str_yes;
1259                 }
1260                 cmd->c_flags |= sure;
1261             }
1262         }
1263     }
1264     else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
1265              arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
1266         if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
1267             if (arg[2].arg_type == A_SINGLE) {
1268                 cmd->c_stab  = arg[1].arg_ptr.arg_stab;
1269                 cmd->c_first = arg[2].arg_ptr.arg_str;
1270                 cmd->c_flen  = 30000;
1271                 switch (arg->arg_type) {
1272                 case O_SLT: case O_SGT:
1273                     sure |= CF_EQSURE;
1274                     cmd->c_flags |= CF_FIRSTNEG;
1275                     break;
1276                 case O_SNE:
1277                     cmd->c_flags |= CF_FIRSTNEG;
1278                     /* FALL THROUGH */
1279                 case O_SEQ:
1280                     sure |= CF_NESURE|CF_EQSURE;
1281                     break;
1282                 }
1283                 if (context & 1) {      /* only sure if thing is false */
1284                     if (cmd->c_flags & CF_FIRSTNEG)
1285                         sure &= ~CF_NESURE;
1286                     else
1287                         sure &= ~CF_EQSURE;
1288                 }
1289                 else if (context & 2) { /* only sure if thing is true */
1290                     if (cmd->c_flags & CF_FIRSTNEG)
1291                         sure &= ~CF_EQSURE;
1292                     else
1293                         sure &= ~CF_NESURE;
1294                 }
1295                 if (sure & (CF_EQSURE|CF_NESURE)) {
1296                     opt = CFT_STROP;
1297                     cmd->c_flags |= sure;
1298                 }
1299             }
1300         }
1301     }
1302     else if (arg->arg_type == O_ASSIGN &&
1303              (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
1304              arg[1].arg_ptr.arg_stab == defstab &&
1305              arg[2].arg_type == A_EXPR ) {
1306         arg2 = arg[2].arg_ptr.arg_arg;
1307         if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
1308             opt = CFT_GETS;
1309             cmd->c_stab = arg2[1].arg_ptr.arg_stab;
1310             if (!(arg2[1].arg_ptr.arg_stab->stab_io->flags & IOF_ARGV)) {
1311                 free_arg(arg2);
1312                 free_arg(arg);
1313                 cmd->c_expr = Nullarg;
1314             }
1315         }
1316     }
1317     else if (arg->arg_type == O_CHOP &&
1318              (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
1319         opt = CFT_CHOP;
1320         cmd->c_stab = arg[1].arg_ptr.arg_stab;
1321         free_arg(arg);
1322         cmd->c_expr = Nullarg;
1323     }
1324     if (context & 4)
1325         opt |= CF_FLIP;
1326     cmd->c_flags |= opt;
1327
1328     if (cmd->c_flags & CF_FLIP) {
1329         if (fliporflop == 1) {
1330             arg = cmd->c_expr;  /* get back to O_FLIP arg */
1331             arg[3].arg_ptr.arg_cmd = (CMD*)safemalloc(sizeof(CMD));
1332             bcopy((char *)cmd, (char *)arg[3].arg_ptr.arg_cmd, sizeof(CMD));
1333             arg[4].arg_ptr.arg_cmd = (CMD*)safemalloc(sizeof(CMD));
1334             bcopy((char *)cmd, (char *)arg[4].arg_ptr.arg_cmd, sizeof(CMD));
1335             opt_arg(arg[4].arg_ptr.arg_cmd,2);
1336             arg->arg_len = 2;           /* this is a lie */
1337         }
1338         else {
1339             if ((opt & CF_OPTIMIZE) == CFT_EVAL)
1340                 cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
1341         }
1342     }
1343 }
1344
1345 ARG *
1346 mod_match(type,left,pat)
1347 register ARG *left;
1348 register ARG *pat;
1349 {
1350
1351     register SPAT *spat;
1352     register ARG *newarg;
1353
1354     if ((pat->arg_type == O_MATCH ||
1355          pat->arg_type == O_SUBST ||
1356          pat->arg_type == O_TRANS ||
1357          pat->arg_type == O_SPLIT
1358         ) &&
1359         pat[1].arg_ptr.arg_stab == defstab ) {
1360         switch (pat->arg_type) {
1361         case O_MATCH:
1362             newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH,
1363                 pat->arg_len,
1364                 left,Nullarg,Nullarg,0);
1365             break;
1366         case O_SUBST:
1367             newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST,
1368                 pat->arg_len,
1369                 left,Nullarg,Nullarg,0));
1370             break;
1371         case O_TRANS:
1372             newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS,
1373                 pat->arg_len,
1374                 left,Nullarg,Nullarg,0));
1375             break;
1376         case O_SPLIT:
1377             newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT,
1378                 pat->arg_len,
1379                 left,Nullarg,Nullarg,0);
1380             break;
1381         }
1382         if (pat->arg_len >= 2) {
1383             newarg[2].arg_type = pat[2].arg_type;
1384             newarg[2].arg_ptr = pat[2].arg_ptr;
1385             newarg[2].arg_flags = pat[2].arg_flags;
1386             if (pat->arg_len >= 3) {
1387                 newarg[3].arg_type = pat[3].arg_type;
1388                 newarg[3].arg_ptr = pat[3].arg_ptr;
1389                 newarg[3].arg_flags = pat[3].arg_flags;
1390             }
1391         }
1392         safefree((char*)pat);
1393     }
1394     else {
1395         spat = (SPAT *) safemalloc(sizeof (SPAT));
1396         bzero((char *)spat, sizeof(SPAT));
1397         spat->spat_next = spat_root;    /* link into spat list */
1398         spat_root = spat;
1399         init_compex(&spat->spat_compex);
1400
1401         spat->spat_runtime = pat;
1402         newarg = make_op(type,2,left,Nullarg,Nullarg,0);
1403         newarg[2].arg_type = A_SPAT;
1404         newarg[2].arg_ptr.arg_spat = spat;
1405         newarg[2].arg_flags = AF_SPECIAL;
1406     }
1407
1408     return newarg;
1409 }
1410
1411 CMD *
1412 add_label(lbl,cmd)
1413 char *lbl;
1414 register CMD *cmd;
1415 {
1416     if (cmd)
1417         cmd->c_label = lbl;
1418     return cmd;
1419 }
1420
1421 CMD *
1422 addcond(cmd, arg)
1423 register CMD *cmd;
1424 register ARG *arg;
1425 {
1426     cmd->c_expr = arg;
1427     opt_arg(cmd,1);
1428     cmd->c_flags |= CF_COND;
1429     return cmd;
1430 }
1431
1432 CMD *
1433 addloop(cmd, arg)
1434 register CMD *cmd;
1435 register ARG *arg;
1436 {
1437     cmd->c_expr = arg;
1438     opt_arg(cmd,1);
1439     cmd->c_flags |= CF_COND|CF_LOOP;
1440     if (cmd->c_type == C_BLOCK)
1441         cmd->c_flags &= ~CF_COND;
1442     else {
1443         arg = cmd->ucmd.acmd.ac_expr;
1444         if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
1445             cmd->c_flags &= ~CF_COND;  /* "do {} while" happens at least once */
1446         if (arg && arg->arg_type == O_SUBR)
1447             cmd->c_flags &= ~CF_COND;  /* likewise for "do subr() while" */
1448     }
1449     return cmd;
1450 }
1451
1452 CMD *
1453 invert(cmd)
1454 register CMD *cmd;
1455 {
1456     cmd->c_flags ^= CF_INVERT;
1457     return cmd;
1458 }
1459
1460 yyerror(s)
1461 char *s;
1462 {
1463     char tmpbuf[128];
1464     char *tname = tmpbuf;
1465
1466     if (yychar > 256) {
1467         tname = tokename[yychar-256];
1468         if (strEQ(tname,"word"))
1469             strcpy(tname,tokenbuf);
1470         else if (strEQ(tname,"register"))
1471             sprintf(tname,"$%s",tokenbuf);
1472         else if (strEQ(tname,"array_length"))
1473             sprintf(tname,"$#%s",tokenbuf);
1474     }
1475     else if (!yychar)
1476         strcpy(tname,"EOF");
1477     else if (yychar < 32)
1478         sprintf(tname,"^%c",yychar+64);
1479     else if (yychar == 127)
1480         strcpy(tname,"^?");
1481     else
1482         sprintf(tname,"%c",yychar);
1483     printf("%s in file %s at line %d, next token \"%s\"\n",
1484       s,filename,line,tname);
1485 }
1486
1487 char *
1488 scanstr(s)
1489 register char *s;
1490 {
1491     register char term;
1492     register char *d;
1493     register ARG *arg;
1494     register bool makesingle = FALSE;
1495     char *leave = "\\$nrtfb0123456789"; /* which backslash sequences to keep */
1496
1497     arg = op_new(1);
1498     yylval.arg = arg;
1499     arg->arg_type = O_ITEM;
1500
1501     switch (*s) {
1502     default:                    /* a substitution replacement */
1503         arg[1].arg_type = A_DOUBLE;
1504         makesingle = TRUE;      /* maybe disable runtime scanning */
1505         term = *s;
1506         if (term == '\'')
1507             leave = Nullch;
1508         goto snarf_it;
1509     case '0':
1510         {
1511             long i;
1512             int shift;
1513
1514             arg[1].arg_type = A_SINGLE;
1515             if (s[1] == 'x') {
1516                 shift = 4;
1517                 s += 2;
1518             }
1519             else if (s[1] == '.')
1520                 goto decimal;
1521             else
1522                 shift = 3;
1523             i = 0;
1524             for (;;) {
1525                 switch (*s) {
1526                 default:
1527                     goto out;
1528                 case '8': case '9':
1529                     if (shift != 4)
1530                         fatal("Illegal octal digit at line %d",line);
1531                     /* FALL THROUGH */
1532                 case '0': case '1': case '2': case '3': case '4':
1533                 case '5': case '6': case '7':
1534                     i <<= shift;
1535                     i += *s++ & 15;
1536                     break;
1537                 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1538                 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
1539                     if (shift != 4)
1540                         goto out;
1541                     i <<= 4;
1542                     i += (*s++ & 7) + 9;
1543                     break;
1544                 }
1545             }
1546           out:
1547             sprintf(tokenbuf,"%d",i);
1548             arg[1].arg_ptr.arg_str = str_make(tokenbuf);
1549         }
1550         break;
1551     case '1': case '2': case '3': case '4': case '5':
1552     case '6': case '7': case '8': case '9': case '.':
1553       decimal:
1554         arg[1].arg_type = A_SINGLE;
1555         d = tokenbuf;
1556         while (isdigit(*s) || *s == '_')
1557             *d++ = *s++;
1558         if (*s == '.' && index("0123456789eE",s[1]))
1559             *d++ = *s++;
1560         while (isdigit(*s) || *s == '_')
1561             *d++ = *s++;
1562         if (index("eE",*s) && index("+-0123456789",s[1]))
1563             *d++ = *s++;
1564         if (*s == '+' || *s == '-')
1565             *d++ = *s++;
1566         while (isdigit(*s))
1567             *d++ = *s++;
1568         *d = '\0';
1569         arg[1].arg_ptr.arg_str = str_make(tokenbuf);
1570         break;
1571     case '\'':
1572         arg[1].arg_type = A_SINGLE;
1573         term = *s;
1574         leave = Nullch;
1575         goto snarf_it;
1576
1577     case '<':
1578         arg[1].arg_type = A_READ;
1579         s = cpytill(tokenbuf,s+1,'>');
1580         if (!*tokenbuf)
1581             strcpy(tokenbuf,"ARGV");
1582         if (*s)
1583             s++;
1584         if (rsfp == stdin && strEQ(tokenbuf,"stdin"))
1585             fatal("Can't get both program and data from <stdin>\n");
1586         arg[1].arg_ptr.arg_stab = stabent(tokenbuf,TRUE);
1587         arg[1].arg_ptr.arg_stab->stab_io = stio_new();
1588         if (strEQ(tokenbuf,"ARGV")) {
1589             aadd(arg[1].arg_ptr.arg_stab);
1590             arg[1].arg_ptr.arg_stab->stab_io->flags |= IOF_ARGV|IOF_START;
1591         }
1592         break;
1593     case '"':
1594         arg[1].arg_type = A_DOUBLE;
1595         makesingle = TRUE;      /* maybe disable runtime scanning */
1596         term = *s;
1597         goto snarf_it;
1598     case '`':
1599         arg[1].arg_type = A_BACKTICK;
1600         term = *s;
1601       snarf_it:
1602         {
1603             STR *tmpstr;
1604             int sqstart = line;
1605             char *tmps;
1606
1607             tmpstr = str_new(strlen(s));
1608             s = str_append_till(tmpstr,s+1,term,leave);
1609             while (!*s) {       /* multiple line string? */
1610                 s = str_gets(linestr, rsfp);
1611                 if (!*s)
1612                     fatal("EOF in string at line %d\n",sqstart);
1613                 line++;
1614                 s = str_append_till(tmpstr,s,term,leave);
1615             }
1616             s++;
1617             if (term == '\'') {
1618                 arg[1].arg_ptr.arg_str = tmpstr;
1619                 break;
1620             }
1621             tmps = s;
1622             s = d = tmpstr->str_ptr;    /* assuming shrinkage only */
1623             while (*s) {
1624                 if (*s == '$' && s[1]) {
1625                     makesingle = FALSE; /* force interpretation */
1626                     if (!isalpha(s[1])) {       /* an internal register? */
1627                         int len;
1628
1629                         len = scanreg(s,tokenbuf) - s;
1630                         stabent(tokenbuf,TRUE); /* make sure it's created */
1631                         while (len--)
1632                             *d++ = *s++;
1633                         continue;
1634                     }
1635                 }
1636                 else if (*s == '\\' && s[1]) {
1637                     s++;
1638                     switch (*s) {
1639                     default:
1640                       defchar:
1641                         if (!leave || index(leave,*s))
1642                             *d++ = '\\';
1643                         *d++ = *s++;
1644                         continue;
1645                     case '0': case '1': case '2': case '3':
1646                     case '4': case '5': case '6': case '7':
1647                         *d = *s++ - '0';
1648                         if (index("01234567",*s)) {
1649                             *d <<= 3;
1650                             *d += *s++ - '0';
1651                         }
1652                         else if (!index("`\"",term)) {  /* oops, a subpattern */
1653                             s--;
1654                             goto defchar;
1655                         }
1656                         if (index("01234567",*s)) {
1657                             *d <<= 3;
1658                             *d += *s++ - '0';
1659                         }
1660                         d++;
1661                         continue;
1662                     case 'b':
1663                         *d++ = '\b';
1664                         break;
1665                     case 'n':
1666                         *d++ = '\n';
1667                         break;
1668                     case 'r':
1669                         *d++ = '\r';
1670                         break;
1671                     case 'f':
1672                         *d++ = '\f';
1673                         break;
1674                     case 't':
1675                         *d++ = '\t';
1676                         break;
1677                     }
1678                     s++;
1679                     continue;
1680                 }
1681                 *d++ = *s++;
1682             }
1683             *d = '\0';
1684             if (arg[1].arg_type == A_DOUBLE) {
1685                 if (makesingle)
1686                     arg[1].arg_type = A_SINGLE; /* now we can optimize on it */
1687                 else
1688                     leave = "\\";
1689                 for (d = s = tmpstr->str_ptr; *s; *d++ = *s++) {
1690                     if (*s == '\\' && (!leave || index(leave,s[1])))
1691                         s++;
1692                 }
1693                 *d = '\0';
1694             }
1695             tmpstr->str_cur = d - tmpstr->str_ptr;      /* XXX cheat */
1696             arg[1].arg_ptr.arg_str = tmpstr;
1697             s = tmps;
1698             break;
1699         }
1700     }
1701     return s;
1702 }
1703
1704 ARG *
1705 make_op(type,newlen,arg1,arg2,arg3,dolist)
1706 int type;
1707 int newlen;
1708 ARG *arg1;
1709 ARG *arg2;
1710 ARG *arg3;
1711 int dolist;
1712 {
1713     register ARG *arg;
1714     register ARG *chld;
1715     register int doarg;
1716
1717     arg = op_new(newlen);
1718     arg->arg_type = type;
1719     doarg = opargs[type];
1720     if (chld = arg1) {
1721         if (!(doarg & 1))
1722             arg[1].arg_flags |= AF_SPECIAL;
1723         if (doarg & 16)
1724             arg[1].arg_flags |= AF_NUMERIC;
1725         if (chld->arg_type == O_ITEM &&
1726             (hoistable[chld[1].arg_type] || chld[1].arg_type == A_LVAL) ) {
1727             arg[1].arg_type = chld[1].arg_type;
1728             arg[1].arg_ptr = chld[1].arg_ptr;
1729             arg[1].arg_flags |= chld[1].arg_flags;
1730             free_arg(chld);
1731         }
1732         else {
1733             arg[1].arg_type = A_EXPR;
1734             arg[1].arg_ptr.arg_arg = chld;
1735             if (dolist & 1) {
1736                 if (chld->arg_type == O_LIST) {
1737                     if (newlen == 1) {  /* we can hoist entire list */
1738                         chld->arg_type = type;
1739                         free_arg(arg);
1740                         arg = chld;
1741                     }
1742                     else {
1743                         arg[1].arg_flags |= AF_SPECIAL;
1744                     }
1745                 }
1746                 else if (chld->arg_type == O_ARRAY && chld->arg_len == 1)
1747                     arg[1].arg_flags |= AF_SPECIAL;
1748             }
1749         }
1750     }
1751     if (chld = arg2) {
1752         if (!(doarg & 2))
1753             arg[2].arg_flags |= AF_SPECIAL;
1754         if (doarg & 32)
1755             arg[2].arg_flags |= AF_NUMERIC;
1756         if (chld->arg_type == O_ITEM &&
1757             (hoistable[chld[1].arg_type] ||
1758              (type == O_ASSIGN &&
1759               (chld[1].arg_type == A_READ ||
1760                chld[1].arg_type == A_DOUBLE ||
1761                chld[1].arg_type == A_BACKTICK ) ) ) ) {
1762             arg[2].arg_type = chld[1].arg_type;
1763             arg[2].arg_ptr = chld[1].arg_ptr;
1764             free_arg(chld);
1765         }
1766         else {
1767             arg[2].arg_type = A_EXPR;
1768             arg[2].arg_ptr.arg_arg = chld;
1769             if ((dolist & 2) &&
1770               (chld->arg_type == O_LIST ||
1771                (chld->arg_type == O_ARRAY && chld->arg_len == 1) ))
1772                 arg[2].arg_flags |= AF_SPECIAL;
1773         }
1774     }
1775     if (chld = arg3) {
1776         if (!(doarg & 4))
1777             arg[3].arg_flags |= AF_SPECIAL;
1778         if (doarg & 64)
1779             arg[3].arg_flags |= AF_NUMERIC;
1780         if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
1781             arg[3].arg_type = chld[1].arg_type;
1782             arg[3].arg_ptr = chld[1].arg_ptr;
1783             free_arg(chld);
1784         }
1785         else {
1786             arg[3].arg_type = A_EXPR;
1787             arg[3].arg_ptr.arg_arg = chld;
1788             if ((dolist & 4) &&
1789               (chld->arg_type == O_LIST ||
1790                (chld->arg_type == O_ARRAY && chld->arg_len == 1) ))
1791                 arg[3].arg_flags |= AF_SPECIAL;
1792         }
1793     }
1794 #ifdef DEBUGGING
1795     if (debug & 16) {
1796         fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
1797         if (arg1)
1798             fprintf(stderr,",%s=%lx",
1799                 argname[arg[1].arg_type],arg[1].arg_ptr.arg_arg);
1800         if (arg2)
1801             fprintf(stderr,",%s=%lx",
1802                 argname[arg[2].arg_type],arg[2].arg_ptr.arg_arg);
1803         if (arg3)
1804             fprintf(stderr,",%s=%lx",
1805                 argname[arg[3].arg_type],arg[3].arg_ptr.arg_arg);
1806         fprintf(stderr,")\n");
1807     }
1808 #endif
1809     evalstatic(arg);            /* see if we can consolidate anything */
1810     return arg;
1811 }
1812
1813 /* turn 123 into 123 == $. */
1814
1815 ARG *
1816 flipflip(arg)
1817 register ARG *arg;
1818 {
1819     if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_SINGLE) {
1820         arg = (ARG*)saferealloc((char*)arg,3*sizeof(ARG));
1821         arg->arg_type = O_EQ;
1822         arg->arg_len = 2;
1823         arg[2].arg_type = A_STAB;
1824         arg[2].arg_flags = 0;
1825         arg[2].arg_ptr.arg_stab = stabent(".",TRUE);
1826     }
1827     return arg;
1828 }
1829
1830 void
1831 evalstatic(arg)
1832 register ARG *arg;
1833 {
1834     register STR *str;
1835     register STR *s1;
1836     register STR *s2;
1837     double value;               /* must not be register */
1838     register char *tmps;
1839     int i;
1840     double exp(), log(), sqrt(), modf();
1841     char *crypt();
1842
1843     if (!arg || !arg->arg_len)
1844         return;
1845
1846     if (arg[1].arg_type == A_SINGLE &&
1847         (arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) {
1848         str = str_new(0);
1849         s1 = arg[1].arg_ptr.arg_str;
1850         if (arg->arg_len > 1)
1851             s2 = arg[2].arg_ptr.arg_str;
1852         else
1853             s2 = Nullstr;
1854         switch (arg->arg_type) {
1855         default:
1856             str_free(str);
1857             str = Nullstr;              /* can't be evaluated yet */
1858             break;
1859         case O_CONCAT:
1860             str_sset(str,s1);
1861             str_scat(str,s2);
1862             break;
1863         case O_REPEAT:
1864             i = (int)str_gnum(s2);
1865             while (i--)
1866                 str_scat(str,s1);
1867             break;
1868         case O_MULTIPLY:
1869             value = str_gnum(s1);
1870             str_numset(str,value * str_gnum(s2));
1871             break;
1872         case O_DIVIDE:
1873             value = str_gnum(s1);
1874             str_numset(str,value / str_gnum(s2));
1875             break;
1876         case O_MODULO:
1877             value = str_gnum(s1);
1878             str_numset(str,(double)(((long)value) % ((long)str_gnum(s2))));
1879             break;
1880         case O_ADD:
1881             value = str_gnum(s1);
1882             str_numset(str,value + str_gnum(s2));
1883             break;
1884         case O_SUBTRACT:
1885             value = str_gnum(s1);
1886             str_numset(str,value - str_gnum(s2));
1887             break;
1888         case O_LEFT_SHIFT:
1889             value = str_gnum(s1);
1890             str_numset(str,(double)(((long)value) << ((long)str_gnum(s2))));
1891             break;
1892         case O_RIGHT_SHIFT:
1893             value = str_gnum(s1);
1894             str_numset(str,(double)(((long)value) >> ((long)str_gnum(s2))));
1895             break;
1896         case O_LT:
1897             value = str_gnum(s1);
1898             str_numset(str,(double)(value < str_gnum(s2)));
1899             break;
1900         case O_GT:
1901             value = str_gnum(s1);
1902             str_numset(str,(double)(value > str_gnum(s2)));
1903             break;
1904         case O_LE:
1905             value = str_gnum(s1);
1906             str_numset(str,(double)(value <= str_gnum(s2)));
1907             break;
1908         case O_GE:
1909             value = str_gnum(s1);
1910             str_numset(str,(double)(value >= str_gnum(s2)));
1911             break;
1912         case O_EQ:
1913             value = str_gnum(s1);
1914             str_numset(str,(double)(value == str_gnum(s2)));
1915             break;
1916         case O_NE:
1917             value = str_gnum(s1);
1918             str_numset(str,(double)(value != str_gnum(s2)));
1919             break;
1920         case O_BIT_AND:
1921             value = str_gnum(s1);
1922             str_numset(str,(double)(((long)value) & ((long)str_gnum(s2))));
1923             break;
1924         case O_XOR:
1925             value = str_gnum(s1);
1926             str_numset(str,(double)(((long)value) ^ ((long)str_gnum(s2))));
1927             break;
1928         case O_BIT_OR:
1929             value = str_gnum(s1);
1930             str_numset(str,(double)(((long)value) | ((long)str_gnum(s2))));
1931             break;
1932         case O_AND:
1933             if (str_true(s1))
1934                 str = str_make(str_get(s2));
1935             else
1936                 str = str_make(str_get(s1));
1937             break;
1938         case O_OR:
1939             if (str_true(s1))
1940                 str = str_make(str_get(s1));
1941             else
1942                 str = str_make(str_get(s2));
1943             break;
1944         case O_COND_EXPR:
1945             if (arg[3].arg_type != A_SINGLE) {
1946                 str_free(str);
1947                 str = Nullstr;
1948             }
1949             else {
1950                 str = str_make(str_get(str_true(s1) ? s2 : arg[3].arg_ptr.arg_str));
1951                 str_free(arg[3].arg_ptr.arg_str);
1952             }
1953             break;
1954         case O_NEGATE:
1955             str_numset(str,(double)(-str_gnum(s1)));
1956             break;
1957         case O_NOT:
1958             str_numset(str,(double)(!str_true(s1)));
1959             break;
1960         case O_COMPLEMENT:
1961             str_numset(str,(double)(~(long)str_gnum(s1)));
1962             break;
1963         case O_LENGTH:
1964             str_numset(str, (double)str_len(s1));
1965             break;
1966         case O_SUBSTR:
1967             if (arg[3].arg_type != A_SINGLE || stabent("[",FALSE)) {
1968                 str_free(str);          /* making the fallacious assumption */
1969                 str = Nullstr;          /* that any $[ occurs before substr()*/
1970             }
1971             else {
1972                 char *beg;
1973                 int len = (int)str_gnum(s2);
1974                 int tmp;
1975
1976                 for (beg = str_get(s1); *beg && len > 0; beg++,len--) ;
1977                 len = (int)str_gnum(arg[3].arg_ptr.arg_str);
1978                 str_free(arg[3].arg_ptr.arg_str);
1979                 if (len > (tmp = strlen(beg)))
1980                     len = tmp;
1981                 str_nset(str,beg,len);
1982             }
1983             break;
1984         case O_SLT:
1985             tmps = str_get(s1);
1986             str_numset(str,(double)(strLT(tmps,str_get(s2))));
1987             break;
1988         case O_SGT:
1989             tmps = str_get(s1);
1990             str_numset(str,(double)(strGT(tmps,str_get(s2))));
1991             break;
1992         case O_SLE:
1993             tmps = str_get(s1);
1994             str_numset(str,(double)(strLE(tmps,str_get(s2))));
1995             break;
1996         case O_SGE:
1997             tmps = str_get(s1);
1998             str_numset(str,(double)(strGE(tmps,str_get(s2))));
1999             break;
2000         case O_SEQ:
2001             tmps = str_get(s1);
2002             str_numset(str,(double)(strEQ(tmps,str_get(s2))));
2003             break;
2004         case O_SNE:
2005             tmps = str_get(s1);
2006             str_numset(str,(double)(strNE(tmps,str_get(s2))));
2007             break;
2008         case O_CRYPT:
2009             tmps = str_get(s1);
2010             str_set(str,crypt(tmps,str_get(s2)));
2011             break;
2012         case O_EXP:
2013             str_numset(str,exp(str_gnum(s1)));
2014             break;
2015         case O_LOG:
2016             str_numset(str,log(str_gnum(s1)));
2017             break;
2018         case O_SQRT:
2019             str_numset(str,sqrt(str_gnum(s1)));
2020             break;
2021         case O_INT:
2022             modf(str_gnum(s1),&value);
2023             str_numset(str,value);
2024             break;
2025         case O_ORD:
2026             str_numset(str,(double)(*str_get(s1)));
2027             break;
2028         }
2029         if (str) {
2030             arg->arg_type = O_ITEM;     /* note arg1 type is already SINGLE */
2031             str_free(s1);
2032             str_free(s2);
2033             arg[1].arg_ptr.arg_str = str;
2034         }
2035     }
2036 }
2037
2038 ARG *
2039 l(arg)
2040 register ARG *arg;
2041 {
2042     register int i;
2043     register ARG *arg1;
2044
2045     arg->arg_flags |= AF_COMMON;        /* XXX should cross-match */
2046
2047     /* see if it's an array reference */
2048
2049     if (arg[1].arg_type == A_EXPR) {
2050         arg1 = arg[1].arg_ptr.arg_arg;
2051
2052         if (arg1->arg_type == O_LIST && arg->arg_type != O_ITEM) {
2053                                                 /* assign to list */
2054             arg[1].arg_flags |= AF_SPECIAL;
2055             arg[2].arg_flags |= AF_SPECIAL;
2056             for (i = arg1->arg_len; i >= 1; i--) {
2057                 switch (arg1[i].arg_type) {
2058                 case A_STAB: case A_LVAL:
2059                     arg1[i].arg_type = A_LVAL;
2060                     break;
2061                 case A_EXPR: case A_LEXPR:
2062                     arg1[i].arg_type = A_LEXPR;
2063                     if (arg1[i].arg_ptr.arg_arg->arg_type == O_ARRAY)
2064                         arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY;
2065                     else if (arg1[i].arg_ptr.arg_arg->arg_type == O_HASH)
2066                         arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH;
2067                     if (arg1[i].arg_ptr.arg_arg->arg_type == O_LARRAY)
2068                         break;
2069                     if (arg1[i].arg_ptr.arg_arg->arg_type == O_LHASH)
2070                         break;
2071                     /* FALL THROUGH */
2072                 default:
2073                     sprintf(tokenbuf,
2074                       "Illegal item (%s) as lvalue",argname[arg1[i].arg_type]);
2075                     yyerror(tokenbuf);
2076                 }
2077             }
2078         }
2079         else if (arg1->arg_type == O_ARRAY) {
2080             if (arg1->arg_len == 1 && arg->arg_type != O_ITEM) {
2081                                                 /* assign to array */
2082                 arg[1].arg_flags |= AF_SPECIAL;
2083                 arg[2].arg_flags |= AF_SPECIAL;
2084             }
2085             else
2086                 arg1->arg_type = O_LARRAY;      /* assign to array elem */
2087         }
2088         else if (arg1->arg_type == O_HASH)
2089             arg1->arg_type = O_LHASH;
2090         else {
2091             sprintf(tokenbuf,
2092               "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
2093             yyerror(tokenbuf);
2094         }
2095         arg[1].arg_type = A_LEXPR;
2096 #ifdef DEBUGGING
2097         if (debug & 16)
2098             fprintf(stderr,"lval LEXPR\n");
2099 #endif
2100         return arg;
2101     }
2102
2103     /* not an array reference, should be a register name */
2104
2105     if (arg[1].arg_type != A_STAB && arg[1].arg_type != A_LVAL) {
2106         sprintf(tokenbuf,
2107           "Illegal item (%s) as lvalue",argname[arg[1].arg_type]);
2108         yyerror(tokenbuf);
2109     }
2110     arg[1].arg_type = A_LVAL;
2111 #ifdef DEBUGGING
2112     if (debug & 16)
2113         fprintf(stderr,"lval LVAL\n");
2114 #endif
2115     return arg;
2116 }
2117
2118 ARG *
2119 addflags(i,flags,arg)
2120 register ARG *arg;
2121 {
2122     arg[i].arg_flags |= flags;
2123     return arg;
2124 }
2125
2126 ARG *
2127 hide_ary(arg)
2128 ARG *arg;
2129 {
2130     if (arg->arg_type == O_ARRAY)
2131         return make_op(O_ITEM,1,arg,Nullarg,Nullarg,0);
2132     return arg;
2133 }
2134
2135 ARG *
2136 make_list(arg)
2137 register ARG *arg;
2138 {
2139     register int i;
2140     register ARG *node;
2141     register ARG *nxtnode;
2142     register int j;
2143     STR *tmpstr;
2144
2145     if (!arg) {
2146         arg = op_new(0);
2147         arg->arg_type = O_LIST;
2148     }
2149     if (arg->arg_type != O_COMMA) {
2150         arg->arg_flags |= AF_LISTISH;   /* see listish() below */
2151         return arg;
2152     }
2153     for (i = 2, node = arg; ; i++) {
2154         if (node->arg_len < 2)
2155             break;
2156         if (node[2].arg_type != A_EXPR)
2157             break;
2158         node = node[2].arg_ptr.arg_arg;
2159         if (node->arg_type != O_COMMA)
2160             break;
2161     }
2162     if (i > 2) {
2163         node = arg;
2164         arg = op_new(i);
2165         tmpstr = arg->arg_ptr.arg_str;
2166         *arg = *node;           /* copy everything except the STR */
2167         arg->arg_ptr.arg_str = tmpstr;
2168         for (j = 1; ; ) {
2169             arg[j++] = node[1];
2170             if (j >= i) {
2171                 arg[j] = node[2];
2172                 free_arg(node);
2173                 break;
2174             }
2175             nxtnode = node[2].arg_ptr.arg_arg;
2176             free_arg(node);
2177             node = nxtnode;
2178         }
2179     }
2180     arg->arg_type = O_LIST;
2181     arg->arg_len = i;
2182     return arg;
2183 }
2184
2185 /* turn a single item into a list */
2186
2187 ARG *
2188 listish(arg)
2189 ARG *arg;
2190 {
2191     if (arg->arg_flags & AF_LISTISH)
2192         arg = make_op(O_LIST,1,arg,Nullarg,Nullarg,0);
2193     return arg;
2194 }
2195
2196 ARG *
2197 stab_to_arg(atype,stab)
2198 int atype;
2199 register STAB *stab;
2200 {
2201     register ARG *arg;
2202
2203     arg = op_new(1);
2204     arg->arg_type = O_ITEM;
2205     arg[1].arg_type = atype;
2206     arg[1].arg_ptr.arg_stab = stab;
2207     return arg;
2208 }
2209
2210 ARG *
2211 cval_to_arg(cval)
2212 register char *cval;
2213 {
2214     register ARG *arg;
2215
2216     arg = op_new(1);
2217     arg->arg_type = O_ITEM;
2218     arg[1].arg_type = A_SINGLE;
2219     arg[1].arg_ptr.arg_str = str_make(cval);
2220     safefree(cval);
2221     return arg;
2222 }
2223
2224 ARG *
2225 op_new(numargs)
2226 int numargs;
2227 {
2228     register ARG *arg;
2229
2230     arg = (ARG*)safemalloc((numargs + 1) * sizeof (ARG));
2231     bzero((char *)arg, (numargs + 1) * sizeof (ARG));
2232     arg->arg_ptr.arg_str = str_new(0);
2233     arg->arg_len = numargs;
2234     return arg;
2235 }
2236
2237 void
2238 free_arg(arg)
2239 ARG *arg;
2240 {
2241     str_free(arg->arg_ptr.arg_str);
2242     safefree((char*)arg);
2243 }
2244
2245 ARG *
2246 make_match(type,expr,spat)
2247 int type;
2248 ARG *expr;
2249 SPAT *spat;
2250 {
2251     register ARG *arg;
2252
2253     arg = make_op(type,2,expr,Nullarg,Nullarg,0);
2254
2255     arg[2].arg_type = A_SPAT;
2256     arg[2].arg_ptr.arg_spat = spat;
2257 #ifdef DEBUGGING
2258     if (debug & 16)
2259         fprintf(stderr,"make_match SPAT=%lx\n",spat);
2260 #endif
2261
2262     if (type == O_SUBST || type == O_NSUBST) {
2263         if (arg[1].arg_type != A_STAB)
2264             yyerror("Illegal lvalue");
2265         arg[1].arg_type = A_LVAL;
2266     }
2267     return arg;
2268 }
2269
2270 ARG *
2271 cmd_to_arg(cmd)
2272 CMD *cmd;
2273 {
2274     register ARG *arg;
2275
2276     arg = op_new(1);
2277     arg->arg_type = O_ITEM;
2278     arg[1].arg_type = A_CMD;
2279     arg[1].arg_ptr.arg_cmd = cmd;
2280     return arg;
2281 }
2282
2283 CMD *
2284 wopt(cmd)
2285 register CMD *cmd;
2286 {
2287     register CMD *tail;
2288     register ARG *arg = cmd->c_expr;
2289     char *tmps; /* used by True macro */
2290
2291     /* hoist "while (<channel>)" up into command block */
2292
2293     if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
2294         cmd->c_flags &= ~CF_OPTIMIZE;   /* clear optimization type */
2295         cmd->c_flags |= CFT_GETS;       /* and set it to do the input */
2296         cmd->c_stab = arg[1].arg_ptr.arg_stab;
2297         if (arg[1].arg_ptr.arg_stab->stab_io->flags & IOF_ARGV) {
2298             cmd->c_expr = l(make_op(O_ASSIGN, 2,        /* fake up "$_ =" */
2299                stab_to_arg(A_LVAL,defstab), arg, Nullarg,1 ));
2300         }
2301         else {
2302             free_arg(arg);
2303             cmd->c_expr = Nullarg;
2304         }
2305     }
2306
2307     /* First find the end of the true list */
2308
2309     if (cmd->ucmd.ccmd.cc_true == Nullcmd)
2310         return cmd;
2311     for (tail = cmd->ucmd.ccmd.cc_true; tail->c_next; tail = tail->c_next) ;
2312
2313     /* if there's a continue block, link it to true block and find end */
2314
2315     if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
2316         tail->c_next = cmd->ucmd.ccmd.cc_alt;
2317         for ( ; tail->c_next; tail = tail->c_next) ;
2318     }
2319
2320     /* Here's the real trick: link the end of the list back to the beginning,
2321      * inserting a "last" block to break out of the loop.  This saves one or
2322      * two procedure calls every time through the loop, because of how cmd_exec
2323      * does tail recursion.
2324      */
2325
2326     tail->c_next = (CMD *) safemalloc(sizeof (CMD));
2327     tail = tail->c_next;
2328     if (!cmd->ucmd.ccmd.cc_alt)
2329         cmd->ucmd.ccmd.cc_alt = tail;   /* every loop has a continue now */
2330
2331     bcopy((char *)cmd, (char *)tail, sizeof(CMD));
2332     tail->c_type = C_EXPR;
2333     tail->c_flags ^= CF_INVERT;         /* turn into "last unless" */
2334     tail->c_next = tail->ucmd.ccmd.cc_true;     /* loop directly back to top */
2335     tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg,0);
2336     tail->ucmd.acmd.ac_stab = Nullstab;
2337     return cmd;
2338 }
2339
2340 FCMD *
2341 load_format()
2342 {
2343     FCMD froot;
2344     FCMD *flinebeg;
2345     register FCMD *fprev = &froot;
2346     register FCMD *fcmd;
2347     register char *s;
2348     register char *t;
2349     register char tmpchar;
2350     bool noblank;
2351
2352     while ((s = str_gets(linestr,rsfp)) != Nullch) {
2353         line++;
2354         if (strEQ(s,".\n")) {
2355             bufptr = s;
2356             return froot.f_next;
2357         }
2358         if (*s == '#')
2359             continue;
2360         flinebeg = Nullfcmd;
2361         noblank = FALSE;
2362         while (*s) {
2363             fcmd = (FCMD *)safemalloc(sizeof (FCMD));
2364             bzero((char*)fcmd, sizeof (FCMD));
2365             fprev->f_next = fcmd;
2366             fprev = fcmd;
2367             for (t=s; *t && *t != '@' && *t != '^'; t++) {
2368                 if (*t == '~') {
2369                     noblank = TRUE;
2370                     *t = ' ';
2371                 }
2372             }
2373             tmpchar = *t;
2374             *t = '\0';
2375             fcmd->f_pre = savestr(s);
2376             fcmd->f_presize = strlen(s);
2377             *t = tmpchar;
2378             s = t;
2379             if (!*s) {
2380                 if (noblank)
2381                     fcmd->f_flags |= FC_NOBLANK;
2382                 break;
2383             }
2384             if (!flinebeg)
2385                 flinebeg = fcmd;                /* start values here */
2386             if (*s++ == '^')
2387                 fcmd->f_flags |= FC_CHOP;       /* for doing text filling */
2388             switch (*s) {
2389             case '*':
2390                 fcmd->f_type = F_LINES;
2391                 *s = '\0';
2392                 break;
2393             case '<':
2394                 fcmd->f_type = F_LEFT;
2395                 while (*s == '<')
2396                     s++;
2397                 break;
2398             case '>':
2399                 fcmd->f_type = F_RIGHT;
2400                 while (*s == '>')
2401                     s++;
2402                 break;
2403             case '|':
2404                 fcmd->f_type = F_CENTER;
2405                 while (*s == '|')
2406                     s++;
2407                 break;
2408             default:
2409                 fcmd->f_type = F_LEFT;
2410                 break;
2411             }
2412             if (fcmd->f_flags & FC_CHOP && *s == '.') {
2413                 fcmd->f_flags |= FC_MORE;
2414                 while (*s == '.')
2415                     s++;
2416             }
2417             fcmd->f_size = s-t;
2418         }
2419         if (flinebeg) {
2420           again:
2421             if ((bufptr = str_gets(linestr ,rsfp)) == Nullch)
2422                 goto badform;
2423             line++;
2424             if (strEQ(bufptr,".\n")) {
2425                 yyerror("Missing values line");
2426                 return froot.f_next;
2427             }
2428             if (*bufptr == '#')
2429                 goto again;
2430             lex_newlines = TRUE;
2431             while (flinebeg || *bufptr) {
2432                 switch(yylex()) {
2433                 default:
2434                     yyerror("Bad value in format");
2435                     *bufptr = '\0';
2436                     break;
2437                 case '\n':
2438                     if (flinebeg)
2439                         yyerror("Missing value in format");
2440                     *bufptr = '\0';
2441                     break;
2442                 case REG:
2443                     yylval.arg = stab_to_arg(A_LVAL,yylval.stabval);
2444                     /* FALL THROUGH */
2445                 case RSTRING:
2446                     if (!flinebeg)
2447                         yyerror("Extra value in format");
2448                     else {
2449                         flinebeg->f_expr = yylval.arg;
2450                         do {
2451                             flinebeg = flinebeg->f_next;
2452                         } while (flinebeg && flinebeg->f_size == 0);
2453                     }
2454                     break;
2455                 case ',': case ';':
2456                     continue;
2457                 }
2458             }
2459             lex_newlines = FALSE;
2460         }
2461     }
2462   badform:
2463     bufptr = str_get(linestr);
2464     yyerror("Format not terminated");
2465     return froot.f_next;
2466 }