cmd.c

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