perly.c

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