Change 14251 by jhi@alpha on 2002/01/13 23:30:05
Integrate perlio.
Slab allocator for ops
- moved the statics to intrpvar.h
- implemented Slab_Free()
- uses PerlMemShared (for now) if distinction exists.
Affected files ...
.... //depot/perl/embed.fnc#7 integrate
.... //depot/perl/embed.h#328 integrate
.... //depot/perl/embedvar.h#136 integrate
.... //depot/perl/global.sym#200 integrate
.... //depot/perl/intrpvar.h#98 integrate
.... //depot/perl/op.c#475 integrate
.... //depot/perl/perl.h#434 integrate
.... //depot/perl/perlapi.c#126 integrate
.... //depot/perl/perlapi.h#58 integrate
.... //depot/perl/proto.h#370 integrate
Differences ...
==== //depot/perl/embed.fnc#7 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc.~1~ Sun Jan 13 16:45:06 2002
+++ perl/embed.fnc Sun Jan 13 16:45:06 2002
@@ -1007,6 +1007,7 @@
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
==== //depot/perl/embed.h#328 (text+w) ====
Index: perl/embed.h
--- perl/embed.h.~1~ Sun Jan 13 16:45:06 2002
+++ perl/embed.h Sun Jan 13 16:45:06 2002
@@ -936,6 +936,7 @@
#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)
@@ -2477,6 +2478,7 @@
#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)
==== //depot/perl/embedvar.h#136 (text+w) ====
Index: perl/embedvar.h
--- perl/embedvar.h.~1~ Sun Jan 13 16:45:06 2002
+++ perl/embedvar.h Sun Jan 13 16:45:06 2002
@@ -183,6 +183,9 @@
#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)
@@ -478,6 +481,9 @@
#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)
@@ -776,6 +782,9 @@
#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
==== //depot/perl/global.sym#200 (text+w) ====
==== //depot/perl/intrpvar.h#98 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h.~1~ Sun Jan 13 16:45:06 2002
+++ perl/intrpvar.h Sun Jan 13 16:45:06 2002
@@ -512,6 +512,12 @@
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. */
==== //depot/perl/op.c#475 (text) ====
Index: perl/op.c
--- perl/op.c.~1~ Sun Jan 13 16:45:06 2002
+++ perl/op.c Sun Jan 13 16:45:06 2002
@@ -23,28 +23,66 @@
#define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)
-/* #define PL_OP_SLAB_ALLOC */
+#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
-#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)
+#define FreeOp(p) Slab_Free(p)
STATIC void *
S_Slab_Alloc(pTHX_ int m, size_t sz)
{
- Newz(m,PL_OpPtr,SLAB_SIZE,char);
- PL_OpSpace = SLAB_SIZE - sz;
- return PL_OpPtr += PL_OpSpace;
+ /* 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;
+ }
+ }
}
#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
@@ -735,14 +773,7 @@
cop_free((COP*)o);
op_clear(o);
-
-#ifdef PL_OP_SLAB_ALLOC
- if ((char *) o == PL_OpPtr)
- {
- }
-#else
- Safefree(o);
-#endif
+ FreeOp(o);
}
void
@@ -2583,10 +2614,8 @@
first->op_last = last->op_last;
first->op_flags |= (last->op_flags & OPf_KIDS);
-#ifdef PL_OP_SLAB_ALLOC
-#else
- Safefree(last);
-#endif
+ FreeOp(last);
+
return (OP*)first;
}
@@ -4288,6 +4317,7 @@
LOOP *tmp;
NewOp(1234,tmp,1,LOOP);
Copy(loop,tmp,1,LOOP);
+ FreeOp(loop);
loop = tmp;
}
#else
==== //depot/perl/perl.h#434 (text) ====
Index: perl/perl.h
--- perl/perl.h.~1~ Sun Jan 13 16:45:06 2002
+++ perl/perl.h Sun Jan 13 16:45:06 2002
@@ -9,6 +9,8 @@
#ifndef H_PERL
#define H_PERL 1
+#define PL_OP_SLAB_ALLOC
+
#ifdef PERL_FOR_X2P
/*
* This file is being used for x2p stuff.
==== //depot/perl/perlapi.c#126 (text+w) ====
==== //depot/perl/perlapi.h#58 (text+w) ====
Index: perl/perlapi.h
--- perl/perlapi.h.~1~ Sun Jan 13 16:45:06 2002
+++ perl/perlapi.h Sun Jan 13 16:45:06 2002
@@ -103,6 +103,12 @@
#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
==== //depot/perl/proto.h#370 (text+w) ====
Index: perl/proto.h
--- perl/proto.h.~1~ Sun Jan 13 16:45:06 2002
+++ perl/proto.h Sun Jan 13 16:45:06 2002
@@ -1043,6 +1043,7 @@
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
End of Patch.
