cmd.c

   1 /* $Header: cmd.c,v 2.0 88/06/05 00:08:24 root Exp $
   2  *
   3  * $Log:        cmd.c,v $
   4  * Revision 2.0  88/06/05  00:08:24  root
   5  * Baseline version 2.0.
   6  *
   7  */
   8
   9 #include "EXTERN.h"
  10 #include "perl.h"
  11
  12 static STR str_chop;
  13
  14 /* This is the main command loop.  We try to spend as much time in this loop
  15  * as possible, so lots of optimizations do their activities in here.  This
  16  * means things get a little sloppy.
  17  */
  18
  19 STR *
  20 cmd_exec(cmd)
  21 #ifdef cray     /* nobody else has complained yet */
  22 CMD *cmd;
  23 #else
  24 register CMD *cmd;
  25 #endif
  26 {
  27     SPAT *oldspat;
  28     int oldsave;
  29 #ifdef DEBUGGING
  30     int olddlevel;
  31     int entdlevel;
  32 #endif
  33     register STR *retstr;
  34     register char *tmps;
  35     register int cmdflags;
  36     register int match;
  37     register char *go_to = goto_targ;
  38     FILE *fp;
  39     ARRAY *ar;
  40
  41     retstr = &str_no;
  42 #ifdef DEBUGGING
  43     entdlevel = dlevel;
  44 #endif
  45 tail_recursion_entry:
  46 #ifdef DEBUGGING
  47     dlevel = entdlevel;
  48 #endif
  49     if (cmd == Nullcmd)
  50         return retstr;
  51     cmdflags = cmd->c_flags;    /* hopefully load register */
  52     if (go_to) {
  53         if (cmd->c_label && strEQ(go_to,cmd->c_label))
  54             goto_targ = go_to = Nullch;         /* here at last */
  55         else {
  56             switch (cmd->c_type) {
  57             case C_IF:
  58                 oldspat = curspat;
  59                 oldsave = savestack->ary_fill;
  60 #ifdef DEBUGGING
  61                 olddlevel = dlevel;
  62 #endif
  63                 retstr = &str_yes;
  64                 if (cmd->ucmd.ccmd.cc_true) {
  65 #ifdef DEBUGGING
  66                     if (debug) {
  67                         debname[dlevel] = 't';
  68                         debdelim[dlevel++] = '_';
  69                     }
  70 #endif
  71                     retstr = cmd_exec(cmd->ucmd.ccmd.cc_true);
  72                 }
  73                 if (!goto_targ) {
  74                     go_to = Nullch;
  75                 } else {
  76                     retstr = &str_no;
  77                     if (cmd->ucmd.ccmd.cc_alt) {
  78 #ifdef DEBUGGING
  79                         if (debug) {
  80                             debname[dlevel] = 'e';
  81                             debdelim[dlevel++] = '_';
  82                         }
  83 #endif
  84                         retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt);
  85                     }
  86                 }
  87                 if (!goto_targ)
  88                     go_to = Nullch;
  89                 curspat = oldspat;
  90                 if (savestack->ary_fill > oldsave)
  91                     restorelist(oldsave);
  92 #ifdef DEBUGGING
  93                 dlevel = olddlevel;
  94 #endif
  95                 break;
  96             case C_BLOCK:
  97             case C_WHILE:
  98                 if (!(cmdflags & CF_ONCE)) {
  99                     cmdflags |= CF_ONCE;
 100                     loop_ptr++;
 101                     loop_stack[loop_ptr].loop_label = cmd->c_label;
 102 #ifdef DEBUGGING
 103                     if (debug & 4) {
 104                         deb("(Pushing label #%d %s)\n",
 105                           loop_ptr,cmd->c_label);
 106                     }
 107 #endif
 108                 }
 109                 switch (setjmp(loop_stack[loop_ptr].loop_env)) {
 110                 case O_LAST:    /* not done unless go_to found */
 111                     go_to = Nullch;
 112                     retstr = &str_no;
 113 #ifdef DEBUGGING
 114                     olddlevel = dlevel;
 115 #endif
 116                     curspat = oldspat;
 117                     if (savestack->ary_fill > oldsave)
 118                         restorelist(oldsave);
 119                     goto next_cmd;
 120                 case O_NEXT:    /* not done unless go_to found */
 121                     go_to = Nullch;
 122                     goto next_iter;
 123                 case O_REDO:    /* not done unless go_to found */
 124                     go_to = Nullch;
 125                     goto doit;
 126                 }
 127                 oldspat = curspat;
 128                 oldsave = savestack->ary_fill;
 129 #ifdef DEBUGGING
 130                 olddlevel = dlevel;
 131 #endif
 132                 if (cmd->ucmd.ccmd.cc_true) {
 133 #ifdef DEBUGGING
 134                     if (debug) {
 135                         debname[dlevel] = 't';
 136                         debdelim[dlevel++] = '_';
 137                     }
 138 #endif
 139                     cmd_exec(cmd->ucmd.ccmd.cc_true);
 140                 }
 141                 if (!goto_targ) {
 142                     go_to = Nullch;
 143                     goto next_iter;
 144                 }
 145 #ifdef DEBUGGING
 146                 dlevel = olddlevel;
 147 #endif
 148                 if (cmd->ucmd.ccmd.cc_alt) {
 149 #ifdef DEBUGGING
 150                     if (debug) {
 151                         debname[dlevel] = 'a';
 152                         debdelim[dlevel++] = '_';
 153                     }
 154 #endif
 155                     cmd_exec(cmd->ucmd.ccmd.cc_alt);
 156                 }
 157                 if (goto_targ)
 158                     break;
 159                 go_to = Nullch;
 160                 goto finish_while;
 161             }
 162             cmd = cmd->c_next;
 163             if (cmd && cmd->c_head == cmd)
 164                                         /* reached end of while loop */
 165                 return retstr;          /* targ isn't in this block */
 166             if (cmdflags & CF_ONCE) {
 167 #ifdef DEBUGGING
 168                 if (debug & 4) {
 169                     deb("(Popping label #%d %s)\n",loop_ptr,
 170                         loop_stack[loop_ptr].loop_label);
 171                 }
 172 #endif
 173                 loop_ptr--;
 174             }
 175             goto tail_recursion_entry;
 176         }
 177     }
 178
 179 until_loop:
 180
 181     /* Set line number so run-time errors can be located */
 182
 183     line = cmd->c_line;
 184
 185 #ifdef DEBUGGING
 186     if (debug) {
 187         if (debug & 2) {
 188             deb("%s     (%lx)   r%lx    t%lx    a%lx    n%lx    cs%lx\n",
 189                 cmdname[cmd->c_type],cmd,cmd->c_expr,
 190                 cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt,cmd->c_next,
 191                 curspat);
 192         }
 193         debname[dlevel] = cmdname[cmd->c_type][0];
 194         debdelim[dlevel++] = '!';
 195     }
 196 #endif
 197     while (tmps_max > tmps_base)                /* clean up after last eval */
 198         str_free(tmps_list[tmps_max--]);
 199
 200     /* Here is some common optimization */
 201
 202     if (cmdflags & CF_COND) {
 203         switch (cmdflags & CF_OPTIMIZE) {
 204
 205         case CFT_FALSE:
 206             retstr = cmd->c_short;
 207             match = FALSE;
 208             if (cmdflags & CF_NESURE)
 209                 goto maybe;
 210             break;
 211         case CFT_TRUE:
 212             retstr = cmd->c_short;
 213             match = TRUE;
 214             if (cmdflags & CF_EQSURE)
 215                 goto flipmaybe;
 216             break;
 217
 218         case CFT_REG:
 219             retstr = STAB_STR(cmd->c_stab);
 220             match = str_true(retstr);   /* => retstr = retstr, c2 should fix */
 221             if (cmdflags & (match ? CF_EQSURE : CF_NESURE))
 222                 goto flipmaybe;
 223             break;
 224
 225         case CFT_ANCHOR:        /* /^pat/ optimization */
 226             if (multiline) {
 227                 if (*cmd->c_short->str_ptr && !(cmdflags & CF_EQSURE))
 228                     goto scanner;       /* just unanchor it */
 229                 else
 230                     break;              /* must evaluate */
 231             }
 232             /* FALL THROUGH */
 233         case CFT_STROP:         /* string op optimization */
 234             retstr = STAB_STR(cmd->c_stab);
 235             if (*cmd->c_short->str_ptr == *str_get(retstr) &&
 236                     strnEQ(cmd->c_short->str_ptr, str_get(retstr),
 237                       cmd->c_slen) ) {
 238                 if (cmdflags & CF_EQSURE) {
 239                     match = !(cmdflags & CF_FIRSTNEG);
 240                     retstr = &str_yes;
 241                     goto flipmaybe;
 242                 }
 243             }
 244             else if (cmdflags & CF_NESURE) {
 245                 match = cmdflags & CF_FIRSTNEG;
 246                 retstr = &str_no;
 247                 goto flipmaybe;
 248             }
 249             break;                      /* must evaluate */
 250
 251         case CFT_SCAN:                  /* non-anchored search */
 252           scanner:
 253             retstr = STAB_STR(cmd->c_stab);
 254             if (retstr->str_pok == 5)
 255                 if (screamfirst[cmd->c_short->str_rare] >= 0)
 256                     tmps = screaminstr(retstr, cmd->c_short);
 257                 else
 258                     tmps = Nullch;
 259             else {
 260                 tmps = str_get(retstr);         /* make sure it's pok */
 261                 tmps = fbminstr(tmps, tmps + retstr->str_cur, cmd->c_short);
 262             }
 263             if (tmps) {
 264                 if (cmdflags & CF_EQSURE) {
 265                     ++*(long*)&cmd->c_short->str_nval;
 266                     match = !(cmdflags & CF_FIRSTNEG);
 267                     retstr = &str_yes;
 268                     goto flipmaybe;
 269                 }
 270                 else
 271                     hint = tmps;
 272             }
 273             else {
 274                 if (cmdflags & CF_NESURE) {
 275                     ++*(long*)&cmd->c_short->str_nval;
 276                     match = cmdflags & CF_FIRSTNEG;
 277                     retstr = &str_no;
 278                     goto flipmaybe;
 279                 }
 280             }
 281             if (--*(long*)&cmd->c_short->str_nval < 0) {
 282                 str_free(cmd->c_short);
 283                 cmd->c_short = Nullstr;
 284                 cmdflags &= ~CF_OPTIMIZE;
 285                 cmdflags |= CFT_EVAL;   /* never try this optimization again */
 286                 cmd->c_flags = cmdflags;
 287             }
 288             break;                      /* must evaluate */
 289
 290         case CFT_NUMOP:         /* numeric op optimization */
 291             retstr = STAB_STR(cmd->c_stab);
 292             switch (cmd->c_slen) {
 293             case O_EQ:
 294                 match = (str_gnum(retstr) == cmd->c_short->str_nval);
 295                 break;
 296             case O_NE:
 297                 match = (str_gnum(retstr) != cmd->c_short->str_nval);
 298                 break;
 299             case O_LT:
 300                 match = (str_gnum(retstr) <  cmd->c_short->str_nval);
 301                 break;
 302             case O_LE:
 303                 match = (str_gnum(retstr) <= cmd->c_short->str_nval);
 304                 break;
 305             case O_GT:
 306                 match = (str_gnum(retstr) >  cmd->c_short->str_nval);
 307                 break;
 308             case O_GE:
 309                 match = (str_gnum(retstr) >= cmd->c_short->str_nval);
 310                 break;
 311             }
 312             if (match) {
 313                 if (cmdflags & CF_EQSURE) {
 314                     retstr = &str_yes;
 315                     goto flipmaybe;
 316                 }
 317             }
 318             else if (cmdflags & CF_NESURE) {
 319                 retstr = &str_no;
 320                 goto flipmaybe;
 321             }
 322             break;                      /* must evaluate */
 323
 324         case CFT_INDGETS:               /* while (<$foo>) */
 325             last_in_stab = stabent(str_get(STAB_STR(cmd->c_stab)),TRUE);
 326             if (!last_in_stab->stab_io)
 327                 last_in_stab->stab_io = stio_new();
 328             goto dogets;
 329         case CFT_GETS:                  /* really a while (<file>) */
 330             last_in_stab = cmd->c_stab;
 331           dogets:
 332             fp = last_in_stab->stab_io->fp;
 333             retstr = defstab->stab_val;
 334             if (fp && str_gets(retstr, fp)) {
 335                 if (*retstr->str_ptr == '0' && !retstr->str_ptr[1])
 336                     match = FALSE;
 337                 else
 338                     match = TRUE;
 339                 last_in_stab->stab_io->lines++;
 340             }
 341             else if (last_in_stab->stab_io->flags & IOF_ARGV)
 342                 goto doeval;    /* doesn't necessarily count as EOF yet */
 343             else {
 344                 retstr = &str_no;
 345                 match = FALSE;
 346             }
 347             goto flipmaybe;
 348         case CFT_EVAL:
 349             break;
 350         case CFT_UNFLIP:
 351             retstr = eval(cmd->c_expr,Null(STR***),-1);
 352             match = str_true(retstr);
 353             if (cmd->c_expr->arg_type == O_FLIP)        /* undid itself? */
 354                 cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
 355             goto maybe;
 356         case CFT_CHOP:
 357             retstr = cmd->c_stab->stab_val;
 358             match = (retstr->str_cur != 0);
 359             tmps = str_get(retstr);
 360             tmps += retstr->str_cur - match;
 361             str_set(&str_chop,tmps);
 362             *tmps = '\0';
 363             retstr->str_nok = 0;
 364             retstr->str_cur = tmps - retstr->str_ptr;
 365             retstr = &str_chop;
 366             goto flipmaybe;
 367         case CFT_ARRAY:
 368             ar = cmd->c_expr[1].arg_ptr.arg_stab->stab_array;
 369             match = ar->ary_index;      /* just to get register */
 370
 371             if (match < 0)              /* first time through here? */
 372                 cmd->c_short = cmd->c_stab->stab_val;
 373
 374             if (match >= ar->ary_fill) {
 375                 ar->ary_index = -1;
 376 /*              cmd->c_stab->stab_val = cmd->c_short; - Can't be done in LAST */
 377                 match = FALSE;
 378             }
 379             else {
 380                 match++;
 381                 retstr = cmd->c_stab->stab_val = ar->ary_array[match];
 382                 ar->ary_index = match;
 383                 match = TRUE;
 384             }
 385             goto maybe;
 386         }
 387
 388     /* we have tried to make this normal case as abnormal as possible */
 389
 390     doeval:
 391         lastretstr = retstr;
 392         retstr = eval(cmd->c_expr,Null(STR***),-1);
 393         match = str_true(retstr);
 394         goto maybe;
 395
 396     /* if flipflop was true, flop it */
 397
 398     flipmaybe:
 399         if (match && cmdflags & CF_FLIP) {
 400             if (cmd->c_expr->arg_type == O_FLOP) {      /* currently toggled? */
 401                 retstr = eval(cmd->c_expr,Null(STR***),-1);/*let eval undo it*/
 402                 cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
 403             }
 404             else {
 405                 retstr = eval(cmd->c_expr,Null(STR***),-1);/* let eval do it */
 406                 if (cmd->c_expr->arg_type == O_FLOP)    /* still toggled? */
 407                     cmdflags = copyopt(cmd,cmd->c_expr[4].arg_ptr.arg_cmd);
 408             }
 409         }
 410         else if (cmdflags & CF_FLIP) {
 411             if (cmd->c_expr->arg_type == O_FLOP) {      /* currently toggled? */
 412                 match = TRUE;                           /* force on */
 413             }
 414         }
 415
 416     /* at this point, match says whether our expression was true */
 417
 418     maybe:
 419         if (cmdflags & CF_INVERT)
 420             match = !match;
 421         if (!match && cmd->c_type != C_IF)
 422             goto next_cmd;
 423     }
 424
 425     /* now to do the actual command, if any */
 426
 427     switch (cmd->c_type) {
 428     case C_NULL:
 429         fatal("panic: cmd_exec");
 430     case C_EXPR:                        /* evaluated for side effects */
 431         if (cmd->ucmd.acmd.ac_expr) {   /* more to do? */
 432             lastretstr = retstr;
 433             retstr = eval(cmd->ucmd.acmd.ac_expr,Null(STR***),-1);
 434         }
 435         break;
 436     case C_IF:
 437         oldspat = curspat;
 438         oldsave = savestack->ary_fill;
 439 #ifdef DEBUGGING
 440         olddlevel = dlevel;
 441 #endif
 442         if (match) {
 443             retstr = &str_yes;
 444             if (cmd->ucmd.ccmd.cc_true) {
 445 #ifdef DEBUGGING
 446                 if (debug) {
 447                     debname[dlevel] = 't';
 448                     debdelim[dlevel++] = '_';
 449                 }
 450 #endif
 451                 retstr = cmd_exec(cmd->ucmd.ccmd.cc_true);
 452             }
 453         }
 454         else {
 455             retstr = &str_no;
 456             if (cmd->ucmd.ccmd.cc_alt) {
 457 #ifdef DEBUGGING
 458                 if (debug) {
 459                     debname[dlevel] = 'e';
 460                     debdelim[dlevel++] = '_';
 461                 }
 462 #endif
 463                 retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt);
 464             }
 465         }
 466         curspat = oldspat;
 467         if (savestack->ary_fill > oldsave)
 468             restorelist(oldsave);
 469 #ifdef DEBUGGING
 470         dlevel = olddlevel;
 471 #endif
 472         break;
 473     case C_BLOCK:
 474     case C_WHILE:
 475         if (!(cmdflags & CF_ONCE)) {    /* first time through here? */
 476             cmdflags |= CF_ONCE;
 477             loop_ptr++;
 478             loop_stack[loop_ptr].loop_label = cmd->c_label;
 479 #ifdef DEBUGGING
 480             if (debug & 4) {
 481                 deb("(Pushing label #%d %s)\n",
 482                   loop_ptr,cmd->c_label);
 483             }
 484 #endif
 485         }
 486         switch (setjmp(loop_stack[loop_ptr].loop_env)) {
 487         case O_LAST:
 488             retstr = lastretstr;
 489             curspat = oldspat;
 490             if (savestack->ary_fill > oldsave)
 491                 restorelist(oldsave);
 492             goto next_cmd;
 493         case O_NEXT:
 494             goto next_iter;
 495         case O_REDO:
 496 #ifdef DEBUGGING
 497             dlevel = olddlevel;
 498 #endif
 499             goto doit;
 500         }
 501         oldspat = curspat;
 502         oldsave = savestack->ary_fill;
 503 #ifdef DEBUGGING
 504         olddlevel = dlevel;
 505 #endif
 506     doit:
 507         if (cmd->ucmd.ccmd.cc_true) {
 508 #ifdef DEBUGGING
 509             if (debug) {
 510                 debname[dlevel] = 't';
 511                 debdelim[dlevel++] = '_';
 512             }
 513 #endif
 514             cmd_exec(cmd->ucmd.ccmd.cc_true);
 515         }
 516         /* actually, this spot is rarely reached anymore since the above
 517          * cmd_exec() returns through longjmp().  Hooray for structure.
 518          */
 519       next_iter:
 520 #ifdef DEBUGGING
 521         dlevel = olddlevel;
 522 #endif
 523         if (cmd->ucmd.ccmd.cc_alt) {
 524 #ifdef DEBUGGING
 525             if (debug) {
 526                 debname[dlevel] = 'a';
 527                 debdelim[dlevel++] = '_';
 528             }
 529 #endif
 530             cmd_exec(cmd->ucmd.ccmd.cc_alt);
 531         }
 532       finish_while:
 533         curspat = oldspat;
 534         if (savestack->ary_fill > oldsave)
 535             restorelist(oldsave);
 536 #ifdef DEBUGGING
 537         dlevel = olddlevel - 1;
 538 #endif
 539         if (cmd->c_type != C_BLOCK)
 540             goto until_loop;    /* go back and evaluate conditional again */
 541     }
 542     if (cmdflags & CF_LOOP) {
 543         cmdflags |= CF_COND;            /* now test the condition */
 544 #ifdef DEBUGGING
 545         dlevel = entdlevel;
 546 #endif
 547         goto until_loop;
 548     }
 549   next_cmd:
 550     if (cmdflags & CF_ONCE) {
 551 #ifdef DEBUGGING
 552         if (debug & 4) {
 553             deb("(Popping label #%d %s)\n",loop_ptr,
 554                 loop_stack[loop_ptr].loop_label);
 555         }
 556 #endif
 557         loop_ptr--;
 558         if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY) {
 559             cmd->c_stab->stab_val = cmd->c_short;
 560         }
 561     }
 562     cmd = cmd->c_next;
 563     goto tail_recursion_entry;
 564 }
 565
 566 #ifdef DEBUGGING
 567 /*VARARGS1*/
 568 deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
 569 char *pat;
 570 {
 571     register int i;
 572
 573     fprintf(stderr,"%-4ld",(long)line);
 574     for (i=0; i<dlevel; i++)
 575         fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
 576     fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
 577 }
 578 #endif
 579
 580 copyopt(cmd,which)
 581 register CMD *cmd;
 582 register CMD *which;
 583 {
 584     cmd->c_flags &= CF_ONCE|CF_COND|CF_LOOP;
 585     cmd->c_flags |= which->c_flags;
 586     cmd->c_short = which->c_short;
 587     cmd->c_slen = which->c_slen;
 588     cmd->c_stab = which->c_stab;
 589     return cmd->c_flags;
 590 }
 591
 592 void
 593 savelist(sarg,maxsarg)
 594 register STR **sarg;
 595 int maxsarg;
 596 {
 597     register STR *str;
 598     register int i;
 599
 600     for (i = 1; i <= maxsarg; i++) {
 601         apush(savestack,sarg[i]);               /* remember the pointer */
 602         str = str_new(0);
 603         str_sset(str,sarg[i]);
 604         apush(savestack,str);                   /* remember the value */
 605     }
 606 }
 607
 608 void
 609 restorelist(base)
 610 int base;
 611 {
 612     register STR *str;
 613     register STR *value;
 614
 615     while (savestack->ary_fill > base) {
 616         value = apop(savestack);
 617         str = apop(savestack);
 618         str_sset(str,value);
 619         STABSET(str);
 620         str_free(value);
 621     }
 622 }