X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=1345af4e9a0640fa52862fd4d14123655164b95f;hb=235bddc8d16c512a7d89f327f65cee68b1f5848c;hp=2230aaf2434e8b188100b4469d6254ffda83b49d;hpb=238a4c30b3724d314933955c5c4a0162eae05ee0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 2230aaf..1345af4 100644
--- a/op.c
+++ b/op.c
@@ -37,29 +37,38 @@
 STATIC void *
 S_Slab_Alloc(pTHX_ int m, size_t sz)
 {
-    /* Add an overhead for pointer to slab and round up as a number of IVs */
-    sz = (sz + 2*sizeof(IV) -1)/sizeof(IV);
+    /*
+     * To make incrementing use count easy PL_OpSlab is an I32 *
+     * To make inserting the link to slab PL_OpPtr is I32 **
+     * So compute size in units of sizeof(I32 *) as that is how Pl_OpPtr increments
+     * Add an overhead for pointer to slab and round up as a number of pointers
+     */
+    sz = (sz + 2*sizeof(I32 *) -1)/sizeof(I32 *);
     if ((PL_OpSpace -= sz) < 0) {
-	PL_OpSlab = (IV *) PerlMemShared_malloc(PERL_SLAB_SIZE*sizeof(IV));
-	if (!PL_OpSlab) {
+	PL_OpPtr = (I32 **) PerlMemShared_malloc(PERL_SLAB_SIZE*sizeof(I32*));
+	if (!PL_OpPtr) {
 	    return NULL;
 	}
-	Zero(PL_OpSlab,PERL_SLAB_SIZE,IV);
-	/* We reserve the 0'th word as a use count */
-	PL_OpSpace = PERL_SLAB_SIZE - 1 - sz;
+	Zero(PL_OpPtr,PERL_SLAB_SIZE,I32 **);
+	/* We reserve the 0'th I32 sized chunk as a use count */
+	PL_OpSlab = (I32 *) PL_OpPtr;
+	/* Reduce size by the use count word, and by the size we need.
+	 * Latter is to mimic the '-=' in the if() above
+	 */
+	PL_OpSpace = PERL_SLAB_SIZE - (sizeof(I32)+sizeof(I32 **)-1)/sizeof(I32 **) - sz;
 	/* Allocation pointer starts at the top.
 	   Theory: because we build leaves before trunk allocating at end
 	   means that at run time access is cache friendly upward
 	 */
-	PL_OpPtr   = (IV **) &PL_OpSlab[PERL_SLAB_SIZE];
+	PL_OpPtr += PERL_SLAB_SIZE;
     }
     assert( PL_OpSpace >= 0 );
     /* Move the allocation pointer down */
     PL_OpPtr   -= sz;
-    assert( PL_OpPtr > (IV **) PL_OpSlab );
+    assert( PL_OpPtr > (I32 **) PL_OpSlab );
     *PL_OpPtr   = PL_OpSlab;	/* Note which slab it belongs to */
     (*PL_OpSlab)++;		/* Increment use count of slab */
-    assert( (IV *) (PL_OpPtr+sz) <= (PL_OpSlab + PERL_SLAB_SIZE) );
+    assert( PL_OpPtr+sz <= ((I32 **) PL_OpSlab + PERL_SLAB_SIZE) );
     assert( *PL_OpSlab > 0 );
     return (void *)(PL_OpPtr + 1);
 }
@@ -67,10 +76,10 @@ S_Slab_Alloc(pTHX_ int m, size_t sz)
 STATIC void
 S_Slab_Free(pTHX_ void *op)
 {
-    IV **ptr = (IV **) op;
-    IV *slab = ptr[-1];
-    assert( ptr-1 > (IV **) slab );
-    assert( (IV *) ptr < (slab + PERL_SLAB_SIZE) );
+    I32 **ptr = (I32 **) op;
+    I32 *slab = ptr[-1];
+    assert( ptr-1 > (I32 **) slab );
+    assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
     assert( *slab > 0 );
     if (--(*slab) == 0) {
 	PerlMemShared_free(slab);
@@ -82,7 +91,7 @@ S_Slab_Free(pTHX_ void *op)
 
 #else
 #define NewOp(m, var, c, type) Newz(m, var, c, type)
-#define FreeOp(p) SafeFree(p)
+#define FreeOp(p) Safefree(p)
 #endif
 /*
  * In the following definition, the ", Nullop" is just to make the compiler
@@ -878,11 +887,7 @@ clear_pmop:
 		    pmop = pmop->op_pmnext;
 		}
 	    }
-#ifdef USE_ITHREADS
-	    Safefree(PmopSTASHPV(cPMOPo));
-#else
-	    /* NOTE: PMOP.op_pmstash is not refcounted */
-#endif
+	    PmopSTASH_free(cPMOPo);
 	}
 	cPMOPo->op_pmreplroot = Nullop;
         /* we use the "SAFE" version of the PM_ macros here
@@ -913,18 +918,20 @@ clear_pmop:
 STATIC void
 S_cop_free(pTHX_ COP* cop)
 {
-    Safefree(cop->cop_label);
-#ifdef USE_ITHREADS
-    Safefree(CopFILE(cop));		/* XXX share in a pvtable? */
-    Safefree(CopSTASHPV(cop));		/* XXX share in a pvtable? */
-#else
-    /* NOTE: COP.cop_stash is not refcounted */
-    SvREFCNT_dec(CopFILEGV(cop));
-#endif
+    Safefree(cop->cop_label);   /* FIXME: treaddead ??? */
+    CopFILE_free(cop);
+    CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
 	SvREFCNT_dec(cop->cop_warnings);
-    if (! specialCopIO(cop->cop_io))
+    if (! specialCopIO(cop->cop_io)) {
+#ifdef USE_ITHREADS
+	STRLEN len;
+        char *s = SvPV(cop->cop_io,len);
+	Perl_warn(aTHX_ "io='%.*s'",(int) len,s);
+#else
 	SvREFCNT_dec(cop->cop_io);
+#endif
+    }
 }
 
 void
@@ -5171,11 +5178,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
 	SAVESPTR(PL_curstash);
 	SAVECOPSTASH(PL_curcop);
 	PL_curstash = stash;
-#ifdef USE_ITHREADS
-	CopSTASHPV(PL_curcop) = stash ? HvNAME(stash) : Nullch;
-#else
-	CopSTASH(PL_curcop) = stash;
-#endif
+	CopSTASH_set(PL_curcop,stash);
     }
 
     cv = newXS(name, const_sv_xsub, __FILE__);
@@ -6082,8 +6085,8 @@ Perl_ck_glob(pTHX_ OP *o)
     if (!gv) {
 	GV *glob_gv;
 	ENTER;
-	Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn("File::Glob", 10), Nullsv,
-			 Nullsv, Nullsv);
+	Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
+		newSVpvn("File::Glob", 10), Nullsv, Nullsv, Nullsv);
 	gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 	glob_gv = gv_fetchpv("File::Glob::csh_glob", FALSE, SVt_PVCV);
 	GvCV(gv) = GvCV(glob_gv);