add note about map in scalar context

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index 6edda19..4a2a778 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -1,6 +1,6 @@
 /*    scope.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1999, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -28,7 +28,7 @@ stack_grow(SV **sp, SV **p, int n)
 #ifndef STRESS_REALLOC
     av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);
 #else
-    av_extend(curstack, (p - stack_base) + (n) + 1);
+    av_extend(PL_curstack, (p - PL_stack_base) + (n) + 1);
 #endif
 #if defined(DEBUGGING) && !defined(USE_THREADS)
     growing--;
@@ -144,9 +144,7 @@ free_tmps(void)
        SV* sv = PL_tmps_stack[PL_tmps_ix];
        PL_tmps_stack[PL_tmps_ix--] = Nullsv;
        if (sv) {
-#ifdef DEBUGGING
            SvTEMP_off(sv);
-#endif
            SvREFCNT_dec(sv);           /* note, can modify tmps_ix!!! */
        }
     }
@@ -206,6 +204,18 @@ save_svref(SV **sptr)
     return save_scalar_at(sptr);
 }
 
+/* Like save_svref(), but doesn't deal with magic.  Can be used to
+ * restore a global SV to its prior contents, freeing new value. */
+void
+save_generic_svref(SV **sptr)
+{
+    dTHR;
+    SSCHECK(3);
+    SSPUSHPTR(sptr);
+    SSPUSHPTR(SvREFCNT_inc(*sptr));
+    SSPUSHINT(SAVEt_GENERIC_SVREF);
+}
+
 void
 save_gp(GV *gv, I32 empty)
 {
@@ -382,7 +392,7 @@ save_threadsv(PADOFFSET i)
 #ifdef USE_THREADS
     dTHR;
     SV **svp = &THREADSV(i);   /* XXX Change to save by offset */
-    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n",
+    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n",
                          i, svp, *svp, SvPEEK(*svp)));
     save_svref(svp);
     return svp;
@@ -528,10 +538,28 @@ save_op(void)
 {
     dTHR;
     SSCHECK(2);
-    SSPUSHPTR(op);
+    SSPUSHPTR(PL_op);
     SSPUSHINT(SAVEt_OP);
 }
 
+I32
+save_alloc(I32 size, I32 pad)
+{
+    dTHR;
+    register I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
+                                - (char*)PL_savestack);
+    register I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
+
+    /* SSCHECK may not be good enough */
+    while (PL_savestack_ix + elems + 2 > PL_savestack_max)
+        savestack_grow();
+
+    PL_savestack_ix += elems;
+    SSPUSHINT(elems);
+    SSPUSHINT(SAVEt_ALLOC);
+    return start;
+}
+
 void
 leave_scope(I32 base)
 {
@@ -562,12 +590,22 @@ leave_scope(I32 base)
            ptr = &GvSV(gv);
            SvREFCNT_dec(gv);
            goto restore_sv;
+        case SAVEt_GENERIC_SVREF:              /* generic sv */
+           value = (SV*)SSPOPPTR;
+           ptr = SSPOPPTR;
+           if (ptr) {
+               sv = *(SV**)ptr;
+               *(SV**)ptr = value;
+               SvREFCNT_dec(sv);
+           }
+           SvREFCNT_dec(value);
+           break;
         case SAVEt_SVREF:                      /* scalar reference */
            value = (SV*)SSPOPPTR;
            ptr = SSPOPPTR;
        restore_sv:
            sv = *(SV**)ptr;
-           DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
                                  "restore svref: %p %p:%s -> %p:%s\n",
                                  ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
            if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
@@ -673,7 +711,7 @@ leave_scope(I32 base)
        case SAVEt_GP:                          /* scalar reference */
            ptr = SSPOPPTR;
            gv = (GV*)SSPOPPTR;
-            if (SvPOK(gv) && SvLEN(gv) > 0) {
+            if (SvPVX(gv) && SvLEN(gv) > 0) {
                 Safefree(SvPVX(gv));
             }
             SvPVX(gv) = (char *)SSPOPPTR;
@@ -759,6 +797,7 @@ leave_scope(I32 base)
            (CALLDESTRUCTOR)(ptr);
            break;
        case SAVEt_REGCONTEXT:
+       case SAVEt_ALLOC:
            i = SSPOPINT;
            PL_savestack_ix -= i;       /* regexp must have croaked */
            break;
@@ -774,7 +813,7 @@ leave_scope(I32 base)
            if (ptr) {
                sv = *(SV**)ptr;
                if (sv && sv != &PL_sv_undef) {
-                   if (SvRMAGICAL(av) && mg_find((SV*)av, 'P'))
+                   if (SvTIED_mg((SV*)av, 'P'))
                        (void)SvREFCNT_inc(sv);
                    SvREFCNT_dec(av);
                    goto restore_sv;
@@ -792,7 +831,7 @@ leave_scope(I32 base)
                SV *oval = HeVAL((HE*)ptr);
                if (oval && oval != &PL_sv_undef) {
                    ptr = &HeVAL((HE*)ptr);
-                   if (SvRMAGICAL(hv) && mg_find((SV*)hv, 'P'))
+                   if (SvTIED_mg((SV*)hv, 'P'))
                        (void)SvREFCNT_inc(*(SV**)ptr);
                    SvREFCNT_dec(hv);
                    SvREFCNT_dec(sv);
@@ -804,7 +843,7 @@ leave_scope(I32 base)
            SvREFCNT_dec(value);
            break;
        case SAVEt_OP:
-           op = (OP*)SSPOPPTR;
+           PL_op = (OP*)SSPOPPTR;
            break;
        case SAVEt_HINTS:
            if (GvHV(PL_hintgv)) {
@@ -824,8 +863,8 @@ cx_dump(PERL_CONTEXT *cx)
 {
 #ifdef DEBUGGING
     dTHR;
-    PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[cx->cx_type]);
-    if (cx->cx_type != CXt_SUBST) {
+    PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]);
+    if (CxTYPE(cx) != CXt_SUBST) {
        PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
        PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
        PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
@@ -834,7 +873,7 @@ cx_dump(PERL_CONTEXT *cx)
        PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
        PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
     }
-    switch (cx->cx_type) {
+    switch (CxTYPE(cx)) {
     case CXt_NULL:
     case CXt_BLOCK:
        break;
@@ -854,8 +893,8 @@ cx_dump(PERL_CONTEXT *cx)
        PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
                (long)cx->blk_eval.old_in_eval);
        PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
-               op_name[cx->blk_eval.old_op_type],
-               op_desc[cx->blk_eval.old_op_type]);
+               PL_op_name[cx->blk_eval.old_op_type],
+               PL_op_desc[cx->blk_eval.old_op_type]);
        PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
                cx->blk_eval.old_name);
        PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
@@ -891,8 +930,8 @@ cx_dump(PERL_CONTEXT *cx)
                (long)cx->sb_iters);
        PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n",
                (long)cx->sb_maxiters);
-       PerlIO_printf(Perl_debug_log, "SB_SAFEBASE = %ld\n",
-               (long)cx->sb_safebase);
+       PerlIO_printf(Perl_debug_log, "SB_RFLAGS = %ld\n",
+               (long)cx->sb_rflags);
        PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n",
                (long)cx->sb_once);
        PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",