perly.c

   1 char rcsid[] = "$Header: perly.c,v 2.0 88/06/05 00:09:56 root Exp $";
   2 /*
   3  * $Log:        perly.c,v $
   4  * Revision 2.0  88/06/05  00:09:56  root
   5  * Baseline version 2.0.
   6  *
   7  */
   8
   9 #include "EXTERN.h"
  10 #include "perl.h"
  11 #include "perly.h"
  12
  13 extern char *tokename[];
  14 extern int yychar;
  15
  16 static int cmd_tosave();
  17 static int arg_tosave();
  18 static int spat_tosave();
  19
  20 main(argc,argv,env)
  21 register int argc;
  22 register char **argv;
  23 register char **env;
  24 {
  25     register STR *str;
  26     register char *s;
  27     char *index(), *strcpy(), *getenv();
  28     bool dosearch = FALSE;
  29
  30     uid = (int)getuid();
  31     euid = (int)geteuid();
  32     linestr = str_new(80);
  33     str_nset(linestr,"",0);
  34     str = str_make("");         /* first used for -I flags */
  35     incstab = aadd(stabent("INC",TRUE));
  36     for (argc--,argv++; argc; argc--,argv++) {
  37         if (argv[0][0] != '-' || !argv[0][1])
  38             break;
  39       reswitch:
  40         switch (argv[0][1]) {
  41         case 'a':
  42             minus_a = TRUE;
  43             strcpy(argv[0], argv[0]+1);
  44             goto reswitch;
  45 #ifdef DEBUGGING
  46         case 'D':
  47             debug = atoi(argv[0]+2);
  48 #ifdef YYDEBUG
  49             yydebug = (debug & 1);
  50 #endif
  51             break;
  52 #endif
  53         case 'e':
  54             if (!e_fp) {
  55                 e_tmpname = strcpy(safemalloc(sizeof(TMPPATH)),TMPPATH);
  56                 mktemp(e_tmpname);
  57                 e_fp = fopen(e_tmpname,"w");
  58             }
  59             if (argv[1])
  60                 fputs(argv[1],e_fp);
  61             putc('\n', e_fp);
  62             argc--,argv++;
  63             break;
  64         case 'i':
  65             inplace = savestr(argv[0]+2);
  66             argvoutstab = stabent("ARGVOUT",TRUE);
  67             break;
  68         case 'I':
  69             str_cat(str,argv[0]);
  70             str_cat(str," ");
  71             if (argv[0][2]) {
  72                 apush(incstab->stab_array,str_make(argv[0]+2));
  73             }
  74             else {
  75                 apush(incstab->stab_array,str_make(argv[1]));
  76                 str_cat(str,argv[1]);
  77                 argc--,argv++;
  78                 str_cat(str," ");
  79             }
  80             break;
  81         case 'n':
  82             minus_n = TRUE;
  83             strcpy(argv[0], argv[0]+1);
  84             goto reswitch;
  85         case 'p':
  86             minus_p = TRUE;
  87             strcpy(argv[0], argv[0]+1);
  88             goto reswitch;
  89         case 'P':
  90             preprocess = TRUE;
  91             strcpy(argv[0], argv[0]+1);
  92             goto reswitch;
  93         case 's':
  94             doswitches = TRUE;
  95             strcpy(argv[0], argv[0]+1);
  96             goto reswitch;
  97         case 'S':
  98             dosearch = TRUE;
  99             strcpy(argv[0], argv[0]+1);
 100             goto reswitch;
 101         case 'U':
 102             unsafe = TRUE;
 103             strcpy(argv[0], argv[0]+1);
 104             goto reswitch;
 105         case 'v':
 106             version();
 107             exit(0);
 108         case 'w':
 109             dowarn = TRUE;
 110             strcpy(argv[0], argv[0]+1);
 111             goto reswitch;
 112         case '-':
 113             argc--,argv++;
 114             goto switch_end;
 115         case 0:
 116             break;
 117         default:
 118             fatal("Unrecognized switch: %s",argv[0]);
 119         }
 120     }
 121   switch_end:
 122     if (e_fp) {
 123         fclose(e_fp);
 124         argc++,argv--;
 125         argv[0] = e_tmpname;
 126     }
 127 #ifndef PRIVLIB
 128 #define PRIVLIB "/usr/local/lib/perl"
 129 #endif
 130     apush(incstab->stab_array,str_make(PRIVLIB));
 131
 132     str_set(&str_no,No);
 133     str_set(&str_yes,Yes);
 134     init_eval();
 135
 136     /* open script */
 137
 138     if (argv[0] == Nullch)
 139         argv[0] = "-";
 140     if (dosearch && argv[0][0] != '/' && (s = getenv("PATH"))) {
 141         char *xfound = Nullch, *xfailed = Nullch;
 142
 143         while (*s) {
 144             s = cpytill(tokenbuf,s,':');
 145             if (*s)
 146                 s++;
 147             if (tokenbuf[0])
 148                 strcat(tokenbuf,"/");
 149             strcat(tokenbuf,argv[0]);
 150 #ifdef DEBUGGING
 151             if (debug & 1)
 152                 fprintf(stderr,"Looking for %s\n",tokenbuf);
 153 #endif
 154             if (stat(tokenbuf,&statbuf) < 0)            /* not there? */
 155                 continue;
 156             if ((statbuf.st_mode & S_IFMT) == S_IFREG
 157              && cando(S_IREAD,TRUE) && cando(S_IEXEC,TRUE)) {
 158                 xfound = tokenbuf;              /* bingo! */
 159                 break;
 160             }
 161             if (!xfailed)
 162                 xfailed = savestr(tokenbuf);
 163         }
 164         if (!xfound)
 165             fatal("Can't execute %s", xfailed);
 166         if (xfailed)
 167             safefree(xfailed);
 168         argv[0] = savestr(xfound);
 169     }
 170     filename = savestr(argv[0]);
 171     origfilename = savestr(filename);
 172     if (strEQ(filename,"-"))
 173         argv[0] = "";
 174     if (preprocess) {
 175         str_cat(str,"-I");
 176         str_cat(str,PRIVLIB);
 177         sprintf(buf, "\
 178 /bin/sed -e '/^[^#]/b' \
 179  -e '/^#[       ]*include[      ]/b' \
 180  -e '/^#[       ]*define[       ]/b' \
 181  -e '/^#[       ]*if[   ]/b' \
 182  -e '/^#[       ]*ifdef[        ]/b' \
 183  -e '/^#[       ]*ifndef[       ]/b' \
 184  -e '/^#[       ]*else/b' \
 185  -e '/^#[       ]*endif/b' \
 186  -e 's/^#.*//' \
 187  %s | %s -C %s %s",
 188           argv[0], CPPSTDIN, str_get(str), CPPMINUS);
 189         rsfp = popen(buf,"r");
 190     }
 191     else if (!*argv[0])
 192         rsfp = stdin;
 193     else
 194         rsfp = fopen(argv[0],"r");
 195     if (rsfp == Nullfp)
 196         fatal("Perl script \"%s\" doesn't seem to exist",filename);
 197     str_free(str);              /* free -I directories */
 198
 199     defstab = stabent("_",TRUE);
 200
 201     /* init tokener */
 202
 203     bufptr = str_get(linestr);
 204
 205     /* now parse the report spec */
 206
 207     if (yyparse())
 208         fatal("Execution aborted due to compilation errors.\n");
 209
 210     if (dowarn) {
 211         stab_check('A','Z');
 212         stab_check('a','z');
 213     }
 214
 215     preprocess = FALSE;
 216     if (e_fp) {
 217         e_fp = Nullfp;
 218         UNLINK(e_tmpname);
 219     }
 220     argc--,argv++;      /* skip name of script */
 221     if (doswitches) {
 222         for (; argc > 0 && **argv == '-'; argc--,argv++) {
 223             if (argv[0][1] == '-') {
 224                 argc--,argv++;
 225                 break;
 226             }
 227             str_numset(stabent(argv[0]+1,TRUE)->stab_val,(double)1.0);
 228         }
 229     }
 230     if (argvstab = stabent("ARGV",allstabs)) {
 231         aadd(argvstab);
 232         for (; argc > 0; argc--,argv++) {
 233             apush(argvstab->stab_array,str_make(argv[0]));
 234         }
 235     }
 236     if (envstab = stabent("ENV",allstabs)) {
 237         hadd(envstab);
 238         for (; *env; env++) {
 239             if (!(s = index(*env,'=')))
 240                 continue;
 241             *s++ = '\0';
 242             str = str_make(s);
 243             str->str_link.str_magic = envstab;
 244             hstore(envstab->stab_hash,*env,str);
 245             *--s = '=';
 246         }
 247     }
 248     if (sigstab = stabent("SIG",allstabs))
 249         hadd(sigstab);
 250
 251     magicalize("!#?^~=-%0123456789.+&*()<>,\\/[|");
 252
 253     sawampersand = (stabent("&",FALSE) != Nullstab);
 254     if (tmpstab = stabent("0",allstabs))
 255         str_set(STAB_STR(tmpstab),origfilename);
 256     if (tmpstab = stabent("$",allstabs))
 257         str_numset(STAB_STR(tmpstab),(double)getpid());
 258
 259     tmpstab = stabent("stdin",TRUE);
 260     tmpstab->stab_io = stio_new();
 261     tmpstab->stab_io->fp = stdin;
 262
 263     tmpstab = stabent("stdout",TRUE);
 264     tmpstab->stab_io = stio_new();
 265     tmpstab->stab_io->fp = stdout;
 266     defoutstab = tmpstab;
 267     curoutstab = tmpstab;
 268
 269     tmpstab = stabent("stderr",TRUE);
 270     tmpstab->stab_io = stio_new();
 271     tmpstab->stab_io->fp = stderr;
 272
 273     savestack = anew(Nullstab);         /* for saving non-local values */
 274
 275     setjmp(top_env);    /* sets goto_targ on longjump */
 276
 277 #ifdef DEBUGGING
 278     if (debug & 1024)
 279         dump_cmd(main_root,Nullcmd);
 280     if (debug)
 281         fprintf(stderr,"\nEXECUTING...\n\n");
 282 #endif
 283
 284     /* do it */
 285
 286     (void) cmd_exec(main_root);
 287
 288     if (goto_targ)
 289         fatal("Can't find label \"%s\"--aborting",goto_targ);
 290     exit(0);
 291     /* NOTREACHED */
 292 }
 293
 294 magicalize(list)
 295 register char *list;
 296 {
 297     register STAB *stab;
 298     char sym[2];
 299
 300     sym[1] = '\0';
 301     while (*sym = *list++) {
 302         if (stab = stabent(sym,allstabs)) {
 303             stab->stab_flags = SF_VMAGIC;
 304             stab->stab_val->str_link.str_magic = stab;
 305         }
 306     }
 307 }
 308
 309 ARG *
 310 make_split(stab,arg)
 311 register STAB *stab;
 312 register ARG *arg;
 313 {
 314     register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT));
 315
 316     if (arg->arg_type != O_MATCH) {
 317         spat = (SPAT *) safemalloc(sizeof (SPAT));
 318         bzero((char *)spat, sizeof(SPAT));
 319         spat->spat_next = spat_root;    /* link into spat list */
 320         spat_root = spat;
 321
 322         spat->spat_runtime = arg;
 323         arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
 324     }
 325     arg->arg_type = O_SPLIT;
 326     spat = arg[2].arg_ptr.arg_spat;
 327     spat->spat_repl = stab2arg(A_STAB,aadd(stab));
 328     if (spat->spat_short) {     /* exact match can bypass regexec() */
 329         if (!((spat->spat_flags & SPAT_SCANFIRST) &&
 330             (spat->spat_flags & SPAT_ALL) )) {
 331             str_free(spat->spat_short);
 332             spat->spat_short = Nullstr;
 333         }
 334     }
 335     return arg;
 336 }
 337
 338 SUBR *
 339 make_sub(name,cmd)
 340 char *name;
 341 CMD *cmd;
 342 {
 343     register SUBR *sub = (SUBR *) safemalloc(sizeof (SUBR));
 344     STAB *stab = stabent(name,TRUE);
 345
 346     if (stab->stab_sub) {
 347         if (dowarn) {
 348             line_t oldline = line;
 349
 350             if (cmd)
 351                 line = cmd->c_line;
 352             warn("Subroutine %s redefined",name);
 353             line = oldline;
 354         }
 355         cmd_free(stab->stab_sub->cmd);
 356         afree(stab->stab_sub->tosave);
 357         safefree((char*)stab->stab_sub);
 358     }
 359     bzero((char *)sub, sizeof(SUBR));
 360     sub->cmd = cmd;
 361     sub->filename = filename;
 362     tosave = anew(Nullstab);
 363     tosave->ary_fill = 0;       /* make 1 based */
 364     cmd_tosave(cmd);            /* this builds the tosave array */
 365     sub->tosave = tosave;
 366     stab->stab_sub = sub;
 367 }
 368
 369 CMD *
 370 block_head(tail)
 371 register CMD *tail;
 372 {
 373     if (tail == Nullcmd) {
 374         return tail;
 375     }
 376     return tail->c_head;
 377 }
 378
 379 CMD *
 380 append_line(head,tail)
 381 register CMD *head;
 382 register CMD *tail;
 383 {
 384     if (tail == Nullcmd)
 385         return head;
 386     if (!tail->c_head)                  /* make sure tail is well formed */
 387         tail->c_head = tail;
 388     if (head != Nullcmd) {
 389         tail = tail->c_head;            /* get to start of tail list */
 390         if (!head->c_head)
 391             head->c_head = head;        /* start a new head list */
 392         while (head->c_next) {
 393             head->c_next->c_head = head->c_head;
 394             head = head->c_next;        /* get to end of head list */
 395         }
 396         head->c_next = tail;            /* link to end of old list */
 397         tail->c_head = head->c_head;    /* propagate head pointer */
 398     }
 399     while (tail->c_next) {
 400         tail->c_next->c_head = tail->c_head;
 401         tail = tail->c_next;
 402     }
 403     return tail;
 404 }
 405
 406 CMD *
 407 make_acmd(type,stab,cond,arg)
 408 int type;
 409 STAB *stab;
 410 ARG *cond;
 411 ARG *arg;
 412 {
 413     register CMD *cmd = (CMD *) safemalloc(sizeof (CMD));
 414
 415     bzero((char *)cmd, sizeof(CMD));
 416     cmd->c_type = type;
 417     cmd->ucmd.acmd.ac_stab = stab;
 418     cmd->ucmd.acmd.ac_expr = arg;
 419     cmd->c_expr = cond;
 420     if (cond) {
 421         opt_arg(cmd,1,1);
 422         cmd->c_flags |= CF_COND;
 423     }
 424     if (cmdline != NOLINE) {
 425         cmd->c_line = cmdline;
 426         cmdline = NOLINE;
 427     }
 428     cmd->c_file = filename;
 429     return cmd;
 430 }
 431
 432 CMD *
 433 make_ccmd(type,arg,cblock)
 434 int type;
 435 register ARG *arg;
 436 struct compcmd cblock;
 437 {
 438     register CMD *cmd = (CMD *) safemalloc(sizeof (CMD));
 439
 440     bzero((char *)cmd, sizeof(CMD));
 441     cmd->c_type = type;
 442     cmd->c_expr = arg;
 443     cmd->ucmd.ccmd.cc_true = cblock.comp_true;
 444     cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
 445     if (arg) {
 446         opt_arg(cmd,1,0);
 447         cmd->c_flags |= CF_COND;
 448     }
 449     if (cmdline != NOLINE) {
 450         cmd->c_line = cmdline;
 451         cmdline = NOLINE;
 452     }
 453     return cmd;
 454 }
 455
 456 void
 457 opt_arg(cmd,fliporflop,acmd)
 458 register CMD *cmd;
 459 int fliporflop;
 460 int acmd;
 461 {
 462     register ARG *arg;
 463     int opt = CFT_EVAL;
 464     int sure = 0;
 465     ARG *arg2;
 466     char *tmps; /* for True macro */
 467     int context = 0;    /* 0 = normal, 1 = before &&, 2 = before || */
 468     int flp = fliporflop;
 469
 470     if (!cmd)
 471         return;
 472     arg = cmd->c_expr;
 473
 474     /* Can we turn && and || into if and unless? */
 475
 476     if (acmd && !cmd->ucmd.acmd.ac_expr &&
 477       (arg->arg_type == O_AND || arg->arg_type == O_OR) ) {
 478         dehoist(arg,1);
 479         dehoist(arg,2);
 480         cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg;
 481         cmd->c_expr = arg[1].arg_ptr.arg_arg;
 482         if (arg->arg_type == O_OR)
 483             cmd->c_flags ^= CF_INVERT;          /* || is like unless */
 484         arg->arg_len = 0;
 485         arg_free(arg);
 486         arg = cmd->c_expr;
 487     }
 488
 489     /* Turn "if (!expr)" into "unless (expr)" */
 490
 491     while (arg->arg_type == O_NOT) {
 492         dehoist(arg,1);
 493         cmd->c_flags ^= CF_INVERT;              /* flip sense of cmd */
 494         cmd->c_expr = arg[1].arg_ptr.arg_arg;   /* hoist the rest of expr */
 495         free_arg(arg);
 496         arg = cmd->c_expr;                      /* here we go again */
 497     }
 498
 499     if (!arg->arg_len) {                /* sanity check */
 500         cmd->c_flags |= opt;
 501         return;
 502     }
 503
 504     /* for "cond .. cond" we set up for the initial check */
 505
 506     if (arg->arg_type == O_FLIP)
 507         context |= 4;
 508
 509     /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
 510
 511     if (arg->arg_type == O_AND)
 512         context |= 1;
 513     else if (arg->arg_type == O_OR)
 514         context |= 2;
 515     if (context && arg[flp].arg_type == A_EXPR) {
 516         arg = arg[flp].arg_ptr.arg_arg;
 517         flp = 1;
 518     }
 519
 520     if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
 521         cmd->c_flags |= opt;
 522         return;                         /* side effect, can't optimize */
 523     }
 524
 525     if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
 526       arg->arg_type == O_AND || arg->arg_type == O_OR) {
 527         if (arg[flp].arg_type == A_SINGLE) {
 528             opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
 529             cmd->c_short = arg[flp].arg_ptr.arg_str;
 530             goto literal;
 531         }
 532         else if (arg[flp].arg_type == A_STAB || arg[flp].arg_type == A_LVAL) {
 533             cmd->c_stab  = arg[flp].arg_ptr.arg_stab;
 534             opt = CFT_REG;
 535           literal:
 536             if (!context) {     /* no && or ||? */
 537                 free_arg(arg);
 538                 cmd->c_expr = Nullarg;
 539             }
 540             if (!(context & 1))
 541                 cmd->c_flags |= CF_EQSURE;
 542             if (!(context & 2))
 543                 cmd->c_flags |= CF_NESURE;
 544         }
 545     }
 546     else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
 547              arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
 548         if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
 549                 arg[2].arg_type == A_SPAT &&
 550                 arg[2].arg_ptr.arg_spat->spat_short ) {
 551             cmd->c_stab  = arg[1].arg_ptr.arg_stab;
 552             cmd->c_short = arg[2].arg_ptr.arg_spat->spat_short;
 553             cmd->c_slen  = arg[2].arg_ptr.arg_spat->spat_slen;
 554             if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL &&
 555                 !(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) &&
 556                 (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
 557                 sure |= CF_EQSURE;              /* (SUBST must be forced even */
 558                                                 /* if we know it will work.) */
 559             arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
 560             arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
 561             sure |= CF_NESURE;          /* normally only sure if it fails */
 562             if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
 563                 cmd->c_flags |= CF_FIRSTNEG;
 564             if (context & 1) {          /* only sure if thing is false */
 565                 if (cmd->c_flags & CF_FIRSTNEG)
 566                     sure &= ~CF_NESURE;
 567                 else
 568                     sure &= ~CF_EQSURE;
 569             }
 570             else if (context & 2) {     /* only sure if thing is true */
 571                 if (cmd->c_flags & CF_FIRSTNEG)
 572                     sure &= ~CF_EQSURE;
 573                 else
 574                     sure &= ~CF_NESURE;
 575             }
 576             if (sure & (CF_EQSURE|CF_NESURE)) { /* if we know anything*/
 577                 if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
 578                     opt = CFT_SCAN;
 579                 else
 580                     opt = CFT_ANCHOR;
 581                 if (sure == (CF_EQSURE|CF_NESURE)       /* really sure? */
 582                     && arg->arg_type == O_MATCH
 583                     && context & 4
 584                     && fliporflop == 1) {
 585                     spat_free(arg[2].arg_ptr.arg_spat);
 586                     arg[2].arg_ptr.arg_spat = Nullspat; /* don't do twice */
 587                 }
 588                 cmd->c_flags |= sure;
 589             }
 590         }
 591     }
 592     else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
 593              arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
 594         if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
 595             if (arg[2].arg_type == A_SINGLE) {
 596                 cmd->c_stab  = arg[1].arg_ptr.arg_stab;
 597                 cmd->c_short = arg[2].arg_ptr.arg_str;
 598                 cmd->c_slen  = 30000;
 599                 switch (arg->arg_type) {
 600                 case O_SLT: case O_SGT:
 601                     sure |= CF_EQSURE;
 602                     cmd->c_flags |= CF_FIRSTNEG;
 603                     break;
 604                 case O_SNE:
 605                     cmd->c_flags |= CF_FIRSTNEG;
 606                     /* FALL THROUGH */
 607                 case O_SEQ:
 608                     sure |= CF_NESURE|CF_EQSURE;
 609                     break;
 610                 }
 611                 if (context & 1) {      /* only sure if thing is false */
 612                     if (cmd->c_flags & CF_FIRSTNEG)
 613                         sure &= ~CF_NESURE;
 614                     else
 615                         sure &= ~CF_EQSURE;
 616                 }
 617                 else if (context & 2) { /* only sure if thing is true */
 618                     if (cmd->c_flags & CF_FIRSTNEG)
 619                         sure &= ~CF_EQSURE;
 620                     else
 621                         sure &= ~CF_NESURE;
 622                 }
 623                 if (sure & (CF_EQSURE|CF_NESURE)) {
 624                     opt = CFT_STROP;
 625                     cmd->c_flags |= sure;
 626                 }
 627             }
 628         }
 629     }
 630     else if (arg->arg_type == O_EQ || arg->arg_type == O_NE ||
 631              arg->arg_type == O_LE || arg->arg_type == O_GE ||
 632              arg->arg_type == O_LT || arg->arg_type == O_GT) {
 633         if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
 634             if (arg[2].arg_type == A_SINGLE) {
 635                 cmd->c_stab  = arg[1].arg_ptr.arg_stab;
 636                 cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str));
 637                 cmd->c_slen = arg->arg_type;
 638                 sure |= CF_NESURE|CF_EQSURE;
 639                 if (context & 1) {      /* only sure if thing is false */
 640                     sure &= ~CF_EQSURE;
 641                 }
 642                 else if (context & 2) { /* only sure if thing is true */
 643                     sure &= ~CF_NESURE;
 644                 }
 645                 if (sure & (CF_EQSURE|CF_NESURE)) {
 646                     opt = CFT_NUMOP;
 647                     cmd->c_flags |= sure;
 648                 }
 649             }
 650         }
 651     }
 652     else if (arg->arg_type == O_ASSIGN &&
 653              (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
 654              arg[1].arg_ptr.arg_stab == defstab &&
 655              arg[2].arg_type == A_EXPR ) {
 656         arg2 = arg[2].arg_ptr.arg_arg;
 657         if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
 658             opt = CFT_GETS;
 659             cmd->c_stab = arg2[1].arg_ptr.arg_stab;
 660             if (!(arg2[1].arg_ptr.arg_stab->stab_io->flags & IOF_ARGV)) {
 661                 free_arg(arg2);
 662                 free_arg(arg);
 663                 cmd->c_expr = Nullarg;
 664             }
 665         }
 666     }
 667     else if (arg->arg_type == O_CHOP &&
 668              (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
 669         opt = CFT_CHOP;
 670         cmd->c_stab = arg[1].arg_ptr.arg_stab;
 671         free_arg(arg);
 672         cmd->c_expr = Nullarg;
 673     }
 674     if (context & 4)
 675         opt |= CF_FLIP;
 676     cmd->c_flags |= opt;
 677
 678     if (cmd->c_flags & CF_FLIP) {
 679         if (fliporflop == 1) {
 680             arg = cmd->c_expr;  /* get back to O_FLIP arg */
 681             arg[3].arg_ptr.arg_cmd = (CMD*)safemalloc(sizeof(CMD));
 682             bcopy((char *)cmd, (char *)arg[3].arg_ptr.arg_cmd, sizeof(CMD));
 683             arg[4].arg_ptr.arg_cmd = (CMD*)safemalloc(sizeof(CMD));
 684             bcopy((char *)cmd, (char *)arg[4].arg_ptr.arg_cmd, sizeof(CMD));
 685             opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd);
 686             arg->arg_len = 2;           /* this is a lie */
 687         }
 688         else {
 689             if ((opt & CF_OPTIMIZE) == CFT_EVAL)
 690                 cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
 691         }
 692     }
 693 }
 694
 695 ARG *
 696 mod_match(type,left,pat)
 697 register ARG *left;
 698 register ARG *pat;
 699 {
 700
 701     register SPAT *spat;
 702     register ARG *newarg;
 703
 704     if ((pat->arg_type == O_MATCH ||
 705          pat->arg_type == O_SUBST ||
 706          pat->arg_type == O_TRANS ||
 707          pat->arg_type == O_SPLIT
 708         ) &&
 709         pat[1].arg_ptr.arg_stab == defstab ) {
 710         switch (pat->arg_type) {
 711         case O_MATCH:
 712             newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH,
 713                 pat->arg_len,
 714                 left,Nullarg,Nullarg,0);
 715             break;
 716         case O_SUBST:
 717             newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST,
 718                 pat->arg_len,
 719                 left,Nullarg,Nullarg,0));
 720             break;
 721         case O_TRANS:
 722             newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS,
 723                 pat->arg_len,
 724                 left,Nullarg,Nullarg,0));
 725             break;
 726         case O_SPLIT:
 727             newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT,
 728                 pat->arg_len,
 729                 left,Nullarg,Nullarg,0);
 730             break;
 731         }
 732         if (pat->arg_len >= 2) {
 733             newarg[2].arg_type = pat[2].arg_type;
 734             newarg[2].arg_ptr = pat[2].arg_ptr;
 735             newarg[2].arg_flags = pat[2].arg_flags;
 736             if (pat->arg_len >= 3) {
 737                 newarg[3].arg_type = pat[3].arg_type;
 738                 newarg[3].arg_ptr = pat[3].arg_ptr;
 739                 newarg[3].arg_flags = pat[3].arg_flags;
 740             }
 741         }
 742         safefree((char*)pat);
 743     }
 744     else {
 745         spat = (SPAT *) safemalloc(sizeof (SPAT));
 746         bzero((char *)spat, sizeof(SPAT));
 747         spat->spat_next = spat_root;    /* link into spat list */
 748         spat_root = spat;
 749
 750         spat->spat_runtime = pat;
 751         newarg = make_op(type,2,left,Nullarg,Nullarg,0);
 752         newarg[2].arg_type = A_SPAT;
 753         newarg[2].arg_ptr.arg_spat = spat;
 754         newarg[2].arg_flags = AF_SPECIAL;
 755     }
 756
 757     return newarg;
 758 }
 759
 760 CMD *
 761 add_label(lbl,cmd)
 762 char *lbl;
 763 register CMD *cmd;
 764 {
 765     if (cmd)
 766         cmd->c_label = lbl;
 767     return cmd;
 768 }
 769
 770 CMD *
 771 addcond(cmd, arg)
 772 register CMD *cmd;
 773 register ARG *arg;
 774 {
 775     cmd->c_expr = arg;
 776     opt_arg(cmd,1,0);
 777     cmd->c_flags |= CF_COND;
 778     return cmd;
 779 }
 780
 781 CMD *
 782 addloop(cmd, arg)
 783 register CMD *cmd;
 784 register ARG *arg;
 785 {
 786     cmd->c_expr = arg;
 787     opt_arg(cmd,1,0);
 788     cmd->c_flags |= CF_COND|CF_LOOP;
 789     if (cmd->c_type == C_BLOCK)
 790         cmd->c_flags &= ~CF_COND;
 791     else {
 792         arg = cmd->ucmd.acmd.ac_expr;
 793         if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
 794             cmd->c_flags &= ~CF_COND;  /* "do {} while" happens at least once */
 795         if (arg && arg->arg_type == O_SUBR)
 796             cmd->c_flags &= ~CF_COND;  /* likewise for "do subr() while" */
 797     }
 798     return cmd;
 799 }
 800
 801 CMD *
 802 invert(cmd)
 803 register CMD *cmd;
 804 {
 805     cmd->c_flags ^= CF_INVERT;
 806     return cmd;
 807 }
 808
 809 yyerror(s)
 810 char *s;
 811 {
 812     char tmpbuf[128];
 813     char *tname = tmpbuf;
 814
 815     if (yychar > 256) {
 816         tname = tokename[yychar-256];
 817         if (strEQ(tname,"word"))
 818             strcpy(tname,tokenbuf);
 819         else if (strEQ(tname,"register"))
 820             sprintf(tname,"$%s",tokenbuf);
 821         else if (strEQ(tname,"array_length"))
 822             sprintf(tname,"$#%s",tokenbuf);
 823     }
 824     else if (!yychar)
 825         strcpy(tname,"EOF");
 826     else if (yychar < 32)
 827         sprintf(tname,"^%c",yychar+64);
 828     else if (yychar == 127)
 829         strcpy(tname,"^?");
 830     else
 831         sprintf(tname,"%c",yychar);
 832     sprintf(tokenbuf, "%s in file %s at line %d, next token \"%s\"\n",
 833       s,filename,line,tname);
 834     if (in_eval)
 835         str_set(stabent("@",TRUE)->stab_val,tokenbuf);
 836     else
 837         fputs(tokenbuf,stderr);
 838 }
 839
 840 ARG *
 841 make_op(type,newlen,arg1,arg2,arg3,dolist)
 842 int type;
 843 int newlen;
 844 ARG *arg1;
 845 ARG *arg2;
 846 ARG *arg3;
 847 int dolist;
 848 {
 849     register ARG *arg;
 850     register ARG *chld;
 851     register int doarg;
 852
 853     arg = op_new(newlen);
 854     arg->arg_type = type;
 855     doarg = opargs[type];
 856     if (chld = arg1) {
 857         if (!(doarg & 1))
 858             arg[1].arg_flags |= AF_SPECIAL;
 859         if (doarg & 16)
 860             arg[1].arg_flags |= AF_NUMERIC;
 861         if (chld->arg_type == O_ITEM &&
 862             (hoistable[chld[1].arg_type] || chld[1].arg_type == A_LVAL) ) {
 863             arg[1].arg_type = chld[1].arg_type;
 864             arg[1].arg_ptr = chld[1].arg_ptr;
 865             arg[1].arg_flags |= chld[1].arg_flags;
 866             free_arg(chld);
 867         }
 868         else {
 869             arg[1].arg_type = A_EXPR;
 870             arg[1].arg_ptr.arg_arg = chld;
 871             if (dolist & 1) {
 872                 if (chld->arg_type == O_LIST) {
 873                     if (newlen == 1) {  /* we can hoist entire list */
 874                         chld->arg_type = type;
 875                         free_arg(arg);
 876                         arg = chld;
 877                     }
 878                     else {
 879                         arg[1].arg_flags |= AF_SPECIAL;
 880                     }
 881                 }
 882                 else {
 883                     switch (chld->arg_type) {
 884                     case O_ARRAY:
 885                         if (chld->arg_len == 1)
 886                             arg[1].arg_flags |= AF_SPECIAL;
 887                         break;
 888                     case O_ITEM:
 889                         if (chld[1].arg_type == A_READ ||
 890                             chld[1].arg_type == A_INDREAD ||
 891                             chld[1].arg_type == A_GLOB)
 892                             arg[1].arg_flags |= AF_SPECIAL;
 893                         break;
 894                     case O_SPLIT:
 895                     case O_TMS:
 896                     case O_EACH:
 897                     case O_VALUES:
 898                     case O_KEYS:
 899                     case O_SORT:
 900                         arg[1].arg_flags |= AF_SPECIAL;
 901                         break;
 902                     }
 903                 }
 904             }
 905         }
 906     }
 907     if (chld = arg2) {
 908         if (!(doarg & 2))
 909             arg[2].arg_flags |= AF_SPECIAL;
 910         if (doarg & 32)
 911             arg[2].arg_flags |= AF_NUMERIC;
 912         if (chld->arg_type == O_ITEM &&
 913             (hoistable[chld[1].arg_type] ||
 914              (type == O_ASSIGN &&
 915               ((chld[1].arg_type == A_READ && !(arg[1].arg_flags & AF_SPECIAL))
 916                 ||
 917                (chld[1].arg_type == A_INDREAD && !(arg[1].arg_flags & AF_SPECIAL))
 918                 ||
 919                (chld[1].arg_type == A_GLOB && !(arg[1].arg_flags & AF_SPECIAL))
 920                 ||
 921                chld[1].arg_type == A_BACKTICK ) ) ) ) {
 922             arg[2].arg_type = chld[1].arg_type;
 923             arg[2].arg_ptr = chld[1].arg_ptr;
 924             free_arg(chld);
 925         }
 926         else {
 927             arg[2].arg_type = A_EXPR;
 928             arg[2].arg_ptr.arg_arg = chld;
 929             if ((dolist & 2) &&
 930               (chld->arg_type == O_LIST ||
 931                (chld->arg_type == O_ARRAY && chld->arg_len == 1) ))
 932                 arg[2].arg_flags |= AF_SPECIAL;
 933         }
 934     }
 935     if (chld = arg3) {
 936         if (!(doarg & 4))
 937             arg[3].arg_flags |= AF_SPECIAL;
 938         if (doarg & 64)
 939             arg[3].arg_flags |= AF_NUMERIC;
 940         if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
 941             arg[3].arg_type = chld[1].arg_type;
 942             arg[3].arg_ptr = chld[1].arg_ptr;
 943             free_arg(chld);
 944         }
 945         else {
 946             arg[3].arg_type = A_EXPR;
 947             arg[3].arg_ptr.arg_arg = chld;
 948             if ((dolist & 4) &&
 949               (chld->arg_type == O_LIST ||
 950                (chld->arg_type == O_ARRAY && chld->arg_len == 1) ))
 951                 arg[3].arg_flags |= AF_SPECIAL;
 952         }
 953     }
 954 #ifdef DEBUGGING
 955     if (debug & 16) {
 956         fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
 957         if (arg1)
 958             fprintf(stderr,",%s=%lx",
 959                 argname[arg[1].arg_type],arg[1].arg_ptr.arg_arg);
 960         if (arg2)
 961             fprintf(stderr,",%s=%lx",
 962                 argname[arg[2].arg_type],arg[2].arg_ptr.arg_arg);
 963         if (arg3)
 964             fprintf(stderr,",%s=%lx",
 965                 argname[arg[3].arg_type],arg[3].arg_ptr.arg_arg);
 966         fprintf(stderr,")\n");
 967     }
 968 #endif
 969     evalstatic(arg);            /* see if we can consolidate anything */
 970     return arg;
 971 }
 972
 973 /* turn 123 into 123 == $. */
 974
 975 ARG *
 976 flipflip(arg)
 977 register ARG *arg;
 978 {
 979     if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_SINGLE) {
 980         arg = (ARG*)saferealloc((char*)arg,3*sizeof(ARG));
 981         arg->arg_type = O_EQ;
 982         arg->arg_len = 2;
 983         arg[2].arg_type = A_STAB;
 984         arg[2].arg_flags = 0;
 985         arg[2].arg_ptr.arg_stab = stabent(".",TRUE);
 986     }
 987     return arg;
 988 }
 989
 990 void
 991 evalstatic(arg)
 992 register ARG *arg;
 993 {
 994     register STR *str;
 995     register STR *s1;
 996     register STR *s2;
 997     double value;               /* must not be register */
 998     register char *tmps;
 999     int i;
1000     unsigned long tmplong;
1001     double exp(), log(), sqrt(), modf();
1002     char *crypt();
1003
1004     if (!arg || !arg->arg_len)
1005         return;
1006
1007     if (arg[1].arg_type == A_SINGLE &&
1008         (arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) {
1009         str = str_new(0);
1010         s1 = arg[1].arg_ptr.arg_str;
1011         if (arg->arg_len > 1)
1012             s2 = arg[2].arg_ptr.arg_str;
1013         else
1014             s2 = Nullstr;
1015         switch (arg->arg_type) {
1016         default:
1017             str_free(str);
1018             str = Nullstr;              /* can't be evaluated yet */
1019             break;
1020         case O_CONCAT:
1021             str_sset(str,s1);
1022             str_scat(str,s2);
1023             break;
1024         case O_REPEAT:
1025             i = (int)str_gnum(s2);
1026             while (i-- > 0)
1027                 str_scat(str,s1);
1028             break;
1029         case O_MULTIPLY:
1030             value = str_gnum(s1);
1031             str_numset(str,value * str_gnum(s2));
1032             break;
1033         case O_DIVIDE:
1034             value = str_gnum(s2);
1035             if (value == 0.0)
1036                 fatal("Illegal division by constant zero");
1037             str_numset(str,str_gnum(s1) / value);
1038             break;
1039         case O_MODULO:
1040             tmplong = (unsigned long)str_gnum(s2);
1041             if (tmplong == 0L)
1042                 fatal("Illegal modulus of constant zero");
1043             str_numset(str,(double)(((unsigned long)str_gnum(s1)) % tmplong));
1044             break;
1045         case O_ADD:
1046             value = str_gnum(s1);
1047             str_numset(str,value + str_gnum(s2));
1048             break;
1049         case O_SUBTRACT:
1050             value = str_gnum(s1);
1051             str_numset(str,value - str_gnum(s2));
1052             break;
1053         case O_LEFT_SHIFT:
1054             value = str_gnum(s1);
1055             i = (int)str_gnum(s2);
1056             str_numset(str,(double)(((unsigned long)value) << i));
1057             break;
1058         case O_RIGHT_SHIFT:
1059             value = str_gnum(s1);
1060             i = (int)str_gnum(s2);
1061             str_numset(str,(double)(((unsigned long)value) >> i));
1062             break;
1063         case O_LT:
1064             value = str_gnum(s1);
1065             str_numset(str,(double)(value < str_gnum(s2)));
1066             break;
1067         case O_GT:
1068             value = str_gnum(s1);
1069             str_numset(str,(double)(value > str_gnum(s2)));
1070             break;
1071         case O_LE:
1072             value = str_gnum(s1);
1073             str_numset(str,(double)(value <= str_gnum(s2)));
1074             break;
1075         case O_GE:
1076             value = str_gnum(s1);
1077             str_numset(str,(double)(value >= str_gnum(s2)));
1078             break;
1079         case O_EQ:
1080             value = str_gnum(s1);
1081             str_numset(str,(double)(value == str_gnum(s2)));
1082             break;
1083         case O_NE:
1084             value = str_gnum(s1);
1085             str_numset(str,(double)(value != str_gnum(s2)));
1086             break;
1087         case O_BIT_AND:
1088             value = str_gnum(s1);
1089             str_numset(str,(double)(((unsigned long)value) &
1090                 ((unsigned long)str_gnum(s2))));
1091             break;
1092         case O_XOR:
1093             value = str_gnum(s1);
1094             str_numset(str,(double)(((unsigned long)value) ^
1095                 ((unsigned long)str_gnum(s2))));
1096             break;
1097         case O_BIT_OR:
1098             value = str_gnum(s1);
1099             str_numset(str,(double)(((unsigned long)value) |
1100                 ((unsigned long)str_gnum(s2))));
1101             break;
1102         case O_AND:
1103             if (str_true(s1))
1104                 str = str_make(str_get(s2));
1105             else
1106                 str = str_make(str_get(s1));
1107             break;
1108         case O_OR:
1109             if (str_true(s1))
1110                 str = str_make(str_get(s1));
1111             else
1112                 str = str_make(str_get(s2));
1113             break;
1114         case O_COND_EXPR:
1115             if (arg[3].arg_type != A_SINGLE) {
1116                 str_free(str);
1117                 str = Nullstr;
1118             }
1119             else {
1120                 str = str_make(str_get(str_true(s1) ? s2 : arg[3].arg_ptr.arg_str));
1121                 str_free(arg[3].arg_ptr.arg_str);
1122             }
1123             break;
1124         case O_NEGATE:
1125             str_numset(str,(double)(-str_gnum(s1)));
1126             break;
1127         case O_NOT:
1128             str_numset(str,(double)(!str_true(s1)));
1129             break;
1130         case O_COMPLEMENT:
1131             str_numset(str,(double)(~(long)str_gnum(s1)));
1132             break;
1133         case O_LENGTH:
1134             str_numset(str, (double)str_len(s1));
1135             break;
1136         case O_SUBSTR:
1137             if (arg[3].arg_type != A_SINGLE || stabent("[",allstabs)) {
1138                 str_free(str);          /* making the fallacious assumption */
1139                 str = Nullstr;          /* that any $[ occurs before substr()*/
1140             }
1141             else {
1142                 char *beg;
1143                 int len = (int)str_gnum(s2);
1144                 int tmp;
1145
1146                 for (beg = str_get(s1); *beg && len > 0; beg++,len--) ;
1147                 len = (int)str_gnum(arg[3].arg_ptr.arg_str);
1148                 str_free(arg[3].arg_ptr.arg_str);
1149                 if (len > (tmp = strlen(beg)))
1150                     len = tmp;
1151                 str_nset(str,beg,len);
1152             }
1153             break;
1154         case O_SLT:
1155             tmps = str_get(s1);
1156             str_numset(str,(double)(strLT(tmps,str_get(s2))));
1157             break;
1158         case O_SGT:
1159             tmps = str_get(s1);
1160             str_numset(str,(double)(strGT(tmps,str_get(s2))));
1161             break;
1162         case O_SLE:
1163             tmps = str_get(s1);
1164             str_numset(str,(double)(strLE(tmps,str_get(s2))));
1165             break;
1166         case O_SGE:
1167             tmps = str_get(s1);
1168             str_numset(str,(double)(strGE(tmps,str_get(s2))));
1169             break;
1170         case O_SEQ:
1171             tmps = str_get(s1);
1172             str_numset(str,(double)(strEQ(tmps,str_get(s2))));
1173             break;
1174         case O_SNE:
1175             tmps = str_get(s1);
1176             str_numset(str,(double)(strNE(tmps,str_get(s2))));
1177             break;
1178         case O_CRYPT:
1179 #ifdef CRYPT
1180             tmps = str_get(s1);
1181             str_set(str,crypt(tmps,str_get(s2)));
1182 #else
1183             fatal(
1184             "The crypt() function is unimplemented due to excessive paranoia.");
1185 #endif
1186             break;
1187         case O_EXP:
1188             str_numset(str,exp(str_gnum(s1)));
1189             break;
1190         case O_LOG:
1191             str_numset(str,log(str_gnum(s1)));
1192             break;
1193         case O_SQRT:
1194             str_numset(str,sqrt(str_gnum(s1)));
1195             break;
1196         case O_INT:
1197             value = str_gnum(s1);
1198             if (value >= 0.0)
1199                 modf(value,&value);
1200             else {
1201                 modf(-value,&value);
1202                 value = -value;
1203             }
1204             str_numset(str,value);
1205             break;
1206         case O_ORD:
1207             str_numset(str,(double)(*str_get(s1)));
1208             break;
1209         }
1210         if (str) {
1211             arg->arg_type = O_ITEM;     /* note arg1 type is already SINGLE */
1212             str_free(s1);
1213             str_free(s2);
1214             arg[1].arg_ptr.arg_str = str;
1215         }
1216     }
1217 }
1218
1219 ARG *
1220 l(arg)
1221 register ARG *arg;
1222 {
1223     register int i;
1224     register ARG *arg1;
1225     ARG *tmparg;
1226
1227     arg->arg_flags |= AF_COMMON;        /* XXX should cross-match */
1228                                         /* this does unnecessary copying */
1229
1230     if (arg[1].arg_type == A_ARYLEN) {
1231         arg[1].arg_type = A_LARYLEN;
1232         return arg;
1233     }
1234
1235     /* see if it's an array reference */
1236
1237     if (arg[1].arg_type == A_EXPR) {
1238         arg1 = arg[1].arg_ptr.arg_arg;
1239
1240         if (arg1->arg_type == O_LIST && arg->arg_type != O_ITEM) {
1241                                                 /* assign to list */
1242             arg[1].arg_flags |= AF_SPECIAL;
1243             dehoist(arg,2);
1244             arg[2].arg_flags |= AF_SPECIAL;
1245             for (i = arg1->arg_len; i >= 1; i--) {
1246                 switch (arg1[i].arg_type) {
1247                 case A_STAB: case A_LVAL:
1248                     arg1[i].arg_type = A_LVAL;
1249                     break;
1250                 case A_EXPR: case A_LEXPR:
1251                     arg1[i].arg_type = A_LEXPR;
1252                     if (arg1[i].arg_ptr.arg_arg->arg_type == O_ARRAY)
1253                         arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY;
1254                     else if (arg1[i].arg_ptr.arg_arg->arg_type == O_HASH)
1255                         arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH;
1256                     if (arg1[i].arg_ptr.arg_arg->arg_type == O_LARRAY)
1257                         break;
1258                     if (arg1[i].arg_ptr.arg_arg->arg_type == O_LHASH)
1259                         break;
1260                     /* FALL THROUGH */
1261                 default:
1262                     sprintf(tokenbuf,
1263                       "Illegal item (%s) as lvalue",argname[arg1[i].arg_type]);
1264                     yyerror(tokenbuf);
1265                 }
1266             }
1267         }
1268         else if (arg1->arg_type == O_ARRAY) {
1269             if (arg1->arg_len == 1 && arg->arg_type != O_ITEM) {
1270                                                 /* assign to array */
1271                 arg[1].arg_flags |= AF_SPECIAL;
1272                 dehoist(arg,2);
1273                 arg[2].arg_flags |= AF_SPECIAL;
1274             }
1275             else
1276                 arg1->arg_type = O_LARRAY;      /* assign to array elem */
1277         }
1278         else if (arg1->arg_type == O_HASH)
1279             arg1->arg_type = O_LHASH;
1280         else if (arg1->arg_type != O_ASSIGN) {
1281             sprintf(tokenbuf,
1282               "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
1283             yyerror(tokenbuf);
1284         }
1285         arg[1].arg_type = A_LEXPR;
1286 #ifdef DEBUGGING
1287         if (debug & 16)
1288             fprintf(stderr,"lval LEXPR\n");
1289 #endif
1290         return arg;
1291     }
1292
1293     /* not an array reference, should be a register name */
1294
1295     if (arg[1].arg_type != A_STAB && arg[1].arg_type != A_LVAL) {
1296         sprintf(tokenbuf,
1297           "Illegal item (%s) as lvalue",argname[arg[1].arg_type]);
1298         yyerror(tokenbuf);
1299     }
1300     arg[1].arg_type = A_LVAL;
1301 #ifdef DEBUGGING
1302     if (debug & 16)
1303         fprintf(stderr,"lval LVAL\n");
1304 #endif
1305     return arg;
1306 }
1307
1308 dehoist(arg,i)
1309 ARG *arg;
1310 {
1311     ARG *tmparg;
1312
1313     if (arg[i].arg_type != A_EXPR) {    /* dehoist */
1314         tmparg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg,0);
1315         tmparg[1] = arg[i];
1316         arg[i].arg_ptr.arg_arg = tmparg;
1317         arg[i].arg_type = A_EXPR;
1318     }
1319 }
1320
1321 ARG *
1322 addflags(i,flags,arg)
1323 register ARG *arg;
1324 {
1325     arg[i].arg_flags |= flags;
1326     return arg;
1327 }
1328
1329 ARG *
1330 hide_ary(arg)
1331 ARG *arg;
1332 {
1333     if (arg->arg_type == O_ARRAY)
1334         return make_op(O_ITEM,1,arg,Nullarg,Nullarg,0);
1335     return arg;
1336 }
1337
1338 ARG *
1339 make_list(arg)
1340 register ARG *arg;
1341 {
1342     register int i;
1343     register ARG *node;
1344     register ARG *nxtnode;
1345     register int j;
1346     STR *tmpstr;
1347
1348     if (!arg) {
1349         arg = op_new(0);
1350         arg->arg_type = O_LIST;
1351     }
1352     if (arg->arg_type != O_COMMA) {
1353         arg->arg_flags |= AF_LISTISH;   /* see listish() below */
1354         return arg;
1355     }
1356     for (i = 2, node = arg; ; i++) {
1357         if (node->arg_len < 2)
1358             break;
1359         if (node[2].arg_type != A_EXPR)
1360             break;
1361         node = node[2].arg_ptr.arg_arg;
1362         if (node->arg_type != O_COMMA)
1363             break;
1364     }
1365     if (i > 2) {
1366         node = arg;
1367         arg = op_new(i);
1368         tmpstr = arg->arg_ptr.arg_str;
1369         *arg = *node;           /* copy everything except the STR */
1370         arg->arg_ptr.arg_str = tmpstr;
1371         for (j = 1; ; ) {
1372             arg[j] = node[1];
1373             ++j;                /* Bug in Xenix compiler */
1374             if (j >= i) {
1375                 arg[j] = node[2];
1376                 free_arg(node);
1377                 break;
1378             }
1379             nxtnode = node[2].arg_ptr.arg_arg;
1380             free_arg(node);
1381             node = nxtnode;
1382         }
1383     }
1384     arg->arg_type = O_LIST;
1385     arg->arg_len = i;
1386     return arg;
1387 }
1388
1389 /* turn a single item into a list */
1390
1391 ARG *
1392 listish(arg)
1393 ARG *arg;
1394 {
1395     if (arg->arg_flags & AF_LISTISH) {
1396         arg = make_op(O_LIST,1,arg,Nullarg,Nullarg,0);
1397         arg[1].arg_flags &= ~AF_SPECIAL;
1398     }
1399     return arg;
1400 }
1401
1402 /* mark list of local variables */
1403
1404 ARG *
1405 localize(arg)
1406 ARG *arg;
1407 {
1408     arg->arg_flags |= AF_LOCAL;
1409     return arg;
1410 }
1411
1412 ARG *
1413 stab2arg(atype,stab)
1414 int atype;
1415 register STAB *stab;
1416 {
1417     register ARG *arg;
1418
1419     arg = op_new(1);
1420     arg->arg_type = O_ITEM;
1421     arg[1].arg_type = atype;
1422     arg[1].arg_ptr.arg_stab = stab;
1423     return arg;
1424 }
1425
1426 ARG *
1427 cval_to_arg(cval)
1428 register char *cval;
1429 {
1430     register ARG *arg;
1431
1432     arg = op_new(1);
1433     arg->arg_type = O_ITEM;
1434     arg[1].arg_type = A_SINGLE;
1435     arg[1].arg_ptr.arg_str = str_make(cval);
1436     safefree(cval);
1437     return arg;
1438 }
1439
1440 ARG *
1441 op_new(numargs)
1442 int numargs;
1443 {
1444     register ARG *arg;
1445
1446     arg = (ARG*)safemalloc((numargs + 1) * sizeof (ARG));
1447     bzero((char *)arg, (numargs + 1) * sizeof (ARG));
1448     arg->arg_ptr.arg_str = str_new(0);
1449     arg->arg_len = numargs;
1450     return arg;
1451 }
1452
1453 void
1454 free_arg(arg)
1455 ARG *arg;
1456 {
1457     str_free(arg->arg_ptr.arg_str);
1458     safefree((char*)arg);
1459 }
1460
1461 ARG *
1462 make_match(type,expr,spat)
1463 int type;
1464 ARG *expr;
1465 SPAT *spat;
1466 {
1467     register ARG *arg;
1468
1469     arg = make_op(type,2,expr,Nullarg,Nullarg,0);
1470
1471     arg[2].arg_type = A_SPAT;
1472     arg[2].arg_ptr.arg_spat = spat;
1473 #ifdef DEBUGGING
1474     if (debug & 16)
1475         fprintf(stderr,"make_match SPAT=%lx\n",(long)spat);
1476 #endif
1477
1478     if (type == O_SUBST || type == O_NSUBST) {
1479         if (arg[1].arg_type != A_STAB)
1480             yyerror("Illegal lvalue");
1481         arg[1].arg_type = A_LVAL;
1482     }
1483     return arg;
1484 }
1485
1486 ARG *
1487 cmd_to_arg(cmd)
1488 CMD *cmd;
1489 {
1490     register ARG *arg;
1491
1492     arg = op_new(1);
1493     arg->arg_type = O_ITEM;
1494     arg[1].arg_type = A_CMD;
1495     arg[1].arg_ptr.arg_cmd = cmd;
1496     return arg;
1497 }
1498
1499 CMD *
1500 wopt(cmd)
1501 register CMD *cmd;
1502 {
1503     register CMD *tail;
1504     register ARG *arg = cmd->c_expr;
1505     STAB *asgnstab;
1506
1507     /* hoist "while (<channel>)" up into command block */
1508
1509     if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
1510         cmd->c_flags &= ~CF_OPTIMIZE;   /* clear optimization type */
1511         cmd->c_flags |= CFT_GETS;       /* and set it to do the input */
1512         cmd->c_stab = arg[1].arg_ptr.arg_stab;
1513         if (arg[1].arg_ptr.arg_stab->stab_io->flags & IOF_ARGV) {
1514             cmd->c_expr = l(make_op(O_ASSIGN, 2,        /* fake up "$_ =" */
1515                stab2arg(A_LVAL,defstab), arg, Nullarg,1 ));
1516         }
1517         else {
1518             free_arg(arg);
1519             cmd->c_expr = Nullarg;
1520         }
1521     }
1522     else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) {
1523         cmd->c_flags &= ~CF_OPTIMIZE;   /* clear optimization type */
1524         cmd->c_flags |= CFT_INDGETS;    /* and set it to do the input */
1525         cmd->c_stab = arg[1].arg_ptr.arg_stab;
1526         free_arg(arg);
1527         cmd->c_expr = Nullarg;
1528     }
1529     else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) {
1530         if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY)
1531             asgnstab = cmd->c_stab;
1532         else
1533             asgnstab = defstab;
1534         cmd->c_expr = l(make_op(O_ASSIGN, 2,    /* fake up "$foo =" */
1535            stab2arg(A_LVAL,asgnstab), arg, Nullarg,1 ));
1536         cmd->c_flags &= ~CF_OPTIMIZE;   /* clear optimization type */
1537     }
1538
1539     /* First find the end of the true list */
1540
1541     if (cmd->ucmd.ccmd.cc_true == Nullcmd)
1542         return cmd;
1543     for (tail = cmd->ucmd.ccmd.cc_true; tail->c_next; tail = tail->c_next) ;
1544
1545     /* if there's a continue block, link it to true block and find end */
1546
1547     if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
1548         tail->c_next = cmd->ucmd.ccmd.cc_alt;
1549         for ( ; tail->c_next; tail = tail->c_next) ;
1550     }
1551
1552     /* Here's the real trick: link the end of the list back to the beginning,
1553      * inserting a "last" block to break out of the loop.  This saves one or
1554      * two procedure calls every time through the loop, because of how cmd_exec
1555      * does tail recursion.
1556      */
1557
1558     tail->c_next = (CMD *) safemalloc(sizeof (CMD));
1559     tail = tail->c_next;
1560     if (!cmd->ucmd.ccmd.cc_alt)
1561         cmd->ucmd.ccmd.cc_alt = tail;   /* every loop has a continue now */
1562
1563     bcopy((char *)cmd, (char *)tail, sizeof(CMD));
1564     tail->c_type = C_EXPR;
1565     tail->c_flags ^= CF_INVERT;         /* turn into "last unless" */
1566     tail->c_next = tail->ucmd.ccmd.cc_true;     /* loop directly back to top */
1567     tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg,0);
1568     tail->ucmd.acmd.ac_stab = Nullstab;
1569     return cmd;
1570 }
1571
1572 CMD *
1573 over(eachstab,cmd)
1574 STAB *eachstab;
1575 register CMD *cmd;
1576 {
1577     /* hoist "for $foo (@bar)" up into command block */
1578
1579     cmd->c_flags &= ~CF_OPTIMIZE;       /* clear optimization type */
1580     cmd->c_flags |= CFT_ARRAY;          /* and set it to do the iteration */
1581     cmd->c_stab = eachstab;
1582
1583     return cmd;
1584 }
1585
1586 static int gensym = 0;
1587
1588 STAB *
1589 genstab()
1590 {
1591     sprintf(tokenbuf,"_GEN_%d",gensym++);
1592     return stabent(tokenbuf,TRUE);
1593 }
1594
1595 /* this routine is in perly.c by virtue of being sort of an alternate main() */
1596
1597 STR *
1598 do_eval(str,optype)
1599 STR *str;
1600 int optype;
1601 {
1602     int retval;
1603     CMD *myroot;
1604     ARRAY *ar;
1605     int i;
1606     char *oldfile = filename;
1607     line_t oldline = line;
1608     int oldtmps_base = tmps_base;
1609     int oldsave = savestack->ary_fill;
1610
1611     tmps_base = tmps_max;
1612     str_set(stabent("@",TRUE)->stab_val,"");
1613     if (optype != O_DOFILE) {   /* normal eval */
1614         filename = "(eval)";
1615         line = 1;
1616         str_sset(linestr,str);
1617     }
1618     else {
1619         filename = savestr(str_get(str));       /* can't free this easily */
1620         str_set(linestr,"");
1621         rsfp = fopen(filename,"r");
1622         ar = incstab->stab_array;
1623         if (!rsfp && *filename != '/') {
1624             for (i = 0; i <= ar->ary_fill; i++) {
1625                 sprintf(tokenbuf,"%s/%s",str_get(afetch(ar,i)),filename);
1626                 rsfp = fopen(tokenbuf,"r");
1627                 if (rsfp) {
1628                     free(filename);
1629                     filename = savestr(tokenbuf);
1630                     break;
1631                 }
1632             }
1633         }
1634         if (!rsfp) {
1635             filename = oldfile;
1636             tmps_base = oldtmps_base;
1637             return &str_no;
1638         }
1639         line = 0;
1640     }
1641     in_eval++;
1642     bufptr = str_get(linestr);
1643     if (setjmp(eval_env))
1644         retval = 1;
1645     else
1646         retval = yyparse();
1647     myroot = eval_root;         /* in case cmd_exec does another eval! */
1648     if (retval)
1649         str = &str_no;
1650     else {
1651         str = str_static(cmd_exec(eval_root));
1652                                 /* if we don't save str, free zaps it */
1653         cmd_free(myroot);       /* can't free on error, for some reason */
1654     }
1655     in_eval--;
1656     filename = oldfile;
1657     line = oldline;
1658     tmps_base = oldtmps_base;
1659     if (savestack->ary_fill > oldsave)  /* let them use local() */
1660         restorelist(oldsave);
1661     return str;
1662 }
1663
1664 cmd_free(cmd)
1665 register CMD *cmd;
1666 {
1667     register CMD *tofree;
1668     register CMD *head = cmd;
1669
1670     while (cmd) {
1671         if (cmd->c_type != C_WHILE) {   /* WHILE block is duplicated */
1672             if (cmd->c_label)
1673                 safefree(cmd->c_label);
1674             if (cmd->c_short)
1675                 str_free(cmd->c_short);
1676             if (cmd->c_spat)
1677                 spat_free(cmd->c_spat);
1678             if (cmd->c_expr)
1679                 arg_free(cmd->c_expr);
1680         }
1681         switch (cmd->c_type) {
1682         case C_WHILE:
1683         case C_BLOCK:
1684         case C_IF:
1685             if (cmd->ucmd.ccmd.cc_true)
1686                 cmd_free(cmd->ucmd.ccmd.cc_true);
1687             if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt)
1688                 cmd_free(cmd->ucmd.ccmd.cc_alt);
1689             break;
1690         case C_EXPR:
1691             if (cmd->ucmd.acmd.ac_expr)
1692                 arg_free(cmd->ucmd.acmd.ac_expr);
1693             break;
1694         }
1695         tofree = cmd;
1696         cmd = cmd->c_next;
1697         safefree((char*)tofree);
1698         if (cmd && cmd == head)         /* reached end of while loop */
1699             break;
1700     }
1701 }
1702
1703 arg_free(arg)
1704 register ARG *arg;
1705 {
1706     register int i;
1707
1708     for (i = 1; i <= arg->arg_len; i++) {
1709         switch (arg[i].arg_type) {
1710         case A_NULL:
1711             break;
1712         case A_LEXPR:
1713         case A_EXPR:
1714             arg_free(arg[i].arg_ptr.arg_arg);
1715             break;
1716         case A_CMD:
1717             cmd_free(arg[i].arg_ptr.arg_cmd);
1718             break;
1719         case A_WORD:
1720         case A_STAB:
1721         case A_LVAL:
1722         case A_READ:
1723         case A_GLOB:
1724         case A_ARYLEN:
1725             break;
1726         case A_SINGLE:
1727         case A_DOUBLE:
1728         case A_BACKTICK:
1729             str_free(arg[i].arg_ptr.arg_str);
1730             break;
1731         case A_SPAT:
1732             spat_free(arg[i].arg_ptr.arg_spat);
1733             break;
1734         case A_NUMBER:
1735             break;
1736         }
1737     }
1738     free_arg(arg);
1739 }
1740
1741 spat_free(spat)
1742 register SPAT *spat;
1743 {
1744     register SPAT *sp;
1745
1746     if (spat->spat_runtime)
1747         arg_free(spat->spat_runtime);
1748     if (spat->spat_repl) {
1749         arg_free(spat->spat_repl);
1750     }
1751     if (spat->spat_short) {
1752         str_free(spat->spat_short);
1753     }
1754     if (spat->spat_regexp) {
1755         regfree(spat->spat_regexp);
1756     }
1757
1758     /* now unlink from spat list */
1759     if (spat_root == spat)
1760         spat_root = spat->spat_next;
1761     else {
1762         for (sp = spat_root; sp->spat_next != spat; sp = sp->spat_next) ;
1763         sp->spat_next = spat->spat_next;
1764     }
1765
1766     safefree((char*)spat);
1767 }
1768
1769 /* Recursively descend a command sequence and push the address of any string
1770  * that needs saving on recursion onto the tosave array.
1771  */
1772
1773 static int
1774 cmd_tosave(cmd)
1775 register CMD *cmd;
1776 {
1777     register CMD *head = cmd;
1778
1779     while (cmd) {
1780         if (cmd->c_spat)
1781             spat_tosave(cmd->c_spat);
1782         if (cmd->c_expr)
1783             arg_tosave(cmd->c_expr);
1784         switch (cmd->c_type) {
1785         case C_WHILE:
1786         case C_BLOCK:
1787         case C_IF:
1788             if (cmd->ucmd.ccmd.cc_true)
1789                 cmd_tosave(cmd->ucmd.ccmd.cc_true);
1790             if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt)
1791                 cmd_tosave(cmd->ucmd.ccmd.cc_alt);
1792             break;
1793         case C_EXPR:
1794             if (cmd->ucmd.acmd.ac_expr)
1795                 arg_tosave(cmd->ucmd.acmd.ac_expr);
1796             break;
1797         }
1798         cmd = cmd->c_next;
1799         if (cmd && cmd == head)         /* reached end of while loop */
1800             break;
1801     }
1802 }
1803
1804 static int
1805 arg_tosave(arg)
1806 register ARG *arg;
1807 {
1808     register int i;
1809     int saving = FALSE;
1810
1811     for (i = 1; i <= arg->arg_len; i++) {
1812         switch (arg[i].arg_type) {
1813         case A_NULL:
1814             break;
1815         case A_LEXPR:
1816         case A_EXPR:
1817             saving |= arg_tosave(arg[i].arg_ptr.arg_arg);
1818             break;
1819         case A_CMD:
1820             cmd_tosave(arg[i].arg_ptr.arg_cmd);
1821             saving = TRUE;      /* assume hanky panky */
1822             break;
1823         case A_WORD:
1824         case A_STAB:
1825         case A_LVAL:
1826         case A_READ:
1827         case A_GLOB:
1828         case A_ARYLEN:
1829         case A_SINGLE:
1830         case A_DOUBLE:
1831         case A_BACKTICK:
1832             break;
1833         case A_SPAT:
1834             saving |= spat_tosave(arg[i].arg_ptr.arg_spat);
1835             break;
1836         case A_NUMBER:
1837             break;
1838         }
1839     }
1840     switch (arg->arg_type) {
1841     case O_EVAL:
1842     case O_SUBR:
1843         saving = TRUE;
1844     }
1845     if (saving)
1846         apush(tosave,arg->arg_ptr.arg_str);
1847     return saving;
1848 }
1849
1850 static int
1851 spat_tosave(spat)
1852 register SPAT *spat;
1853 {
1854     int saving = FALSE;
1855
1856     if (spat->spat_runtime)
1857         saving |= arg_tosave(spat->spat_runtime);
1858     if (spat->spat_repl) {
1859         saving |= arg_tosave(spat->spat_repl);
1860     }
1861
1862     return saving;
1863 }