scope.c

   1 /* $RCSfile: op.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:16 $
   2  *
   3  *    Copyright (c) 1991, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  * $Log:        op.c,v $
   9  */
  10
  11 #include "EXTERN.h"
  12 #include "perl.h"
  13
  14 I32
  15 cxinc()
  16 {
  17     cxstack_max = cxstack_max * 3 / 2;
  18     Renew(cxstack, cxstack_max, CONTEXT);
  19     return cxstack_ix + 1;
  20 }
  21
  22 void
  23 push_return(retop)
  24 OP *retop;
  25 {
  26     if (retstack_ix == retstack_max) {
  27         retstack_max = retstack_max * 3 / 2;
  28         Renew(retstack, retstack_max, OP*);
  29     }
  30     retstack[retstack_ix++] = retop;
  31 }
  32
  33 OP *
  34 pop_return()
  35 {
  36     if (retstack_ix > 0)
  37         return retstack[--retstack_ix];
  38     else
  39         return Nullop;
  40 }
  41
  42 void
  43 push_scope()
  44 {
  45     if (scopestack_ix == scopestack_max) {
  46         scopestack_max = scopestack_max * 3 / 2;
  47         Renew(scopestack, scopestack_max, I32);
  48     }
  49     scopestack[scopestack_ix++] = savestack_ix;
  50
  51 }
  52
  53 void
  54 pop_scope()
  55 {
  56     I32 oldsave = scopestack[--scopestack_ix];
  57     LEAVE_SCOPE(oldsave);
  58 }
  59
  60 void
  61 savestack_grow()
  62 {
  63     savestack_max = savestack_max * 3 / 2;
  64     Renew(savestack, savestack_max, ANY);
  65 }
  66
  67 void
  68 free_tmps()
  69 {
  70     /* XXX should tmps_floor live in cxstack? */
  71     I32 myfloor = tmps_floor;
  72     while (tmps_ix > myfloor) {      /* clean up after last statement */
  73         SV* sv = tmps_stack[tmps_ix];
  74         tmps_stack[tmps_ix--] = Nullsv;
  75         if (sv) {
  76 #ifdef DEBUGGING
  77             SvTEMP_off(sv);
  78 #endif
  79             SvREFCNT_dec(sv);           /* note, can modify tmps_ix!!! */
  80         }
  81     }
  82 }
  83
  84 SV *
  85 save_scalar(gv)
  86 GV *gv;
  87 {
  88     register SV *sv;
  89     SV *osv = GvSV(gv);
  90
  91     SSCHECK(3);
  92     SSPUSHPTR(gv);
  93     SSPUSHPTR(osv);
  94     SSPUSHINT(SAVEt_SV);
  95
  96     sv = GvSV(gv) = NEWSV(0,0);
  97     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv)) {
  98         sv_upgrade(sv, SvTYPE(osv));
  99         SvMAGIC(sv) = SvMAGIC(osv);
 100         localizing = TRUE;
 101         SvSETMAGIC(sv);
 102         localizing = FALSE;
 103     }
 104     return sv;
 105 }
 106
 107 #ifdef INLINED_ELSEWHERE
 108 void
 109 save_gp(gv)
 110 GV *gv;
 111 {
 112     register GP *gp;
 113     GP *ogp = GvGP(gv);
 114
 115     SSCHECK(3);
 116     SSPUSHPTR(gv);
 117     SSPUSHPTR(ogp);
 118     SSPUSHINT(SAVEt_GP);
 119
 120     Newz(602,gp, 1, GP);
 121     GvGP(gv) = gp;
 122     GvREFCNT(gv) = 1;
 123     GvSV(gv) = NEWSV(72,0);
 124     GvLINE(gv) = curcop->cop_line;
 125     GvEGV(gv) = gv;
 126 }
 127 #endif
 128
 129 SV*
 130 save_svref(sptr)
 131 SV **sptr;
 132 {
 133     register SV *sv;
 134     SV *osv = *sptr;
 135
 136     SSCHECK(3);
 137     SSPUSHPTR(*sptr);
 138     SSPUSHPTR(sptr);
 139     SSPUSHINT(SAVEt_SVREF);
 140
 141     sv = *sptr = NEWSV(0,0);
 142     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(sv)) {
 143         sv_upgrade(sv, SvTYPE(osv));
 144         SvMAGIC(sv) = SvMAGIC(osv);
 145         localizing = TRUE;
 146         SvSETMAGIC(sv);
 147         localizing = FALSE;
 148     }
 149     return sv;
 150 }
 151
 152 AV *
 153 save_ary(gv)
 154 GV *gv;
 155 {
 156     SSCHECK(3);
 157     SSPUSHPTR(gv);
 158     SSPUSHPTR(GvAVn(gv));
 159     SSPUSHINT(SAVEt_AV);
 160
 161     GvAV(gv) = Null(AV*);
 162     return GvAVn(gv);
 163 }
 164
 165 HV *
 166 save_hash(gv)
 167 GV *gv;
 168 {
 169     SSCHECK(3);
 170     SSPUSHPTR(gv);
 171     SSPUSHPTR(GvHVn(gv));
 172     SSPUSHINT(SAVEt_HV);
 173
 174     GvHV(gv) = Null(HV*);
 175     return GvHVn(gv);
 176 }
 177
 178 void
 179 save_item(item)
 180 register SV *item;
 181 {
 182     register SV *sv;
 183
 184     SSCHECK(3);
 185     SSPUSHPTR(item);            /* remember the pointer */
 186     sv = NEWSV(0,0);
 187     sv_setsv(sv,item);
 188     SSPUSHPTR(sv);              /* remember the value */
 189     SSPUSHINT(SAVEt_ITEM);
 190 }
 191
 192 void
 193 save_int(intp)
 194 int *intp;
 195 {
 196     SSCHECK(3);
 197     SSPUSHINT(*intp);
 198     SSPUSHPTR(intp);
 199     SSPUSHINT(SAVEt_INT);
 200 }
 201
 202 void
 203 save_I32(intp)
 204 I32 *intp;
 205 {
 206     SSCHECK(3);
 207     SSPUSHINT(*intp);
 208     SSPUSHPTR(intp);
 209     SSPUSHINT(SAVEt_I32);
 210 }
 211
 212 void
 213 save_sptr(sptr)
 214 SV **sptr;
 215 {
 216     SSCHECK(3);
 217     SSPUSHPTR(*sptr);
 218     SSPUSHPTR(sptr);
 219     SSPUSHINT(SAVEt_SPTR);
 220 }
 221
 222 void
 223 save_nogv(gv)
 224 GV *gv;
 225 {
 226     SSCHECK(2);
 227     SSPUSHPTR(gv);
 228     SSPUSHINT(SAVEt_NSTAB);
 229 }
 230
 231 void
 232 save_hptr(hptr)
 233 HV **hptr;
 234 {
 235     SSCHECK(3);
 236     SSPUSHINT(*hptr);
 237     SSPUSHPTR(hptr);
 238     SSPUSHINT(SAVEt_HPTR);
 239 }
 240
 241 void
 242 save_aptr(aptr)
 243 AV **aptr;
 244 {
 245     SSCHECK(3);
 246     SSPUSHINT(*aptr);
 247     SSPUSHPTR(aptr);
 248     SSPUSHINT(SAVEt_APTR);
 249 }
 250
 251 void
 252 save_freesv(sv)
 253 SV *sv;
 254 {
 255     SSCHECK(2);
 256     SSPUSHPTR(sv);
 257     SSPUSHINT(SAVEt_FREESV);
 258 }
 259
 260 void
 261 save_freeop(op)
 262 OP *op;
 263 {
 264     SSCHECK(2);
 265     SSPUSHPTR(op);
 266     SSPUSHINT(SAVEt_FREEOP);
 267 }
 268
 269 void
 270 save_freepv(pv)
 271 char *pv;
 272 {
 273     SSCHECK(2);
 274     SSPUSHPTR(pv);
 275     SSPUSHINT(SAVEt_FREEPV);
 276 }
 277
 278 void
 279 save_clearsv(svp)
 280 SV** svp;
 281 {
 282     SSCHECK(2);
 283     SSPUSHPTR(svp);
 284     SSPUSHINT(SAVEt_CLEARSV);
 285 }
 286
 287 void
 288 save_delete(hv,key,klen)
 289 HV *hv;
 290 char *key;
 291 I32 klen;
 292 {
 293     SSCHECK(4);
 294     SSPUSHINT(klen);
 295     SSPUSHPTR(key);
 296     SSPUSHPTR(hv);
 297     SSPUSHINT(SAVEt_DELETE);
 298 }
 299
 300 void
 301 save_list(sarg,maxsarg)
 302 register SV **sarg;
 303 I32 maxsarg;
 304 {
 305     register SV *sv;
 306     register I32 i;
 307
 308     SSCHECK(3 * maxsarg);
 309     for (i = 1; i <= maxsarg; i++) {
 310         SSPUSHPTR(sarg[i]);             /* remember the pointer */
 311         sv = NEWSV(0,0);
 312         sv_setsv(sv,sarg[i]);
 313         SSPUSHPTR(sv);                  /* remember the value */
 314         SSPUSHINT(SAVEt_ITEM);
 315     }
 316 }
 317
 318 void
 319 leave_scope(base)
 320 I32 base;
 321 {
 322     register SV *sv;
 323     register SV *value;
 324     register GV *gv;
 325     register AV *av;
 326     register HV *hv;
 327     register void* ptr;
 328
 329     if (base < -1)
 330         croak("panic: corrupt saved stack index");
 331     while (savestack_ix > base) {
 332         switch (SSPOPINT) {
 333         case SAVEt_ITEM:                        /* normal string */
 334             value = (SV*)SSPOPPTR;
 335             sv = (SV*)SSPOPPTR;
 336             sv_replace(sv,value);
 337             SvSETMAGIC(sv);
 338             break;
 339         case SAVEt_SV:                          /* scalar reference */
 340             value = (SV*)SSPOPPTR;
 341             gv = (GV*)SSPOPPTR;
 342             sv = GvSV(gv);
 343             if (SvTYPE(sv) >= SVt_PVMG)
 344                 SvMAGIC(sv) = 0;
 345             SvREFCNT_dec(sv);
 346             GvSV(gv) = sv = value;
 347             SvSETMAGIC(sv);
 348             break;
 349         case SAVEt_SVREF:                       /* scalar reference */
 350             ptr = SSPOPPTR;
 351             sv = *(SV**)ptr;
 352             if (SvTYPE(sv) >= SVt_PVMG)
 353                 SvMAGIC(sv) = 0;
 354             SvREFCNT_dec(sv);
 355             *(SV**)ptr = sv = (SV*)SSPOPPTR;
 356             SvSETMAGIC(sv);
 357             break;
 358         case SAVEt_AV:                          /* array reference */
 359             av = (AV*)SSPOPPTR;
 360             gv = (GV*)SSPOPPTR;
 361             SvREFCNT_dec(GvAV(gv));
 362             GvAV(gv) = av;
 363             break;
 364         case SAVEt_HV:                          /* hash reference */
 365             hv = (HV*)SSPOPPTR;
 366             gv = (GV*)SSPOPPTR;
 367             SvREFCNT_dec(GvHV(gv));
 368             GvHV(gv) = hv;
 369             break;
 370         case SAVEt_INT:                         /* int reference */
 371             ptr = SSPOPPTR;
 372             *(int*)ptr = (int)SSPOPINT;
 373             break;
 374         case SAVEt_I32:                         /* I32 reference */
 375             ptr = SSPOPPTR;
 376             *(I32*)ptr = (I32)SSPOPINT;
 377             break;
 378         case SAVEt_SPTR:                        /* SV* reference */
 379             ptr = SSPOPPTR;
 380             *(SV**)ptr = (SV*)SSPOPPTR;
 381             break;
 382         case SAVEt_HPTR:                        /* HV* reference */
 383             ptr = SSPOPPTR;
 384             *(HV**)ptr = (HV*)SSPOPPTR;
 385             break;
 386         case SAVEt_APTR:                        /* AV* reference */
 387             ptr = SSPOPPTR;
 388             *(AV**)ptr = (AV*)SSPOPPTR;
 389             break;
 390         case SAVEt_NSTAB:
 391             gv = (GV*)SSPOPPTR;
 392             (void)sv_clear(gv);
 393             break;
 394         case SAVEt_GP:                          /* scalar reference */
 395             ptr = SSPOPPTR;
 396             gv = (GV*)SSPOPPTR;
 397             gp_free(gv);
 398             GvGP(gv) = (GP*)ptr;
 399             break;
 400         case SAVEt_FREESV:
 401             ptr = SSPOPPTR;
 402             SvREFCNT_dec((SV*)ptr);
 403             break;
 404         case SAVEt_FREEOP:
 405             ptr = SSPOPPTR;
 406             curpad = AvARRAY(comppad);
 407             op_free((OP*)ptr);
 408             break;
 409         case SAVEt_FREEPV:
 410             ptr = SSPOPPTR;
 411             Safefree((char*)ptr);
 412             break;
 413         case SAVEt_CLEARSV:
 414             ptr = SSPOPPTR;
 415             sv = *(SV**)ptr;
 416             if (SvREFCNT(sv) <= 1) {    /* Can clear pad variable in place. */
 417                 if (SvTHINKFIRST(sv)) {
 418                     if (SvREADONLY(sv))
 419                         croak("panic: leave_scope clearsv");
 420                     if (SvROK(sv))
 421                         sv_unref(sv);
 422                 }
 423
 424                 switch (SvTYPE(sv)) {
 425                 case SVt_NULL:
 426                     break;
 427                 case SVt_PVAV:
 428                     av_clear((AV*)sv);
 429                     break;
 430                 case SVt_PVHV:
 431                     hv_clear((HV*)sv);
 432                     break;
 433                 case SVt_PVCV:
 434                     sub_generation++;
 435                     cv_clear((CV*)sv);
 436                     break;
 437                 default:
 438                     if (SvPOK(sv) && SvLEN(sv))
 439                         SvOOK_off(sv);
 440                     SvOK_off(sv);
 441                     SvSETMAGIC(sv);
 442                     break;
 443                 }
 444             }
 445             else {      /* Someone has a claim on this, so abandon it. */
 446                 SvREFCNT_dec(sv);       /* Cast current value to the winds. */
 447                 switch (SvTYPE(sv)) {   /* Console ourselves with a new value */
 448                 case SVt_PVAV:  *(SV**)ptr = (SV*)newAV();      break;
 449                 case SVt_PVHV:  *(SV**)ptr = (SV*)newHV();      break;
 450                 default:        *(SV**)ptr = NEWSV(0,0);        break;
 451                 }
 452             }
 453             break;
 454         case SAVEt_DELETE:
 455             ptr = SSPOPPTR;
 456             hv = (HV*)ptr;
 457             ptr = SSPOPPTR;
 458             hv_delete(hv, (char*)ptr, (U32)SSPOPINT);
 459             break;
 460         default:
 461             croak("panic: leave_scope inconsistency");
 462         }
 463     }
 464 }
 465
 466 #ifdef DEBUGGING
 467 void
 468 cx_dump(cx)
 469 CONTEXT* cx;
 470 {
 471     fprintf(stderr, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]);
 472     if (cx->cx_type != CXt_SUBST) {
 473         fprintf(stderr, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
 474         fprintf(stderr, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
 475         fprintf(stderr, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
 476         fprintf(stderr, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
 477         fprintf(stderr, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp);
 478         fprintf(stderr, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
 479         fprintf(stderr, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
 480     }
 481     switch (cx->cx_type) {
 482     case CXt_NULL:
 483     case CXt_BLOCK:
 484         break;
 485     case CXt_SUB:
 486         fprintf(stderr, "BLK_SUB.CV = 0x%lx\n",
 487                 (long)cx->blk_sub.cv);
 488         fprintf(stderr, "BLK_SUB.GV = 0x%lx\n",
 489                 (long)cx->blk_sub.gv);
 490         fprintf(stderr, "BLK_SUB.DFOUTGV = 0x%lx\n",
 491                 (long)cx->blk_sub.dfoutgv);
 492         fprintf(stderr, "BLK_SUB.OLDDEPTH = %ld\n",
 493                 (long)cx->blk_sub.olddepth);
 494         fprintf(stderr, "BLK_SUB.HASARGS = %d\n",
 495                 (int)cx->blk_sub.hasargs);
 496         break;
 497     case CXt_EVAL:
 498         fprintf(stderr, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
 499                 (long)cx->blk_eval.old_in_eval);
 500         fprintf(stderr, "BLK_EVAL.OLD_OP_TYPE = %s\n",
 501                 op_name[cx->blk_eval.old_op_type]);
 502         fprintf(stderr, "BLK_EVAL.OLD_NAME = %s\n",
 503                 cx->blk_eval.old_name);
 504         fprintf(stderr, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
 505                 (long)cx->blk_eval.old_eval_root);
 506         break;
 507
 508     case CXt_LOOP:
 509         fprintf(stderr, "BLK_LOOP.LABEL = %s\n",
 510                 cx->blk_loop.label);
 511         fprintf(stderr, "BLK_LOOP.RESETSP = %ld\n",
 512                 (long)cx->blk_loop.resetsp);
 513         fprintf(stderr, "BLK_LOOP.REDO_OP = 0x%lx\n",
 514                 (long)cx->blk_loop.redo_op);
 515         fprintf(stderr, "BLK_LOOP.NEXT_OP = 0x%lx\n",
 516                 (long)cx->blk_loop.next_op);
 517         fprintf(stderr, "BLK_LOOP.LAST_OP = 0x%lx\n",
 518                 (long)cx->blk_loop.last_op);
 519         fprintf(stderr, "BLK_LOOP.ITERIX = %ld\n",
 520                 (long)cx->blk_loop.iterix);
 521         fprintf(stderr, "BLK_LOOP.ITERARY = 0x%lx\n",
 522                 (long)cx->blk_loop.iterary);
 523         fprintf(stderr, "BLK_LOOP.ITERVAR = 0x%lx\n",
 524                 (long)cx->blk_loop.itervar);
 525         if (cx->blk_loop.itervar)
 526             fprintf(stderr, "BLK_LOOP.ITERSAVE = 0x%lx\n",
 527                 (long)cx->blk_loop.itersave);
 528         break;
 529
 530     case CXt_SUBST:
 531         fprintf(stderr, "SB_ITERS = %ld\n",
 532                 (long)cx->sb_iters);
 533         fprintf(stderr, "SB_MAXITERS = %ld\n",
 534                 (long)cx->sb_maxiters);
 535         fprintf(stderr, "SB_SAFEBASE = %ld\n",
 536                 (long)cx->sb_safebase);
 537         fprintf(stderr, "SB_ONCE = %ld\n",
 538                 (long)cx->sb_once);
 539         fprintf(stderr, "SB_ORIG = %s\n",
 540                 cx->sb_orig);
 541         fprintf(stderr, "SB_DSTR = 0x%lx\n",
 542                 (long)cx->sb_dstr);
 543         fprintf(stderr, "SB_TARG = 0x%lx\n",
 544                 (long)cx->sb_targ);
 545         fprintf(stderr, "SB_S = 0x%lx\n",
 546                 (long)cx->sb_s);
 547         fprintf(stderr, "SB_M = 0x%lx\n",
 548                 (long)cx->sb_m);
 549         fprintf(stderr, "SB_STREND = 0x%lx\n",
 550                 (long)cx->sb_strend);
 551         fprintf(stderr, "SB_SUBBASE = 0x%lx\n",
 552                 (long)cx->sb_subbase);
 553         break;
 554     }
 555 }
 556 #endif