cmd.c

   1 /* $Header: cmd.c,v 3.0.1.9 90/10/15 15:32:39 lwall Locked $
   2  *
   3  *    Copyright (c) 1989, Larry Wall
   4  *
   5  *    You may distribute under the terms of the GNU General Public License
   6  *    as specified in the README file that comes with the perl 3.0 kit.
   7  *
   8  * $Log:        cmd.c,v $
   9  * Revision 3.0.1.9  90/10/15  15:32:39  lwall
  10  * patch29: non-existent array values no longer cause core dumps
  11  * patch29: scripts now run at almost full speed under the debugger
  12  * patch29: @ENV = () now works
  13  * patch29: added caller
  14  *
  15  * Revision 3.0.1.8  90/08/09  02:28:49  lwall
  16  * patch19: did preliminary work toward debugging packages and evals
  17  * patch19: conditionals now always supply a scalar context to expression
  18  * patch19: switch optimizer was confused by negative fractional values
  19  *
  20  * Revision 3.0.1.7  90/03/27  15:32:37  lwall
  21  * patch16: non-terminal blocks should never have arrays requested of them
  22  *
  23  * Revision 3.0.1.6  90/03/12  16:21:09  lwall
  24  * patch13: fixed some backwards VOLATILE declarations
  25  * patch13: while (s/x//) {} still caused some anomolies
  26  * patch13: greater-than test of numeric switch structures did less-than action
  27  *
  28  * Revision 3.0.1.5  90/02/28  16:38:31  lwall
  29  * patch9: volatilized some more variables for super-optimizing compilers
  30  * patch9: nested foreach loops didn't reset inner loop on next to outer loop
  31  * patch9: returned values were read from obsolete stack
  32  * patch9: added sanity check on longjmp() return value
  33  * patch9: substitutions that almost always succeed can corrupt label stack
  34  * patch9: subs which return by both mechanisms can clobber local return data
  35  *
  36  * Revision 3.0.1.4  89/12/21  19:17:41  lwall
  37  * patch7: arranged for certain registers to be restored after longjmp()
  38  * patch7: made nested or recursive foreach work right
  39  *
  40  * Revision 3.0.1.3  89/11/17  15:04:36  lwall
  41  * patch5: nested foreach on same array didn't work
  42  *
  43  * Revision 3.0.1.2  89/11/11  04:08:56  lwall
  44  * patch2: non-BSD machines required two ^D's for <>
  45  * patch2: grow_dlevel() not inside #ifdef DEBUGGING
  46  *
  47  * Revision 3.0.1.1  89/10/26  23:04:21  lwall
  48  * patch1: heuristically disabled optimization could cause core dump
  49  *
  50  * Revision 3.0  89/10/18  15:09:02  lwall
  51  * 3.0 baseline
  52  *
  53  */
  54
  55 #include "EXTERN.h"
  56 #include "perl.h"
  57
  58 #ifdef I_VARARGS
  59 #  include <varargs.h>
  60 #endif
  61
  62 static STR str_chop;
  63
  64 void grow_dlevel();
  65
  66 /* do longjmps() clobber register variables? */
  67
  68 #if defined(cray) || defined(__STDC__)
  69 #define JMPCLOBBER
  70 #endif
  71
  72 /* This is the main command loop.  We try to spend as much time in this loop
  73  * as possible, so lots of optimizations do their activities in here.  This
  74  * means things get a little sloppy.
  75  */
  76
  77 int
  78 cmd_exec(cmdparm,gimme,sp)
  79 CMD *VOLATILE cmdparm;
  80 VOLATILE int gimme;
  81 VOLATILE int sp;
  82 {
  83     register CMD *cmd = cmdparm;
  84     SPAT *VOLATILE oldspat;
  85     VOLATILE int firstsave = savestack->ary_fill;
  86     VOLATILE int oldsave;
  87     VOLATILE int aryoptsave;
  88 #ifdef DEBUGGING
  89     VOLATILE int olddlevel;
  90     VOLATILE int entdlevel;
  91 #endif
  92     register STR *retstr = &str_undef;
  93     register char *tmps;
  94     register int cmdflags;
  95     register int match;
  96     register char *go_to = goto_targ;
  97     register int newsp = -2;
  98     register STR **st = stack->ary_array;
  99     FILE *VOLATILE fp;
 100     ARRAY *VOLATILE ar;
 101
 102     lastsize = 0;
 103 #ifdef DEBUGGING
 104     entdlevel = dlevel;
 105 #endif
 106 tail_recursion_entry:
 107 #ifdef DEBUGGING
 108     dlevel = entdlevel;
 109 #endif
 110 #ifdef TAINT
 111     tainted = 0;        /* Each statement is presumed innocent */
 112 #endif
 113     if (cmd == Nullcmd) {
 114         if (gimme == G_ARRAY && newsp > -2)
 115             return newsp;
 116         else {
 117             st[++sp] = retstr;
 118             return sp;
 119         }
 120     }
 121     cmdflags = cmd->c_flags;    /* hopefully load register */
 122     if (go_to) {
 123         if (cmd->c_label && strEQ(go_to,cmd->c_label))
 124             goto_targ = go_to = Nullch;         /* here at last */
 125         else {
 126             switch (cmd->c_type) {
 127             case C_IF:
 128                 oldspat = curspat;
 129                 oldsave = savestack->ary_fill;
 130 #ifdef DEBUGGING
 131                 olddlevel = dlevel;
 132 #endif
 133                 retstr = &str_yes;
 134                 newsp = -2;
 135                 if (cmd->ucmd.ccmd.cc_true) {
 136 #ifdef DEBUGGING
 137                     if (debug) {
 138                         debname[dlevel] = 't';
 139                         debdelim[dlevel] = '_';
 140                         if (++dlevel >= dlmax)
 141                             grow_dlevel();
 142                     }
 143 #endif
 144                     newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
 145                     st = stack->ary_array;      /* possibly reallocated */
 146                     retstr = st[newsp];
 147                 }
 148                 if (!goto_targ)
 149                     go_to = Nullch;
 150                 curspat = oldspat;
 151                 if (savestack->ary_fill > oldsave)
 152                     restorelist(oldsave);
 153 #ifdef DEBUGGING
 154                 dlevel = olddlevel;
 155 #endif
 156                 cmd = cmd->ucmd.ccmd.cc_alt;
 157                 goto tail_recursion_entry;
 158             case C_ELSE:
 159                 oldspat = curspat;
 160                 oldsave = savestack->ary_fill;
 161 #ifdef DEBUGGING
 162                 olddlevel = dlevel;
 163 #endif
 164                 retstr = &str_undef;
 165                 newsp = -2;
 166                 if (cmd->ucmd.ccmd.cc_true) {
 167 #ifdef DEBUGGING
 168                     if (debug) {
 169                         debname[dlevel] = 'e';
 170                         debdelim[dlevel] = '_';
 171                         if (++dlevel >= dlmax)
 172                             grow_dlevel();
 173                     }
 174 #endif
 175                     newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
 176                     st = stack->ary_array;      /* possibly reallocated */
 177                     retstr = st[newsp];
 178                 }
 179                 if (!goto_targ)
 180                     go_to = Nullch;
 181                 curspat = oldspat;
 182                 if (savestack->ary_fill > oldsave)
 183                     restorelist(oldsave);
 184 #ifdef DEBUGGING
 185                 dlevel = olddlevel;
 186 #endif
 187                 break;
 188             case C_BLOCK:
 189             case C_WHILE:
 190                 if (!(cmdflags & CF_ONCE)) {
 191                     cmdflags |= CF_ONCE;
 192                     if (++loop_ptr >= loop_max) {
 193                         loop_max += 128;
 194                         Renew(loop_stack, loop_max, struct loop);
 195                     }
 196                     loop_stack[loop_ptr].loop_label = cmd->c_label;
 197                     loop_stack[loop_ptr].loop_sp = sp;
 198 #ifdef DEBUGGING
 199                     if (debug & 4) {
 200                         deb("(Pushing label #%d %s)\n",
 201                           loop_ptr, cmd->c_label ? cmd->c_label : "");
 202                     }
 203 #endif
 204                 }
 205 #ifdef JMPCLOBBER
 206                 cmdparm = cmd;
 207 #endif
 208                 if (match = setjmp(loop_stack[loop_ptr].loop_env)) {
 209                     st = stack->ary_array;      /* possibly reallocated */
 210 #ifdef JMPCLOBBER
 211                     cmd = cmdparm;
 212                     cmdflags = cmd->c_flags|CF_ONCE;
 213 #endif
 214                     if (savestack->ary_fill > oldsave)
 215                         restorelist(oldsave);
 216                     switch (match) {
 217                     default:
 218                         fatal("longjmp returned bad value (%d)",match);
 219                     case O_LAST:        /* not done unless go_to found */
 220                         go_to = Nullch;
 221                         if (lastretstr) {
 222                             retstr = lastretstr;
 223                             newsp = -2;
 224                         }
 225                         else {
 226                             newsp = sp + lastsize;
 227                             retstr = st[newsp];
 228                         }
 229 #ifdef DEBUGGING
 230                         olddlevel = dlevel;
 231 #endif
 232                         curspat = oldspat;
 233                         goto next_cmd;
 234                     case O_NEXT:        /* not done unless go_to found */
 235                         go_to = Nullch;
 236 #ifdef JMPCLOBBER
 237                         newsp = -2;
 238                         retstr = &str_undef;
 239 #endif
 240                         goto next_iter;
 241                     case O_REDO:        /* not done unless go_to found */
 242                         go_to = Nullch;
 243 #ifdef JMPCLOBBER
 244                         newsp = -2;
 245                         retstr = &str_undef;
 246 #endif
 247                         goto doit;
 248                     }
 249                 }
 250                 oldspat = curspat;
 251                 oldsave = savestack->ary_fill;
 252 #ifdef DEBUGGING
 253                 olddlevel = dlevel;
 254 #endif
 255                 if (cmd->ucmd.ccmd.cc_true) {
 256 #ifdef DEBUGGING
 257                     if (debug) {
 258                         debname[dlevel] = 't';
 259                         debdelim[dlevel] = '_';
 260                         if (++dlevel >= dlmax)
 261                             grow_dlevel();
 262                     }
 263 #endif
 264                     newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
 265                     st = stack->ary_array;      /* possibly reallocated */
 266                     retstr = st[newsp];
 267                 }
 268                 if (!goto_targ) {
 269                     go_to = Nullch;
 270                     goto next_iter;
 271                 }
 272 #ifdef DEBUGGING
 273                 dlevel = olddlevel;
 274 #endif
 275                 if (cmd->ucmd.ccmd.cc_alt) {
 276 #ifdef DEBUGGING
 277                     if (debug) {
 278                         debname[dlevel] = 'a';
 279                         debdelim[dlevel] = '_';
 280                         if (++dlevel >= dlmax)
 281                             grow_dlevel();
 282                     }
 283 #endif
 284                     newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme && (cmdflags & CF_TERM),sp);
 285                     st = stack->ary_array;      /* possibly reallocated */
 286                     retstr = st[newsp];
 287                 }
 288                 if (goto_targ)
 289                     break;
 290                 go_to = Nullch;
 291                 goto finish_while;
 292             }
 293             cmd = cmd->c_next;
 294             if (cmd && cmd->c_head == cmd)
 295                                         /* reached end of while loop */
 296                 return sp;              /* targ isn't in this block */
 297             if (cmdflags & CF_ONCE) {
 298 #ifdef DEBUGGING
 299                 if (debug & 4) {
 300                     tmps = loop_stack[loop_ptr].loop_label;
 301                     deb("(Popping label #%d %s)\n",loop_ptr,
 302                         tmps ? tmps : "" );
 303                 }
 304 #endif
 305                 loop_ptr--;
 306             }
 307             goto tail_recursion_entry;
 308         }
 309     }
 310
 311 until_loop:
 312
 313     /* Set line number so run-time errors can be located */
 314
 315     curcmd = cmd;
 316
 317 #ifdef DEBUGGING
 318     if (debug) {
 319         if (debug & 2) {
 320             deb("%s     (%lx)   r%lx    t%lx    a%lx    n%lx    cs%lx\n",
 321                 cmdname[cmd->c_type],cmd,cmd->c_expr,
 322                 cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt,cmd->c_next,
 323                 curspat);
 324         }
 325         debname[dlevel] = cmdname[cmd->c_type][0];
 326         debdelim[dlevel] = '!';
 327         if (++dlevel >= dlmax)
 328             grow_dlevel();
 329     }
 330 #endif
 331
 332     /* Here is some common optimization */
 333
 334     if (cmdflags & CF_COND) {
 335         switch (cmdflags & CF_OPTIMIZE) {
 336
 337         case CFT_FALSE:
 338             retstr = cmd->c_short;
 339             newsp = -2;
 340             match = FALSE;
 341             if (cmdflags & CF_NESURE)
 342                 goto maybe;
 343             break;
 344         case CFT_TRUE:
 345             retstr = cmd->c_short;
 346             newsp = -2;
 347             match = TRUE;
 348             if (cmdflags & CF_EQSURE)
 349                 goto flipmaybe;
 350             break;
 351
 352         case CFT_REG:
 353             retstr = STAB_STR(cmd->c_stab);
 354             newsp = -2;
 355             match = str_true(retstr);   /* => retstr = retstr, c2 should fix */
 356             if (cmdflags & (match ? CF_EQSURE : CF_NESURE))
 357                 goto flipmaybe;
 358             break;
 359
 360         case CFT_ANCHOR:        /* /^pat/ optimization */
 361             if (multiline) {
 362                 if (*cmd->c_short->str_ptr && !(cmdflags & CF_EQSURE))
 363                     goto scanner;       /* just unanchor it */
 364                 else
 365                     break;              /* must evaluate */
 366             }
 367             /* FALL THROUGH */
 368         case CFT_STROP:         /* string op optimization */
 369             retstr = STAB_STR(cmd->c_stab);
 370             newsp = -2;
 371 #ifndef I286
 372             if (*cmd->c_short->str_ptr == *str_get(retstr) &&
 373                     bcmp(cmd->c_short->str_ptr, str_get(retstr),
 374                       cmd->c_slen) == 0 ) {
 375                 if (cmdflags & CF_EQSURE) {
 376                     if (sawampersand && (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
 377                         curspat = Nullspat;
 378                         if (leftstab)
 379                             str_nset(stab_val(leftstab),"",0);
 380                         if (amperstab)
 381                             str_sset(stab_val(amperstab),cmd->c_short);
 382                         if (rightstab)
 383                             str_nset(stab_val(rightstab),
 384                               retstr->str_ptr + cmd->c_slen,
 385                               retstr->str_cur - cmd->c_slen);
 386                     }
 387                     match = !(cmdflags & CF_FIRSTNEG);
 388                     retstr = &str_yes;
 389                     goto flipmaybe;
 390                 }
 391             }
 392             else if (cmdflags & CF_NESURE) {
 393                 match = cmdflags & CF_FIRSTNEG;
 394                 retstr = &str_no;
 395                 goto flipmaybe;
 396             }
 397 #else
 398             {
 399                 char *zap1, *zap2, zap1c, zap2c;
 400                 int  zaplen;
 401
 402                 zap1 = cmd->c_short->str_ptr;
 403                 zap2 = str_get(retstr);
 404                 zap1c = *zap1;
 405                 zap2c = *zap2;
 406                 zaplen = cmd->c_slen;
 407                 if ((zap1c == zap2c) && (bcmp(zap1, zap2, zaplen) == 0)) {
 408                     if (cmdflags & CF_EQSURE) {
 409                         if (sawampersand &&
 410                           (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
 411                             curspat = Nullspat;
 412                             if (leftstab)
 413                                 str_nset(stab_val(leftstab),"",0);
 414                             if (amperstab)
 415                                 str_sset(stab_val(amperstab),cmd->c_short);
 416                             if (rightstab)
 417                                 str_nset(stab_val(rightstab),
 418                                          retstr->str_ptr + cmd->c_slen,
 419                                          retstr->str_cur - cmd->c_slen);
 420                         }
 421                         match = !(cmdflags & CF_FIRSTNEG);
 422                         retstr = &str_yes;
 423                         goto flipmaybe;
 424                     }
 425                 }
 426                 else if (cmdflags & CF_NESURE) {
 427                     match = cmdflags & CF_FIRSTNEG;
 428                     retstr = &str_no;
 429                     goto flipmaybe;
 430                 }
 431             }
 432 #endif
 433             break;                      /* must evaluate */
 434
 435         case CFT_SCAN:                  /* non-anchored search */
 436           scanner:
 437             retstr = STAB_STR(cmd->c_stab);
 438             newsp = -2;
 439             if (retstr->str_pok & SP_STUDIED)
 440                 if (screamfirst[cmd->c_short->str_rare] >= 0)
 441                     tmps = screaminstr(retstr, cmd->c_short);
 442                 else
 443                     tmps = Nullch;
 444             else {
 445                 tmps = str_get(retstr);         /* make sure it's pok */
 446 #ifndef lint
 447                 tmps = fbminstr((unsigned char*)tmps,
 448                     (unsigned char*)tmps + retstr->str_cur, cmd->c_short);
 449 #endif
 450             }
 451             if (tmps) {
 452                 if (cmdflags & CF_EQSURE) {
 453                     ++cmd->c_short->str_u.str_useful;
 454                     if (sawampersand) {
 455                         curspat = Nullspat;
 456                         if (leftstab)
 457                             str_nset(stab_val(leftstab),retstr->str_ptr,
 458                               tmps - retstr->str_ptr);
 459                         if (amperstab)
 460                             str_sset(stab_val(amperstab),cmd->c_short);
 461                         if (rightstab)
 462                             str_nset(stab_val(rightstab),
 463                               tmps + cmd->c_short->str_cur,
 464                               retstr->str_cur - (tmps - retstr->str_ptr) -
 465                                 cmd->c_short->str_cur);
 466                     }
 467                     match = !(cmdflags & CF_FIRSTNEG);
 468                     retstr = &str_yes;
 469                     goto flipmaybe;
 470                 }
 471                 else
 472                     hint = tmps;
 473             }
 474             else {
 475                 if (cmdflags & CF_NESURE) {
 476                     ++cmd->c_short->str_u.str_useful;
 477                     match = cmdflags & CF_FIRSTNEG;
 478                     retstr = &str_no;
 479                     goto flipmaybe;
 480                 }
 481             }
 482             if (--cmd->c_short->str_u.str_useful < 0) {
 483                 cmdflags &= ~CF_OPTIMIZE;
 484                 cmdflags |= CFT_EVAL;   /* never try this optimization again */
 485                 cmd->c_flags = (cmdflags & ~CF_ONCE);
 486             }
 487             break;                      /* must evaluate */
 488
 489         case CFT_NUMOP:         /* numeric op optimization */
 490             retstr = STAB_STR(cmd->c_stab);
 491             newsp = -2;
 492             switch (cmd->c_slen) {
 493             case O_EQ:
 494                 if (dowarn) {
 495                     if ((!retstr->str_nok && !looks_like_number(retstr)))
 496                         warn("Possible use of == on string value");
 497                 }
 498                 match = (str_gnum(retstr) == cmd->c_short->str_u.str_nval);
 499                 break;
 500             case O_NE:
 501                 match = (str_gnum(retstr) != cmd->c_short->str_u.str_nval);
 502                 break;
 503             case O_LT:
 504                 match = (str_gnum(retstr) <  cmd->c_short->str_u.str_nval);
 505                 break;
 506             case O_LE:
 507                 match = (str_gnum(retstr) <= cmd->c_short->str_u.str_nval);
 508                 break;
 509             case O_GT:
 510                 match = (str_gnum(retstr) >  cmd->c_short->str_u.str_nval);
 511                 break;
 512             case O_GE:
 513                 match = (str_gnum(retstr) >= cmd->c_short->str_u.str_nval);
 514                 break;
 515             }
 516             if (match) {
 517                 if (cmdflags & CF_EQSURE) {
 518                     retstr = &str_yes;
 519                     goto flipmaybe;
 520                 }
 521             }
 522             else if (cmdflags & CF_NESURE) {
 523                 retstr = &str_no;
 524                 goto flipmaybe;
 525             }
 526             break;                      /* must evaluate */
 527
 528         case CFT_INDGETS:               /* while (<$foo>) */
 529             last_in_stab = stabent(str_get(STAB_STR(cmd->c_stab)),TRUE);
 530             if (!stab_io(last_in_stab))
 531                 stab_io(last_in_stab) = stio_new();
 532             goto dogets;
 533         case CFT_GETS:                  /* really a while (<file>) */
 534             last_in_stab = cmd->c_stab;
 535           dogets:
 536             fp = stab_io(last_in_stab)->ifp;
 537             retstr = stab_val(defstab);
 538             newsp = -2;
 539           keepgoing:
 540             if (fp && str_gets(retstr, fp, 0)) {
 541                 if (*retstr->str_ptr == '0' && retstr->str_cur == 1)
 542                     match = FALSE;
 543                 else
 544                     match = TRUE;
 545                 stab_io(last_in_stab)->lines++;
 546             }
 547             else if (stab_io(last_in_stab)->flags & IOF_ARGV) {
 548                 if (!fp)
 549                     goto doeval;        /* first time through */
 550                 fp = nextargv(last_in_stab);
 551                 if (fp)
 552                     goto keepgoing;
 553                 (void)do_close(last_in_stab,FALSE);
 554                 stab_io(last_in_stab)->flags |= IOF_START;
 555                 retstr = &str_undef;
 556                 match = FALSE;
 557             }
 558             else {
 559                 retstr = &str_undef;
 560                 match = FALSE;
 561             }
 562             goto flipmaybe;
 563         case CFT_EVAL:
 564             break;
 565         case CFT_UNFLIP:
 566             while (tmps_max > tmps_base)        /* clean up after last eval */
 567                 str_free(tmps_list[tmps_max--]);
 568             newsp = eval(cmd->c_expr,gimme && (cmdflags & CF_TERM),sp);
 569             st = stack->ary_array;      /* possibly reallocated */
 570             retstr = st[newsp];
 571             match = str_true(retstr);
 572             if (cmd->c_expr->arg_type == O_FLIP)        /* undid itself? */
 573                 cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
 574             goto maybe;
 575         case CFT_CHOP:
 576             retstr = stab_val(cmd->c_stab);
 577             newsp = -2;
 578             match = (retstr->str_cur != 0);
 579             tmps = str_get(retstr);
 580             tmps += retstr->str_cur - match;
 581             str_nset(&str_chop,tmps,match);
 582             *tmps = '\0';
 583             retstr->str_nok = 0;
 584             retstr->str_cur = tmps - retstr->str_ptr;
 585             retstr = &str_chop;
 586             goto flipmaybe;
 587         case CFT_ARRAY:
 588             match = cmd->c_short->str_u.str_useful; /* just to get register */
 589
 590             if (match < 0) {            /* first time through here? */
 591                 ar = stab_array(cmd->c_expr[1].arg_ptr.arg_stab);
 592                 aryoptsave = savestack->ary_fill;
 593                 savesptr(&stab_val(cmd->c_stab));
 594                 savelong(&cmd->c_short->str_u.str_useful);
 595             }
 596             else {
 597                 ar = stab_xarray(cmd->c_expr[1].arg_ptr.arg_stab);
 598                 if (cmd->c_type != C_WHILE && savestack->ary_fill > firstsave)
 599                     restorelist(firstsave);
 600             }
 601
 602             if (match >= ar->ary_fill) {        /* we're in LAST, probably */
 603                 retstr = &str_undef;
 604                 cmd->c_short->str_u.str_useful = -1;    /* actually redundant */
 605                 match = FALSE;
 606             }
 607             else {
 608                 match++;
 609                 if (!(retstr = ar->ary_array[match]))
 610                     retstr = afetch(ar,match,TRUE);
 611                 stab_val(cmd->c_stab) = retstr;
 612                 cmd->c_short->str_u.str_useful = match;
 613                 match = TRUE;
 614             }
 615             newsp = -2;
 616             goto maybe;
 617         case CFT_D1:
 618             break;
 619         case CFT_D0:
 620             if (DBsingle->str_u.str_nval != 0)
 621                 break;
 622             if (DBsignal->str_u.str_nval != 0)
 623                 break;
 624             if (DBtrace->str_u.str_nval != 0)
 625                 break;
 626             goto next_cmd;
 627         }
 628
 629     /* we have tried to make this normal case as abnormal as possible */
 630
 631     doeval:
 632         if (gimme == G_ARRAY) {
 633             lastretstr = Nullstr;
 634             lastspbase = sp;
 635             lastsize = newsp - sp;
 636         }
 637         else
 638             lastretstr = retstr;
 639         while (tmps_max > tmps_base)    /* clean up after last eval */
 640             str_free(tmps_list[tmps_max--]);
 641         newsp = eval(cmd->c_expr,
 642           gimme && (cmdflags & CF_TERM) && cmd->c_type == C_EXPR &&
 643                 !cmd->ucmd.acmd.ac_expr,
 644           sp);
 645         st = stack->ary_array;  /* possibly reallocated */
 646         retstr = st[newsp];
 647         if (newsp > sp && retstr)
 648             match = str_true(retstr);
 649         else
 650             match = FALSE;
 651         goto maybe;
 652
 653     /* if flipflop was true, flop it */
 654
 655     flipmaybe:
 656         if (match && cmdflags & CF_FLIP) {
 657             while (tmps_max > tmps_base)        /* clean up after last eval */
 658                 str_free(tmps_list[tmps_max--]);
 659             if (cmd->c_expr->arg_type == O_FLOP) {      /* currently toggled? */
 660                 newsp = eval(cmd->c_expr,G_SCALAR,sp);/*let eval undo it*/
 661                 cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
 662             }
 663             else {
 664                 newsp = eval(cmd->c_expr,G_SCALAR,sp);/* let eval do it */
 665                 if (cmd->c_expr->arg_type == O_FLOP)    /* still toggled? */
 666                     cmdflags = copyopt(cmd,cmd->c_expr[4].arg_ptr.arg_cmd);
 667             }
 668         }
 669         else if (cmdflags & CF_FLIP) {
 670             if (cmd->c_expr->arg_type == O_FLOP) {      /* currently toggled? */
 671                 match = TRUE;                           /* force on */
 672             }
 673         }
 674
 675     /* at this point, match says whether our expression was true */
 676
 677     maybe:
 678         if (cmdflags & CF_INVERT)
 679             match = !match;
 680         if (!match)
 681             goto next_cmd;
 682     }
 683 #ifdef TAINT
 684     tainted = 0;        /* modifier doesn't affect regular expression */
 685 #endif
 686
 687     /* now to do the actual command, if any */
 688
 689     switch (cmd->c_type) {
 690     case C_NULL:
 691         fatal("panic: cmd_exec");
 692     case C_EXPR:                        /* evaluated for side effects */
 693         if (cmd->ucmd.acmd.ac_expr) {   /* more to do? */
 694             if (gimme == G_ARRAY) {
 695                 lastretstr = Nullstr;
 696                 lastspbase = sp;
 697                 lastsize = newsp - sp;
 698             }
 699             else
 700                 lastretstr = retstr;
 701             while (tmps_max > tmps_base)        /* clean up after last eval */
 702                 str_free(tmps_list[tmps_max--]);
 703             newsp = eval(cmd->ucmd.acmd.ac_expr,gimme && (cmdflags&CF_TERM),sp);
 704             st = stack->ary_array;      /* possibly reallocated */
 705             retstr = st[newsp];
 706         }
 707         break;
 708     case C_NSWITCH:
 709         {
 710             double value = str_gnum(STAB_STR(cmd->c_stab));
 711
 712             match = (int)value;
 713             if (value < 0.0) {
 714                 if (((double)match) > value)
 715                     --match;            /* was fractional--truncate other way */
 716             }
 717         }
 718         goto doswitch;
 719     case C_CSWITCH:
 720         match = *(str_get(STAB_STR(cmd->c_stab))) & 255;
 721       doswitch:
 722         match -= cmd->ucmd.scmd.sc_offset;
 723         if (match < 0)
 724             match = 0;
 725         else if (match > cmd->ucmd.scmd.sc_max)
 726             match = cmd->ucmd.scmd.sc_max;
 727         cmd = cmd->ucmd.scmd.sc_next[match];
 728         goto tail_recursion_entry;
 729     case C_NEXT:
 730         cmd = cmd->ucmd.ccmd.cc_alt;
 731         goto tail_recursion_entry;
 732     case C_ELSIF:
 733         fatal("panic: ELSIF");
 734     case C_IF:
 735         oldspat = curspat;
 736         oldsave = savestack->ary_fill;
 737 #ifdef DEBUGGING
 738         olddlevel = dlevel;
 739 #endif
 740         retstr = &str_yes;
 741         newsp = -2;
 742         if (cmd->ucmd.ccmd.cc_true) {
 743 #ifdef DEBUGGING
 744             if (debug) {
 745                 debname[dlevel] = 't';
 746                 debdelim[dlevel] = '_';
 747                 if (++dlevel >= dlmax)
 748                     grow_dlevel();
 749             }
 750 #endif
 751             newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
 752             st = stack->ary_array;      /* possibly reallocated */
 753             retstr = st[newsp];
 754         }
 755         curspat = oldspat;
 756         if (savestack->ary_fill > oldsave)
 757             restorelist(oldsave);
 758 #ifdef DEBUGGING
 759         dlevel = olddlevel;
 760 #endif
 761         cmd = cmd->ucmd.ccmd.cc_alt;
 762         goto tail_recursion_entry;
 763     case C_ELSE:
 764         oldspat = curspat;
 765         oldsave = savestack->ary_fill;
 766 #ifdef DEBUGGING
 767         olddlevel = dlevel;
 768 #endif
 769         retstr = &str_undef;
 770         newsp = -2;
 771         if (cmd->ucmd.ccmd.cc_true) {
 772 #ifdef DEBUGGING
 773             if (debug) {
 774                 debname[dlevel] = 'e';
 775                 debdelim[dlevel] = '_';
 776                 if (++dlevel >= dlmax)
 777                     grow_dlevel();
 778             }
 779 #endif
 780             newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
 781             st = stack->ary_array;      /* possibly reallocated */
 782             retstr = st[newsp];
 783         }
 784         curspat = oldspat;
 785         if (savestack->ary_fill > oldsave)
 786             restorelist(oldsave);
 787 #ifdef DEBUGGING
 788         dlevel = olddlevel;
 789 #endif
 790         break;
 791     case C_BLOCK:
 792     case C_WHILE:
 793         if (!(cmdflags & CF_ONCE)) {    /* first time through here? */
 794             cmdflags |= CF_ONCE;
 795             if (++loop_ptr >= loop_max) {
 796                 loop_max += 128;
 797                 Renew(loop_stack, loop_max, struct loop);
 798             }
 799             loop_stack[loop_ptr].loop_label = cmd->c_label;
 800             loop_stack[loop_ptr].loop_sp = sp;
 801 #ifdef DEBUGGING
 802             if (debug & 4) {
 803                 deb("(Pushing label #%d %s)\n",
 804                   loop_ptr, cmd->c_label ? cmd->c_label : "");
 805             }
 806 #endif
 807         }
 808 #ifdef JMPCLOBBER
 809         cmdparm = cmd;
 810 #endif
 811         if (match = setjmp(loop_stack[loop_ptr].loop_env)) {
 812             st = stack->ary_array;      /* possibly reallocated */
 813 #ifdef JMPCLOBBER
 814             cmd = cmdparm;
 815             cmdflags = cmd->c_flags|CF_ONCE;
 816             go_to = goto_targ;
 817 #endif
 818             if (savestack->ary_fill > oldsave)
 819                 restorelist(oldsave);
 820             switch (match) {
 821             default:
 822                 fatal("longjmp returned bad value (%d)",match);
 823             case O_LAST:
 824                 if (lastretstr) {
 825                     retstr = lastretstr;
 826                     newsp = -2;
 827                 }
 828                 else {
 829                     newsp = sp + lastsize;
 830                     retstr = st[newsp];
 831                 }
 832                 curspat = oldspat;
 833                 goto next_cmd;
 834             case O_NEXT:
 835 #ifdef JMPCLOBBER
 836                 newsp = -2;
 837                 retstr = &str_undef;
 838 #endif
 839                 goto next_iter;
 840             case O_REDO:
 841 #ifdef DEBUGGING
 842                 dlevel = olddlevel;
 843 #endif
 844 #ifdef JMPCLOBBER
 845                 newsp = -2;
 846                 retstr = &str_undef;
 847 #endif
 848                 goto doit;
 849             }
 850         }
 851         oldspat = curspat;
 852         oldsave = savestack->ary_fill;
 853 #ifdef DEBUGGING
 854         olddlevel = dlevel;
 855 #endif
 856     doit:
 857         if (cmd->ucmd.ccmd.cc_true) {
 858 #ifdef DEBUGGING
 859             if (debug) {
 860                 debname[dlevel] = 't';
 861                 debdelim[dlevel] = '_';
 862                 if (++dlevel >= dlmax)
 863                     grow_dlevel();
 864             }
 865 #endif
 866             newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
 867             st = stack->ary_array;      /* possibly reallocated */
 868             retstr = st[newsp];
 869         }
 870         /* actually, this spot is rarely reached anymore since the above
 871          * cmd_exec() returns through longjmp().  Hooray for structure.
 872          */
 873       next_iter:
 874 #ifdef DEBUGGING
 875         dlevel = olddlevel;
 876 #endif
 877         if (cmd->ucmd.ccmd.cc_alt) {
 878 #ifdef DEBUGGING
 879             if (debug) {
 880                 debname[dlevel] = 'a';
 881                 debdelim[dlevel] = '_';
 882                 if (++dlevel >= dlmax)
 883                     grow_dlevel();
 884             }
 885 #endif
 886             newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme && (cmdflags & CF_TERM),sp);
 887             st = stack->ary_array;      /* possibly reallocated */
 888             retstr = st[newsp];
 889         }
 890       finish_while:
 891         curspat = oldspat;
 892         if (savestack->ary_fill > oldsave) {
 893             if (cmdflags & CF_TERM) {
 894                 for (match = sp + 1; match <= newsp; match++)
 895                     st[match] = str_static(st[match]);
 896                 retstr = st[newsp];
 897             }
 898             restorelist(oldsave);
 899         }
 900 #ifdef DEBUGGING
 901         dlevel = olddlevel - 1;
 902 #endif
 903         if (cmd->c_type != C_BLOCK)
 904             goto until_loop;    /* go back and evaluate conditional again */
 905     }
 906     if (cmdflags & CF_LOOP) {
 907         cmdflags |= CF_COND;            /* now test the condition */
 908 #ifdef DEBUGGING
 909         dlevel = entdlevel;
 910 #endif
 911         goto until_loop;
 912     }
 913   next_cmd:
 914     if (cmdflags & CF_ONCE) {
 915 #ifdef DEBUGGING
 916         if (debug & 4) {
 917             tmps = loop_stack[loop_ptr].loop_label;
 918             deb("(Popping label #%d %s)\n",loop_ptr, tmps ? tmps : "");
 919         }
 920 #endif
 921         loop_ptr--;
 922         if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY &&
 923           savestack->ary_fill > aryoptsave)
 924             restorelist(aryoptsave);
 925     }
 926     cmd = cmd->c_next;
 927     goto tail_recursion_entry;
 928 }
 929
 930 #ifdef DEBUGGING
 931 #  ifndef VARARGS
 932 /*VARARGS1*/
 933 deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
 934 char *pat;
 935 {
 936     register int i;
 937
 938     fprintf(stderr,"%-4ld",(long)curcmd->c_line);
 939     for (i=0; i<dlevel; i++)
 940         fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
 941     fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
 942 }
 943 #  else
 944 /*VARARGS1*/
 945 deb(va_alist)
 946 va_dcl
 947 {
 948     va_list args;
 949     char *pat;
 950     register int i;
 951
 952     va_start(args);
 953     fprintf(stderr,"%-4ld",(long)curcmd->c_line);
 954     for (i=0; i<dlevel; i++)
 955         fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
 956
 957     pat = va_arg(args, char *);
 958     (void) vfprintf(stderr,pat,args);
 959     va_end( args );
 960 }
 961 #  endif
 962 #endif
 963
 964 copyopt(cmd,which)
 965 register CMD *cmd;
 966 register CMD *which;
 967 {
 968     cmd->c_flags &= CF_ONCE|CF_COND|CF_LOOP;
 969     cmd->c_flags |= which->c_flags;
 970     cmd->c_short = which->c_short;
 971     cmd->c_slen = which->c_slen;
 972     cmd->c_stab = which->c_stab;
 973     return cmd->c_flags;
 974 }
 975
 976 ARRAY *
 977 saveary(stab)
 978 STAB *stab;
 979 {
 980     register STR *str;
 981
 982     str = Str_new(10,0);
 983     str->str_state = SS_SARY;
 984     str->str_u.str_stab = stab;
 985     if (str->str_ptr) {
 986         Safefree(str->str_ptr);
 987         str->str_len = 0;
 988     }
 989     str->str_ptr = (char*)stab_array(stab);
 990     (void)apush(savestack,str); /* save array ptr */
 991     stab_xarray(stab) = Null(ARRAY*);
 992     return stab_xarray(aadd(stab));
 993 }
 994
 995 HASH *
 996 savehash(stab)
 997 STAB *stab;
 998 {
 999     register STR *str;
1000
1001     str = Str_new(11,0);
1002     str->str_state = SS_SHASH;
1003     str->str_u.str_stab = stab;
1004     if (str->str_ptr) {
1005         Safefree(str->str_ptr);
1006         str->str_len = 0;
1007     }
1008     str->str_ptr = (char*)stab_hash(stab);
1009     (void)apush(savestack,str); /* save hash ptr */
1010     stab_xhash(stab) = Null(HASH*);
1011     return stab_xhash(hadd(stab));
1012 }
1013
1014 void
1015 saveitem(item)
1016 register STR *item;
1017 {
1018     register STR *str;
1019
1020     (void)apush(savestack,item);                /* remember the pointer */
1021     str = Str_new(12,0);
1022     str_sset(str,item);
1023     (void)apush(savestack,str);                 /* remember the value */
1024 }
1025
1026 void
1027 saveint(intp)
1028 int *intp;
1029 {
1030     register STR *str;
1031
1032     str = Str_new(13,0);
1033     str->str_state = SS_SINT;
1034     str->str_u.str_useful = (long)*intp;        /* remember value */
1035     if (str->str_ptr) {
1036         Safefree(str->str_ptr);
1037         str->str_len = 0;
1038     }
1039     str->str_ptr = (char*)intp;         /* remember pointer */
1040     (void)apush(savestack,str);
1041 }
1042
1043 void
1044 savelong(longp)
1045 long *longp;
1046 {
1047     register STR *str;
1048
1049     str = Str_new(14,0);
1050     str->str_state = SS_SLONG;
1051     str->str_u.str_useful = *longp;             /* remember value */
1052     if (str->str_ptr) {
1053         Safefree(str->str_ptr);
1054         str->str_len = 0;
1055     }
1056     str->str_ptr = (char*)longp;                /* remember pointer */
1057     (void)apush(savestack,str);
1058 }
1059
1060 void
1061 savesptr(sptr)
1062 STR **sptr;
1063 {
1064     register STR *str;
1065
1066     str = Str_new(15,0);
1067     str->str_state = SS_SSTRP;
1068     str->str_magic = *sptr;             /* remember value */
1069     if (str->str_ptr) {
1070         Safefree(str->str_ptr);
1071         str->str_len = 0;
1072     }
1073     str->str_ptr = (char*)sptr;         /* remember pointer */
1074     (void)apush(savestack,str);
1075 }
1076
1077 void
1078 savenostab(stab)
1079 STAB *stab;
1080 {
1081     register STR *str;
1082
1083     str = Str_new(16,0);
1084     str->str_state = SS_SNSTAB;
1085     str->str_magic = (STR*)stab;        /* remember which stab to free */
1086     (void)apush(savestack,str);
1087 }
1088
1089 void
1090 savehptr(hptr)
1091 HASH **hptr;
1092 {
1093     register STR *str;
1094
1095     str = Str_new(17,0);
1096     str->str_state = SS_SHPTR;
1097     str->str_u.str_hash = *hptr;        /* remember value */
1098     if (str->str_ptr) {
1099         Safefree(str->str_ptr);
1100         str->str_len = 0;
1101     }
1102     str->str_ptr = (char*)hptr;         /* remember pointer */
1103     (void)apush(savestack,str);
1104 }
1105
1106 void
1107 savelist(sarg,maxsarg)
1108 register STR **sarg;
1109 int maxsarg;
1110 {
1111     register STR *str;
1112     register int i;
1113
1114     for (i = 1; i <= maxsarg; i++) {
1115         (void)apush(savestack,sarg[i]);         /* remember the pointer */
1116         str = Str_new(18,0);
1117         str_sset(str,sarg[i]);
1118         (void)apush(savestack,str);                     /* remember the value */
1119         sarg[i]->str_u.str_useful = -1;
1120     }
1121 }
1122
1123 void
1124 restorelist(base)
1125 int base;
1126 {
1127     register STR *str;
1128     register STR *value;
1129     register STAB *stab;
1130
1131     if (base < -1)
1132         fatal("panic: corrupt saved stack index");
1133     while (savestack->ary_fill > base) {
1134         value = apop(savestack);
1135         switch (value->str_state) {
1136         case SS_NORM:                           /* normal string */
1137         case SS_INCR:
1138             str = apop(savestack);
1139             str_replace(str,value);
1140             STABSET(str);
1141             break;
1142         case SS_SARY:                           /* array reference */
1143             stab = value->str_u.str_stab;
1144             afree(stab_xarray(stab));
1145             stab_xarray(stab) = (ARRAY*)value->str_ptr;
1146             value->str_ptr = Nullch;
1147             str_free(value);
1148             break;
1149         case SS_SHASH:                          /* hash reference */
1150             stab = value->str_u.str_stab;
1151             (void)hfree(stab_xhash(stab), FALSE);
1152             stab_xhash(stab) = (HASH*)value->str_ptr;
1153             value->str_ptr = Nullch;
1154             str_free(value);
1155             break;
1156         case SS_SINT:                           /* int reference */
1157             *((int*)value->str_ptr) = (int)value->str_u.str_useful;
1158             value->str_ptr = Nullch;
1159             str_free(value);
1160             break;
1161         case SS_SLONG:                          /* long reference */
1162             *((long*)value->str_ptr) = value->str_u.str_useful;
1163             value->str_ptr = Nullch;
1164             str_free(value);
1165             break;
1166         case SS_SSTRP:                          /* STR* reference */
1167             *((STR**)value->str_ptr) = value->str_magic;
1168             value->str_magic = Nullstr;
1169             value->str_ptr = Nullch;
1170             str_free(value);
1171             break;
1172         case SS_SHPTR:                          /* HASH* reference */
1173             *((HASH**)value->str_ptr) = value->str_u.str_hash;
1174             value->str_ptr = Nullch;
1175             str_free(value);
1176             break;
1177         case SS_SNSTAB:
1178             stab = (STAB*)value->str_magic;
1179             value->str_magic = Nullstr;
1180             (void)stab_clear(stab);
1181             str_free(value);
1182             break;
1183         case SS_SCSV:                           /* callsave structure */
1184             {
1185                 CSV *csv = (CSV*) value->str_ptr;
1186
1187                 curcmd = csv->curcmd;
1188                 curcsv = csv->curcsv;
1189                 csv->sub->depth = csv->depth;
1190                 if (csv->hasargs) {             /* put back old @_ */
1191                     afree(csv->argarray);
1192                     stab_xarray(defstab) = csv->savearray;
1193                 }
1194                 str_free(value);
1195             }
1196             break;
1197         default:
1198             fatal("panic: restorelist inconsistency");
1199         }
1200     }
1201 }
1202
1203 #ifdef DEBUGGING
1204 void
1205 grow_dlevel()
1206 {
1207     dlmax += 128;
1208     Renew(debname, dlmax, char);
1209     Renew(debdelim, dlmax, char);
1210 }
1211 #endif