X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=94c0b392d1e137959c776e24ebfc9c999f316b36;hb=a9ef352ac26829339bf17aa20568b3bde2fb1dd0;hp=635a04aad477d8d49db594700511d645daa13db4;hpb=79cb57f6e01f91d8fff40d69caa187aaa669671b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 635a04a..94c0b39 100644
--- a/op.c
+++ b/op.c
@@ -22,8 +22,31 @@
 #define CHECKCALL this->*PL_check
 #else
 #define CHECKCALL *PL_check
+#endif              
+
+/* #define PL_OP_SLAB_ALLOC */
+                                                            
+#ifdef PL_OP_SLAB_ALLOC 
+#define SLAB_SIZE 8192
+static char    *PL_OpPtr  = NULL;
+static int     PL_OpSpace = 0;
+#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 *           
+Slab_Alloc(int m, size_t sz)
+{ 
+ 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)
 #endif
-
 /*
  * In the following definition, the ", Nullop" is just to make the compiler
  * think the expression is of the right type: croak actually does a Siglongjmp.
@@ -706,7 +729,13 @@ op_free(OP *o)
     if (o->op_targ > 0)
 	pad_free(o->op_targ);
 
+#ifdef PL_OP_SLAB_ALLOC
+    if ((char *) o == PL_OpPtr)
+     {
+     }
+#else
     Safefree(o);
+#endif
 }
 
 STATIC void
@@ -1722,6 +1751,8 @@ newPROG(OP *o)
 {
     dTHR;
     if (PL_in_eval) {
+	if (PL_eval_root)
+		return;
 	PL_eval_root = newUNOP(OP_LEAVEEVAL, ((PL_in_eval & 4) ? OPf_SPECIAL : 0), o);
 	PL_eval_start = linklist(PL_eval_root);
 	PL_eval_root->op_next = 0;
@@ -1997,8 +2028,11 @@ append_list(I32 type, LISTOP *first, LISTOP *last)
     first->op_children += last->op_children;
     if (first->op_children)
 	first->op_flags |= OPf_KIDS;
-
-    Safefree(last);
+    
+#ifdef PL_OP_SLAB_ALLOC
+#else
+    Safefree(last);     
+#endif
     return (OP*)first;
 }
 
@@ -2053,7 +2087,7 @@ newLISTOP(I32 type, I32 flags, OP *first, OP *last)
 {
     LISTOP *listop;
 
-    Newz(1101, listop, 1, LISTOP);
+    NewOp(1101, listop, 1, LISTOP);
 
     listop->op_type = type;
     listop->op_ppaddr = PL_ppaddr[type];
@@ -2087,7 +2121,7 @@ OP *
 newOP(I32 type, I32 flags)
 {
     OP *o;
-    Newz(1101, o, 1, OP);
+    NewOp(1101, o, 1, OP);
     o->op_type = type;
     o->op_ppaddr = PL_ppaddr[type];
     o->op_flags = flags;
@@ -2111,7 +2145,7 @@ newUNOP(I32 type, I32 flags, OP *first)
     if (PL_opargs[type] & OA_MARK)
 	first = force_list(first);
 
-    Newz(1101, unop, 1, UNOP);
+    NewOp(1101, unop, 1, UNOP);
     unop->op_type = type;
     unop->op_ppaddr = PL_ppaddr[type];
     unop->op_first = first;
@@ -2128,7 +2162,7 @@ OP *
 newBINOP(I32 type, I32 flags, OP *first, OP *last)
 {
     BINOP *binop;
-    Newz(1101, binop, 1, BINOP);
+    NewOp(1101, binop, 1, BINOP);
 
     if (!first)
 	first = newOP(OP_NULL, 0);
@@ -2425,7 +2459,7 @@ newPMOP(I32 type, I32 flags)
     dTHR;
     PMOP *pmop;
 
-    Newz(1101, pmop, 1, PMOP);
+    NewOp(1101, pmop, 1, PMOP);
     pmop->op_type = type;
     pmop->op_ppaddr = PL_ppaddr[type];
     pmop->op_flags = flags;
@@ -2480,7 +2514,7 @@ pmruntime(OP *o, OP *expr, OP *repl)
 			    ? OP_REGCRESET
 			    : OP_REGCMAYBE),0,expr);
 
-	Newz(1101, rcop, 1, LOGOP);
+	NewOp(1101, rcop, 1, LOGOP);
 	rcop->op_type = OP_REGCOMP;
 	rcop->op_ppaddr = PL_ppaddr[OP_REGCOMP];
 	rcop->op_first = scalar(expr);
@@ -2575,7 +2609,7 @@ pmruntime(OP *o, OP *expr, OP *repl)
 		pm->op_pmflags |= PMf_MAYBE_CONST;
 		pm->op_pmpermflags |= PMf_MAYBE_CONST;
 	    }
-	    Newz(1101, rcop, 1, LOGOP);
+	    NewOp(1101, rcop, 1, LOGOP);
 	    rcop->op_type = OP_SUBSTCONT;
 	    rcop->op_ppaddr = PL_ppaddr[OP_SUBSTCONT];
 	    rcop->op_first = scalar(repl);
@@ -2600,7 +2634,7 @@ OP *
 newSVOP(I32 type, I32 flags, SV *sv)
 {
     SVOP *svop;
-    Newz(1101, svop, 1, SVOP);
+    NewOp(1101, svop, 1, SVOP);
     svop->op_type = type;
     svop->op_ppaddr = PL_ppaddr[type];
     svop->op_sv = sv;
@@ -2618,7 +2652,7 @@ newGVOP(I32 type, I32 flags, GV *gv)
 {
     dTHR;
     GVOP *gvop;
-    Newz(1101, gvop, 1, GVOP);
+    NewOp(1101, gvop, 1, GVOP);
     gvop->op_type = type;
     gvop->op_ppaddr = PL_ppaddr[type];
     gvop->op_gv = (GV*)SvREFCNT_inc(gv);
@@ -2635,7 +2669,7 @@ OP *
 newPVOP(I32 type, I32 flags, char *pv)
 {
     PVOP *pvop;
-    Newz(1101, pvop, 1, PVOP);
+    NewOp(1101, pvop, 1, PVOP);
     pvop->op_type = type;
     pvop->op_ppaddr = PL_ppaddr[type];
     pvop->op_pv = pv;
@@ -2973,7 +3007,7 @@ newSTATEOP(I32 flags, char *label, OP *o)
     U32 seq = intro_my();
     register COP *cop;
 
-    Newz(1101, cop, 1, COP);
+    NewOp(1101, cop, 1, COP);
     if (PERLDB_LINE && PL_curcop->cop_line && PL_curstash != PL_debstash) {
 	cop->op_type = OP_DBSTATE;
 	cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ];
@@ -3140,7 +3174,7 @@ new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
     if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
 	other->op_private |= OPpASSIGN_BACKWARDS;  /* other is an OP_SASSIGN */
 
-    Newz(1101, logop, 1, LOGOP);
+    NewOp(1101, logop, 1, LOGOP);
 
     logop->op_type = type;
     logop->op_ppaddr = PL_ppaddr[type];
@@ -3189,7 +3223,7 @@ newCONDOP(I32 flags, OP *first, OP *trueop, OP *falseop)
 	list(trueop);
 	scalar(falseop);
     }
-    Newz(1101, condop, 1, CONDOP);
+    NewOp(1101, condop, 1, CONDOP);
 
     condop->op_type = OP_COND_EXPR;
     condop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];
@@ -3222,7 +3256,7 @@ newRANGE(I32 flags, OP *left, OP *right)
     OP *flop;
     OP *o;
 
-    Newz(1101, condop, 1, CONDOP);
+    NewOp(1101, condop, 1, CONDOP);
 
     condop->op_type = OP_RANGE;
     condop->op_ppaddr = PL_ppaddr[OP_RANGE];
@@ -3383,7 +3417,7 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b
 	o = listop;
 
     if (!loop) {
-	Newz(1101,loop,1,LOOP);
+	NewOp(1101,loop,1,LOOP);
 	loop->op_type = OP_ENTERLOOP;
 	loop->op_ppaddr = PL_ppaddr[OP_ENTERLOOP];
 	loop->op_private = 0;
@@ -3409,6 +3443,7 @@ OP *
 newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
 {
     LOOP *loop;
+    LOOP *tmp;
     OP *wop;
     int padoff = 0;
     I32 iterflags = 0;
@@ -3480,7 +3515,13 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
     loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
 			       append_elem(OP_LIST, expr, scalar(sv))));
     assert(!loop->op_next);
+#ifdef PL_OP_SLAB_ALLOC
+    NewOp(1234,tmp,1,LOOP);
+    Copy(loop,tmp,1,LOOP);
+    loop = tmp;
+#else
     Renew(loop, 1, LOOP);
+#endif 
     loop->op_targ = padoff;
     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont);
     PL_copline = forline;
@@ -4306,7 +4347,7 @@ newAVREF(OP *o)
 OP *
 newGVREF(I32 type, OP *o)
 {
-    if (type == OP_MAPSTART || type == OP_GREPSTART)
+    if (type == OP_MAPSTART || type == OP_GREPSTART || type == OP_SORT)
 	return newUNOP(OP_NULL, 0, o);
     return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
 }
@@ -4464,7 +4505,7 @@ ck_eval(OP *o)
 	    cUNOPo->op_first = 0;
 	    op_free(o);
 
-	    Newz(1101, enter, 1, LOGOP);
+	    NewOp(1101, enter, 1, LOGOP);
 	    enter->op_type = OP_ENTERTRY;
 	    enter->op_ppaddr = PL_ppaddr[OP_ENTERTRY];
 	    enter->op_private = 0;
@@ -4780,11 +4821,27 @@ ck_fun(OP *o)
 		    }
 		    else {
 			I32 flags = OPf_SPECIAL;
+			I32 priv = 0;
 			/* is this op a FH constructor? */
-			if (is_handle_constructor(o,numargs))
-			    flags = 0;
+			if (is_handle_constructor(o,numargs)) {
+			    flags   = 0;                         
+			    /* Set a flag to tell rv2gv to vivify 
+			     * need to "prove" flag does not mean something
+			     * else already - NI-S 1999/05/07
+			     */ 
+			    priv = OPpDEREF; 
+#if 0
+			    /* Helps with open($array[$n],...) 
+			       but is too simplistic - need to do selectively
+			    */
+			    mod(kid,type);
+#endif
+			}
 			kid->op_sibling = 0;
 			kid = newUNOP(OP_RV2GV, flags, scalar(kid));
+			if (priv) {
+			    kid->op_private |= priv;
+			}
 		    }
 		    kid->op_sibling = sibl;
 		    *tokid = kid;
@@ -4859,7 +4916,7 @@ ck_grep(OP *o)
     OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
 
     o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
-    Newz(1101, gwop, 1, LOGOP);
+    NewOp(1101, gwop, 1, LOGOP);
 
     if (o->op_flags & OPf_STACKED) {
 	OP* k;
@@ -5119,7 +5176,7 @@ ck_sort(OP *o)
     if (o->op_flags & OPf_STACKED) {		     /* may have been cleared */
 	OP *kid = cLISTOPo->op_first->op_sibling;	/* get past pushmark */
 	OP *k;
-	kid = kUNOP->op_first;				/* get past rv2gv */
+	kid = kUNOP->op_first;				/* get past null */
 
 	if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
 	    linklist(kid);
@@ -5144,7 +5201,6 @@ ck_sort(OP *o)
 	    peep(k);
 
 	    kid = cLISTOPo->op_first->op_sibling;	/* get past pushmark */
-	    null(kid);					/* wipe out rv2gv */
 	    if (o->op_type == OP_SORT)
 		kid->op_next = kid;
 	    else
@@ -5169,7 +5225,7 @@ simplify_sort(OP *o)
 	return;
     GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV)); 
     GvMULTI_on(gv_fetchpv("b", TRUE, SVt_PV)); 
-    kid = kUNOP->op_first;				/* get past rv2gv */
+    kid = kUNOP->op_first;				/* get past null */
     if (kid->op_type != OP_SCOPE)
 	return;
     kid = kLISTOP->op_last;				/* get past scope */
@@ -5573,7 +5629,7 @@ peep(register OP *o)
 	    char *key;
 	    STRLEN keylen;
 	
-	    if (o->op_private & (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)
+	    if ((o->op_private & (OPpLVAL_INTRO))
 		|| ((BINOP*)o)->op_last->op_type != OP_CONST)
 		break;
 	    rop = (UNOP*)((BINOP*)o)->op_first;