From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Mon, 14 Jan 2002 14:04:24 +0000 (+0000)
Subject: Retract #14251 (the op slab allocator from perlio)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=00896663c42f948ff210f9dc95027f57806a6ded;p=p5sagit%2Fp5-mst-13.2.git

Retract #14251 (the op slab allocator from perlio)
until we figure out why 2.2.19 x86 debian gets
a circular sibling chain and therefore hangs in
the Perl_ck_subr() sibling for-loop.

p4raw-id: //depot/perl@14255
---

diff --git a/embed.fnc b/embed.fnc
index f5fcac6..729f914 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1007,7 +1007,6 @@ s	|void	|apply_attrs	|HV *stash|SV *target|OP *attrs|bool for_my
 s	|void	|apply_attrs_my	|HV *stash|OP *target|OP *attrs|OP **imopsp
 #  if defined(PL_OP_SLAB_ALLOC)
 s	|void*	|Slab_Alloc	|int m|size_t sz
-s	|void	|Slab_Free	|void *
 #  endif
 #endif
 
diff --git a/embed.h b/embed.h
index cbd880e..6203634 100644
--- a/embed.h
+++ b/embed.h
@@ -936,7 +936,6 @@
 #define apply_attrs_my		S_apply_attrs_my
 #  if defined(PL_OP_SLAB_ALLOC)
 #define Slab_Alloc		S_Slab_Alloc
-#define Slab_Free		S_Slab_Free
 #  endif
 #endif
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
@@ -2478,7 +2477,6 @@
 #define apply_attrs_my(a,b,c,d)	S_apply_attrs_my(aTHX_ a,b,c,d)
 #  if defined(PL_OP_SLAB_ALLOC)
 #define Slab_Alloc(a,b)		S_Slab_Alloc(aTHX_ a,b)
-#define Slab_Free(a)		S_Slab_Free(aTHX_ a)
 #  endif
 #endif
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
diff --git a/embedvar.h b/embedvar.h
index c6eb5fa..16c8e46 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -183,9 +183,6 @@
 #define PL_Mem			(PERL_GET_INTERP->IMem)
 #define PL_MemParse		(PERL_GET_INTERP->IMemParse)
 #define PL_MemShared		(PERL_GET_INTERP->IMemShared)
-#define PL_OpPtr		(PERL_GET_INTERP->IOpPtr)
-#define PL_OpSlab		(PERL_GET_INTERP->IOpSlab)
-#define PL_OpSpace		(PERL_GET_INTERP->IOpSpace)
 #define PL_Proc			(PERL_GET_INTERP->IProc)
 #define PL_Sock			(PERL_GET_INTERP->ISock)
 #define PL_StdIO		(PERL_GET_INTERP->IStdIO)
@@ -481,9 +478,6 @@
 #define PL_Mem			(vTHX->IMem)
 #define PL_MemParse		(vTHX->IMemParse)
 #define PL_MemShared		(vTHX->IMemShared)
-#define PL_OpPtr		(vTHX->IOpPtr)
-#define PL_OpSlab		(vTHX->IOpSlab)
-#define PL_OpSpace		(vTHX->IOpSpace)
 #define PL_Proc			(vTHX->IProc)
 #define PL_Sock			(vTHX->ISock)
 #define PL_StdIO		(vTHX->IStdIO)
@@ -782,9 +776,6 @@
 #define PL_IMem			PL_Mem
 #define PL_IMemParse		PL_MemParse
 #define PL_IMemShared		PL_MemShared
-#define PL_IOpPtr		PL_OpPtr
-#define PL_IOpSlab		PL_OpSlab
-#define PL_IOpSpace		PL_OpSpace
 #define PL_IProc		PL_Proc
 #define PL_ISock		PL_Sock
 #define PL_IStdIO		PL_StdIO
diff --git a/intrpvar.h b/intrpvar.h
index 4486d2f..3d08143 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -512,12 +512,6 @@ PERLVAR(Idebug_pad,	struct perl_debug_pad)	/* always needed because of the re ex
 
 PERLVAR(Itaint_warn, bool)      /* taint warns instead of dying */
 
-#ifdef PL_OP_SLAB_ALLOC
-PERLVAR(IOpPtr,IV **)
-PERLVARI(IOpSpace,int,0)
-PERLVAR(IOpSlab,IV *)
-#endif
-
 /* New variables must be added to the very end for binary compatibility.
  * XSUB.h provides wrapper functions via perlapi.h that make this
  * irrelevant, but not all code may be expected to #include XSUB.h. */
diff --git a/op.c b/op.c
index 2230aaf..c97dacd 100644
--- a/op.c
+++ b/op.c
@@ -23,66 +23,28 @@
 
 #define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)
 
-#if defined(PL_OP_SLAB_ALLOC)
-
-#ifndef PERL_SLAB_SIZE
-#define PERL_SLAB_SIZE 2048
-#endif
-
-#define NewOp(m,var,c,type) \
-	STMT_START { var = (type *) Slab_Alloc(m,c*sizeof(type)); } STMT_END
-
-#define FreeOp(p) Slab_Free(p)
+/* #define PL_OP_SLAB_ALLOC */
+
+#if defined(PL_OP_SLAB_ALLOC) && !defined(PERL_IMPLICIT_CONTEXT)
+#define SLAB_SIZE 8192
+static char    *PL_OpPtr  = NULL;	/* XXX threadead */
+static int     PL_OpSpace = 0;		/* XXX threadead */
+#define NewOp(m,var,c,type) do { if ((PL_OpSpace -= c*sizeof(type)) >= 0)     \
+                              var =  (type *)(PL_OpPtr -= c*sizeof(type));    \
+                             else                                             \
+                              var = (type *) Slab_Alloc(m,c*sizeof(type));    \
+                           } while (0)
 
 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);
-    if ((PL_OpSpace -= sz) < 0) {
-	PL_OpSlab = (IV *) PerlMemShared_malloc(PERL_SLAB_SIZE*sizeof(IV));
-	if (!PL_OpSlab) {
-	    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;
-	/* 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];
-    }
-    assert( PL_OpSpace >= 0 );
-    /* Move the allocation pointer down */
-    PL_OpPtr   -= sz;
-    assert( PL_OpPtr > (IV **) 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_OpSlab > 0 );
-    return (void *)(PL_OpPtr + 1);
-}
-
-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) );
-    assert( *slab > 0 );
-    if (--(*slab) == 0) {
-	PerlMemShared_free(slab);
-	if (slab == PL_OpSlab) {
-	    PL_OpSpace = 0;
-	}
-    }
+ Newz(m,PL_OpPtr,SLAB_SIZE,char);
+ PL_OpSpace = SLAB_SIZE - sz;
+ return PL_OpPtr += PL_OpSpace;
 }
 
 #else
 #define NewOp(m, var, c, type) Newz(m, var, c, type)
-#define FreeOp(p) SafeFree(p)
 #endif
 /*
  * In the following definition, the ", Nullop" is just to make the compiler
@@ -773,7 +735,14 @@ Perl_op_free(pTHX_ OP *o)
 	cop_free((COP*)o);
 
     op_clear(o);
-    FreeOp(o);
+
+#ifdef PL_OP_SLAB_ALLOC
+    if ((char *) o == PL_OpPtr)
+     {
+     }
+#else
+    Safefree(o);
+#endif
 }
 
 void
@@ -2614,8 +2583,10 @@ Perl_append_list(pTHX_ I32 type, LISTOP *first, LISTOP *last)
     first->op_last = last->op_last;
     first->op_flags |= (last->op_flags & OPf_KIDS);
 
-    FreeOp(last);
-
+#ifdef PL_OP_SLAB_ALLOC
+#else
+    Safefree(last);
+#endif
     return (OP*)first;
 }
 
@@ -4317,7 +4288,6 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
 	LOOP *tmp;
 	NewOp(1234,tmp,1,LOOP);
 	Copy(loop,tmp,1,LOOP);
-	FreeOp(loop);
 	loop = tmp;
     }
 #else
diff --git a/perl.h b/perl.h
index a7a7849..7a876b5 100644
--- a/perl.h
+++ b/perl.h
@@ -9,8 +9,6 @@
 #ifndef H_PERL
 #define H_PERL 1
 
-#define PL_OP_SLAB_ALLOC
-
 #ifdef PERL_FOR_X2P
 /*
  * This file is being used for x2p stuff.
diff --git a/perlapi.h b/perlapi.h
index 76eb92f..3d74ecd 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -103,12 +103,6 @@ END_EXTERN_C
 #define PL_MemParse		(*Perl_IMemParse_ptr(aTHX))
 #undef  PL_MemShared
 #define PL_MemShared		(*Perl_IMemShared_ptr(aTHX))
-#undef  PL_OpPtr
-#define PL_OpPtr		(*Perl_IOpPtr_ptr(aTHX))
-#undef  PL_OpSlab
-#define PL_OpSlab		(*Perl_IOpSlab_ptr(aTHX))
-#undef  PL_OpSpace
-#define PL_OpSpace		(*Perl_IOpSpace_ptr(aTHX))
 #undef  PL_Proc
 #define PL_Proc			(*Perl_IProc_ptr(aTHX))
 #undef  PL_Sock
diff --git a/proto.h b/proto.h
index 0bdb25c..ea837ec 100644
--- a/proto.h
+++ b/proto.h
@@ -1043,7 +1043,6 @@ STATIC void	S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my);
 STATIC void	S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp);
 #  if defined(PL_OP_SLAB_ALLOC)
 STATIC void*	S_Slab_Alloc(pTHX_ int m, size_t sz);
-STATIC void	S_Slab_Free(pTHX_ void *);
 #  endif
 #endif