perly.c

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