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         mg_get(osv);
 100         SvFLAGS(osv) |= (SvFLAGS(osv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 101         SvMAGIC(sv) = SvMAGIC(osv);
 102         localizing = TRUE;
 103         SvSETMAGIC(sv);
 104         localizing = FALSE;
 105     }
 106     return sv;
 107 }
 108
 109 #ifdef INLINED_ELSEWHERE
 110 void
 111 save_gp(gv)
 112 GV *gv;
 113 {
 114     register GP *gp;
 115     GP *ogp = GvGP(gv);
 116
 117     SSCHECK(3);
 118     SSPUSHPTR(gv);
 119     SSPUSHPTR(ogp);
 120     SSPUSHINT(SAVEt_GP);
 121
 122     Newz(602,gp, 1, GP);
 123     GvGP(gv) = gp;
 124     GvREFCNT(gv) = 1;
 125     GvSV(gv) = NEWSV(72,0);
 126     GvLINE(gv) = curcop->cop_line;
 127     GvEGV(gv) = gv;
 128 }
 129 #endif
 130
 131 SV*
 132 save_svref(sptr)
 133 SV **sptr;
 134 {
 135     register SV *sv;
 136     SV *osv = *sptr;
 137
 138     SSCHECK(3);
 139     SSPUSHPTR(*sptr);
 140     SSPUSHPTR(sptr);
 141     SSPUSHINT(SAVEt_SVREF);
 142
 143     sv = *sptr = NEWSV(0,0);
 144     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(sv)) {
 145         sv_upgrade(sv, SvTYPE(osv));
 146         SvMAGIC(sv) = SvMAGIC(osv);
 147         localizing = TRUE;
 148         SvSETMAGIC(sv);
 149         localizing = FALSE;
 150     }
 151     return sv;
 152 }
 153
 154 AV *
 155 save_ary(gv)
 156 GV *gv;
 157 {
 158     SSCHECK(3);
 159     SSPUSHPTR(gv);
 160     SSPUSHPTR(GvAVn(gv));
 161     SSPUSHINT(SAVEt_AV);
 162
 163     GvAV(gv) = Null(AV*);
 164     return GvAVn(gv);
 165 }
 166
 167 HV *
 168 save_hash(gv)
 169 GV *gv;
 170 {
 171     SSCHECK(3);
 172     SSPUSHPTR(gv);
 173     SSPUSHPTR(GvHVn(gv));
 174     SSPUSHINT(SAVEt_HV);
 175
 176     GvHV(gv) = Null(HV*);
 177     return GvHVn(gv);
 178 }
 179
 180 void
 181 save_item(item)
 182 register SV *item;
 183 {
 184     register SV *sv;
 185
 186     SSCHECK(3);
 187     SSPUSHPTR(item);            /* remember the pointer */
 188     sv = NEWSV(0,0);
 189     sv_setsv(sv,item);
 190     SSPUSHPTR(sv);              /* remember the value */
 191     SSPUSHINT(SAVEt_ITEM);
 192 }
 193
 194 void
 195 save_int(intp)
 196 int *intp;
 197 {
 198     SSCHECK(3);
 199     SSPUSHINT(*intp);
 200     SSPUSHPTR(intp);
 201     SSPUSHINT(SAVEt_INT);
 202 }
 203
 204 void
 205 save_long(longp)
 206 long *longp;
 207 {
 208     SSCHECK(3);
 209     SSPUSHLONG(*longp);
 210     SSPUSHPTR(longp);
 211     SSPUSHINT(SAVEt_LONG);
 212 }
 213
 214 void
 215 save_I32(intp)
 216 I32 *intp;
 217 {
 218     SSCHECK(3);
 219     SSPUSHINT(*intp);
 220     SSPUSHPTR(intp);
 221     SSPUSHINT(SAVEt_I32);
 222 }
 223
 224 /* Cannot use save_sptr() to store a char* since the SV** cast will
 225  * force word-alignment and we'll miss the pointer.
 226  */
 227 void
 228 save_pptr(pptr)
 229 char **pptr;
 230 {
 231     SSCHECK(3);
 232     SSPUSHPTR(*pptr);
 233     SSPUSHPTR(pptr);
 234     SSPUSHINT(SAVEt_PPTR);
 235 }
 236
 237 void
 238 save_sptr(sptr)
 239 SV **sptr;
 240 {
 241     SSCHECK(3);
 242     SSPUSHPTR(*sptr);
 243     SSPUSHPTR(sptr);
 244     SSPUSHINT(SAVEt_SPTR);
 245 }
 246
 247 void
 248 save_nogv(gv)
 249 GV *gv;
 250 {
 251     SSCHECK(2);
 252     SSPUSHPTR(gv);
 253     SSPUSHINT(SAVEt_NSTAB);
 254 }
 255
 256 void
 257 save_hptr(hptr)
 258 HV **hptr;
 259 {
 260     SSCHECK(3);
 261     SSPUSHPTR(*hptr);
 262     SSPUSHPTR(hptr);
 263     SSPUSHINT(SAVEt_HPTR);
 264 }
 265
 266 void
 267 save_aptr(aptr)
 268 AV **aptr;
 269 {
 270     SSCHECK(3);
 271     SSPUSHPTR(*aptr);
 272     SSPUSHPTR(aptr);
 273     SSPUSHINT(SAVEt_APTR);
 274 }
 275
 276 void
 277 save_freesv(sv)
 278 SV *sv;
 279 {
 280     SSCHECK(2);
 281     SSPUSHPTR(sv);
 282     SSPUSHINT(SAVEt_FREESV);
 283 }
 284
 285 void
 286 save_freeop(op)
 287 OP *op;
 288 {
 289     SSCHECK(2);
 290     SSPUSHPTR(op);
 291     SSPUSHINT(SAVEt_FREEOP);
 292 }
 293
 294 void
 295 save_freepv(pv)
 296 char *pv;
 297 {
 298     SSCHECK(2);
 299     SSPUSHPTR(pv);
 300     SSPUSHINT(SAVEt_FREEPV);
 301 }
 302
 303 void
 304 save_clearsv(svp)
 305 SV** svp;
 306 {
 307     SSCHECK(2);
 308     SSPUSHPTR(svp);
 309     SSPUSHINT(SAVEt_CLEARSV);
 310 }
 311
 312 void
 313 save_delete(hv,key,klen)
 314 HV *hv;
 315 char *key;
 316 I32 klen;
 317 {
 318     SSCHECK(4);
 319     SSPUSHINT(klen);
 320     SSPUSHPTR(key);
 321     SSPUSHPTR(hv);
 322     SSPUSHINT(SAVEt_DELETE);
 323 }
 324
 325 void
 326 save_list(sarg,maxsarg)
 327 register SV **sarg;
 328 I32 maxsarg;
 329 {
 330     register SV *sv;
 331     register I32 i;
 332
 333     SSCHECK(3 * maxsarg);
 334     for (i = 1; i <= maxsarg; i++) {
 335         SSPUSHPTR(sarg[i]);             /* remember the pointer */
 336         sv = NEWSV(0,0);
 337         sv_setsv(sv,sarg[i]);
 338         SSPUSHPTR(sv);                  /* remember the value */
 339         SSPUSHINT(SAVEt_ITEM);
 340     }
 341 }
 342
 343 void
 344 leave_scope(base)
 345 I32 base;
 346 {
 347     register SV *sv;
 348     register SV *value;
 349     register GV *gv;
 350     register AV *av;
 351     register HV *hv;
 352     register void* ptr;
 353
 354     if (base < -1)
 355         croak("panic: corrupt saved stack index");
 356     while (savestack_ix > base) {
 357         switch (SSPOPINT) {
 358         case SAVEt_ITEM:                        /* normal string */
 359             value = (SV*)SSPOPPTR;
 360             sv = (SV*)SSPOPPTR;
 361             sv_replace(sv,value);
 362             SvSETMAGIC(sv);
 363             break;
 364         case SAVEt_SV:                          /* scalar reference */
 365             value = (SV*)SSPOPPTR;
 366             gv = (GV*)SSPOPPTR;
 367             sv = GvSV(gv);
 368             if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
 369                 SvMAGIC(value) = SvMAGIC(sv);
 370                 SvMAGIC(sv) = 0;
 371             }
 372             SvREFCNT_dec(sv);
 373             GvSV(gv) = sv = value;
 374             SvSETMAGIC(sv);
 375             break;
 376         case SAVEt_SVREF:                       /* scalar reference */
 377             ptr = SSPOPPTR;
 378             sv = *(SV**)ptr;
 379             if (SvTYPE(sv) >= SVt_PVMG)
 380                 SvMAGIC(sv) = 0;
 381             SvREFCNT_dec(sv);
 382             *(SV**)ptr = sv = (SV*)SSPOPPTR;
 383             SvSETMAGIC(sv);
 384             break;
 385         case SAVEt_AV:                          /* array reference */
 386             av = (AV*)SSPOPPTR;
 387             gv = (GV*)SSPOPPTR;
 388             SvREFCNT_dec(GvAV(gv));
 389             GvAV(gv) = av;
 390             break;
 391         case SAVEt_HV:                          /* hash reference */
 392             hv = (HV*)SSPOPPTR;
 393             gv = (GV*)SSPOPPTR;
 394             SvREFCNT_dec(GvHV(gv));
 395             GvHV(gv) = hv;
 396             break;
 397         case SAVEt_INT:                         /* int reference */
 398             ptr = SSPOPPTR;
 399             *(int*)ptr = (int)SSPOPINT;
 400             break;
 401         case SAVEt_LONG:                        /* long reference */
 402             ptr = SSPOPPTR;
 403             *(long*)ptr = (long)SSPOPLONG;
 404             break;
 405         case SAVEt_I32:                         /* I32 reference */
 406             ptr = SSPOPPTR;
 407             *(I32*)ptr = (I32)SSPOPINT;
 408             break;
 409         case SAVEt_SPTR:                        /* SV* reference */
 410             ptr = SSPOPPTR;
 411             *(SV**)ptr = (SV*)SSPOPPTR;
 412             break;
 413         case SAVEt_PPTR:                        /* char* reference */
 414             ptr = SSPOPPTR;
 415             *(char**)ptr = (char*)SSPOPPTR;
 416             break;
 417         case SAVEt_HPTR:                        /* HV* reference */
 418             ptr = SSPOPPTR;
 419             *(HV**)ptr = (HV*)SSPOPPTR;
 420             break;
 421         case SAVEt_APTR:                        /* AV* reference */
 422             ptr = SSPOPPTR;
 423             *(AV**)ptr = (AV*)SSPOPPTR;
 424             break;
 425         case SAVEt_NSTAB:
 426             gv = (GV*)SSPOPPTR;
 427             (void)sv_clear(gv);
 428             break;
 429         case SAVEt_GP:                          /* scalar reference */
 430             ptr = SSPOPPTR;
 431             gv = (GV*)SSPOPPTR;
 432             gp_free(gv);
 433             GvGP(gv) = (GP*)ptr;
 434             break;
 435         case SAVEt_FREESV:
 436             ptr = SSPOPPTR;
 437             SvREFCNT_dec((SV*)ptr);
 438             break;
 439         case SAVEt_FREEOP:
 440             ptr = SSPOPPTR;
 441             curpad = AvARRAY(comppad);
 442             op_free((OP*)ptr);
 443             break;
 444         case SAVEt_FREEPV:
 445             ptr = SSPOPPTR;
 446             Safefree((char*)ptr);
 447             break;
 448         case SAVEt_CLEARSV:
 449             ptr = SSPOPPTR;
 450             sv = *(SV**)ptr;
 451             if (SvREFCNT(sv) <= 1) {    /* Can clear pad variable in place. */
 452                 if (SvTHINKFIRST(sv)) {
 453                     if (SvREADONLY(sv))
 454                         croak("panic: leave_scope clearsv");
 455                     if (SvROK(sv))
 456                         sv_unref(sv);
 457                 }
 458
 459                 switch (SvTYPE(sv)) {
 460                 case SVt_NULL:
 461                     break;
 462                 case SVt_PVAV:
 463                     av_clear((AV*)sv);
 464                     break;
 465                 case SVt_PVHV:
 466                     hv_clear((HV*)sv);
 467                     break;
 468                 case SVt_PVCV:
 469                     sub_generation++;
 470                     cv_undef((CV*)sv);
 471                     break;
 472                 default:
 473                     if (SvPOK(sv) && SvLEN(sv))
 474                         SvOOK_off(sv);
 475                     SvOK_off(sv);
 476                     SvSETMAGIC(sv);
 477                     break;
 478                 }
 479             }
 480             else {      /* Someone has a claim on this, so abandon it. */
 481                 SvREFCNT_dec(sv);       /* Cast current value to the winds. */
 482                 switch (SvTYPE(sv)) {   /* Console ourselves with a new value */
 483                 case SVt_PVAV:  *(SV**)ptr = (SV*)newAV();      break;
 484                 case SVt_PVHV:  *(SV**)ptr = (SV*)newHV();      break;
 485                 default:        *(SV**)ptr = NEWSV(0,0);        break;
 486                 }
 487             }
 488             break;
 489         case SAVEt_DELETE:
 490             ptr = SSPOPPTR;
 491             hv = (HV*)ptr;
 492             ptr = SSPOPPTR;
 493             hv_delete(hv, (char*)ptr, (U32)SSPOPINT);
 494             break;
 495         default:
 496             croak("panic: leave_scope inconsistency");
 497         }
 498     }
 499 }
 500
 501 #ifdef DEBUGGING
 502 void
 503 cx_dump(cx)
 504 CONTEXT* cx;
 505 {
 506     fprintf(stderr, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]);
 507     if (cx->cx_type != CXt_SUBST) {
 508         fprintf(stderr, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
 509         fprintf(stderr, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
 510         fprintf(stderr, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
 511         fprintf(stderr, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
 512         fprintf(stderr, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp);
 513         fprintf(stderr, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
 514         fprintf(stderr, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
 515     }
 516     switch (cx->cx_type) {
 517     case CXt_NULL:
 518     case CXt_BLOCK:
 519         break;
 520     case CXt_SUB:
 521         fprintf(stderr, "BLK_SUB.CV = 0x%lx\n",
 522                 (long)cx->blk_sub.cv);
 523         fprintf(stderr, "BLK_SUB.GV = 0x%lx\n",
 524                 (long)cx->blk_sub.gv);
 525         fprintf(stderr, "BLK_SUB.DFOUTGV = 0x%lx\n",
 526                 (long)cx->blk_sub.dfoutgv);
 527         fprintf(stderr, "BLK_SUB.OLDDEPTH = %ld\n",
 528                 (long)cx->blk_sub.olddepth);
 529         fprintf(stderr, "BLK_SUB.HASARGS = %d\n",
 530                 (int)cx->blk_sub.hasargs);
 531         break;
 532     case CXt_EVAL:
 533         fprintf(stderr, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
 534                 (long)cx->blk_eval.old_in_eval);
 535         fprintf(stderr, "BLK_EVAL.OLD_OP_TYPE = %s\n",
 536                 op_name[cx->blk_eval.old_op_type]);
 537         fprintf(stderr, "BLK_EVAL.OLD_NAME = %s\n",
 538                 cx->blk_eval.old_name);
 539         fprintf(stderr, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
 540                 (long)cx->blk_eval.old_eval_root);
 541         break;
 542
 543     case CXt_LOOP:
 544         fprintf(stderr, "BLK_LOOP.LABEL = %s\n",
 545                 cx->blk_loop.label);
 546         fprintf(stderr, "BLK_LOOP.RESETSP = %ld\n",
 547                 (long)cx->blk_loop.resetsp);
 548         fprintf(stderr, "BLK_LOOP.REDO_OP = 0x%lx\n",
 549                 (long)cx->blk_loop.redo_op);
 550         fprintf(stderr, "BLK_LOOP.NEXT_OP = 0x%lx\n",
 551                 (long)cx->blk_loop.next_op);
 552         fprintf(stderr, "BLK_LOOP.LAST_OP = 0x%lx\n",
 553                 (long)cx->blk_loop.last_op);
 554         fprintf(stderr, "BLK_LOOP.ITERIX = %ld\n",
 555                 (long)cx->blk_loop.iterix);
 556         fprintf(stderr, "BLK_LOOP.ITERARY = 0x%lx\n",
 557                 (long)cx->blk_loop.iterary);
 558         fprintf(stderr, "BLK_LOOP.ITERVAR = 0x%lx\n",
 559                 (long)cx->blk_loop.itervar);
 560         if (cx->blk_loop.itervar)
 561             fprintf(stderr, "BLK_LOOP.ITERSAVE = 0x%lx\n",
 562                 (long)cx->blk_loop.itersave);
 563         break;
 564
 565     case CXt_SUBST:
 566         fprintf(stderr, "SB_ITERS = %ld\n",
 567                 (long)cx->sb_iters);
 568         fprintf(stderr, "SB_MAXITERS = %ld\n",
 569                 (long)cx->sb_maxiters);
 570         fprintf(stderr, "SB_SAFEBASE = %ld\n",
 571                 (long)cx->sb_safebase);
 572         fprintf(stderr, "SB_ONCE = %ld\n",
 573                 (long)cx->sb_once);
 574         fprintf(stderr, "SB_ORIG = %s\n",
 575                 cx->sb_orig);
 576         fprintf(stderr, "SB_DSTR = 0x%lx\n",
 577                 (long)cx->sb_dstr);
 578         fprintf(stderr, "SB_TARG = 0x%lx\n",
 579                 (long)cx->sb_targ);
 580         fprintf(stderr, "SB_S = 0x%lx\n",
 581                 (long)cx->sb_s);
 582         fprintf(stderr, "SB_M = 0x%lx\n",
 583                 (long)cx->sb_m);
 584         fprintf(stderr, "SB_STREND = 0x%lx\n",
 585                 (long)cx->sb_strend);
 586         fprintf(stderr, "SB_SUBBASE = 0x%lx\n",
 587                 (long)cx->sb_subbase);
 588         break;
 589     }
 590 }
 591 #endif