develooper Front page | perl.ponie.changes | Postings from March 2006

[svn:ponie] r396 - branches/5.9.3merge/perl

From:
nicholas
Date:
March 16, 2006 15:53
Subject:
[svn:ponie] r396 - branches/5.9.3merge/perl
Message ID:
20060316235343.A2CD5CBA2B@x12.develooper.com
Author: nicholas
Date: Thu Mar 16 15:53:42 2006
New Revision: 396

Modified:
   branches/5.9.3merge/perl/embed.fnc
   branches/5.9.3merge/perl/embed.h
   branches/5.9.3merge/perl/perlio.c
   branches/5.9.3merge/perl/pp.c
   branches/5.9.3merge/perl/pp_hot.c
   branches/5.9.3merge/perl/pp_pack.c
   branches/5.9.3merge/perl/proto.h
   branches/5.9.3merge/perl/regexec.c
   branches/5.9.3merge/perl/sv.c
   branches/5.9.3merge/perl/sv.h

Log:
Fix the remainder of the compile errors. This gets us to the point of linking a
miniperl. Of course, it doesn't actually run properly yet. :-)


Modified: branches/5.9.3merge/perl/embed.fnc
==============================================================================
--- branches/5.9.3merge/perl/embed.fnc	(original)
+++ branches/5.9.3merge/perl/embed.fnc	Thu Mar 16 15:53:42 2006
@@ -1339,6 +1339,7 @@
 nsR	|char *	|uiv_2buf	|NN char *buf|IV iv|UV uv|int is_uv|NN char **peob
 s	|void	|not_a_number	|NN SV *sv
 s	|I32	|visit		|NN SVFUNC_t f|U32 flags|U32 mask
+p	|void	|sv_del_backref	|SV *target|SV *ref
 sR	|SV *	|varname	|NULLOK GV *gv|const char gvtype|PADOFFSET targ \
 				|NULLOK SV *keyname|I32 aindex|int subscript_type
 #  if !defined(NV_PRESERVES_UV)

Modified: branches/5.9.3merge/perl/embed.h
==============================================================================
--- branches/5.9.3merge/perl/embed.h	(original)
+++ branches/5.9.3merge/perl/embed.h	Thu Mar 16 15:53:42 2006
@@ -1353,6 +1353,7 @@
 #define uiv_2buf		S_uiv_2buf
 #define not_a_number		S_not_a_number
 #define visit			S_visit
+#define sv_del_backref		Perl_sv_del_backref
 #define varname			S_varname
 #endif
 #  if !defined(NV_PRESERVES_UV)
@@ -3420,6 +3421,7 @@
 #define uiv_2buf		S_uiv_2buf
 #define not_a_number(a)		S_not_a_number(aTHX_ a)
 #define visit(a,b,c)		S_visit(aTHX_ a,b,c)
+#define sv_del_backref(a,b)	Perl_sv_del_backref(aTHX_ a,b)
 #define varname(a,b,c,d,e,f)	S_varname(aTHX_ a,b,c,d,e,f)
 #endif
 #  if !defined(NV_PRESERVES_UV)

Modified: branches/5.9.3merge/perl/perlio.c
==============================================================================
--- branches/5.9.3merge/perl/perlio.c	(original)
+++ branches/5.9.3merge/perl/perlio.c	Thu Mar 16 15:53:42 2006
@@ -470,7 +470,6 @@
     }
     if (PL_perlio_debug_fd > 0) {
 	dTHX;
-	const char *s;
 #ifdef USE_ITHREADS
 	const char * const s = CopFILE(PL_curcop);
 	/* Use fixed buffer as sv_catpvf etc. needs SVs */

Modified: branches/5.9.3merge/perl/pp.c
==============================================================================
--- branches/5.9.3merge/perl/pp.c	(original)
+++ branches/5.9.3merge/perl/pp.c	Thu Mar 16 15:53:42 2006
@@ -600,9 +600,8 @@
 	    break;
 	case 'P':
 	    if (strEQ(second_letter, "ACKAGE")) {
-		const HV * const stash = GvSTASH(gv);
-		const HEK * const hek = stash ? HvNAME_HEK(stash) : NULL;
-		sv = hek ? newSVhek(hek) : newSVpvs("__ANON__");
+		const char *name = HvNAME(GvSTASH(gv));
+		sv = newSVpv(name ? name : "__ANON__", 0);
 	    }
 	    break;
 	case 'S':

Modified: branches/5.9.3merge/perl/pp_hot.c
==============================================================================
--- branches/5.9.3merge/perl/pp_hot.c	(original)
+++ branches/5.9.3merge/perl/pp_hot.c	Thu Mar 16 15:53:42 2006
@@ -378,7 +378,9 @@
         && SvIVX(TOPs) != IV_MAX)
     {
 	SvIV_set(TOPs, SvIVX(TOPs) + 1);
-	SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
+	/*SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);*/
+	SvPOK_off(TOPs);
+	SvNOK_off(TOPs);
     }
     else /* Do all the PERL_PRESERVE_IVUV conditionals in sv_inc */
 	sv_inc(TOPs);
@@ -3163,18 +3165,10 @@
 		packname = CopSTASHPV(PL_curcop);
 	    }
 	    else if (stash) {
-		HEK * const packhek = HvNAME_HEK(stash);
-		if (packhek) {
-		    packname = HEK_KEY(packhek);
-		    packlen = HEK_LEN(packhek);
-		    need_strlen = 0;
-		} else {
-		    goto croak;
-		}
+		packname = HvNAME(stash);
 	    }
 
 	    if (!packname) {
-	    croak:
 		Perl_croak(aTHX_
 			   "Can't use anonymous symbol table for method lookup");
 	    }

Modified: branches/5.9.3merge/perl/pp_pack.c
==============================================================================
--- branches/5.9.3merge/perl/pp_pack.c	(original)
+++ branches/5.9.3merge/perl/pp_pack.c	Thu Mar 16 15:53:42 2006
@@ -2495,7 +2495,7 @@
 	    from_start -= SvIVX(sv);
 	    SvIV_set(sv, 0);
 	}
-	SvFLAGS(sv) &= ~SVf_OOK;
+	Parrot_PMC_set_intval_intkey(PL_Parrot,MUMBLE(sv), Ponie_I_SVf_OOK, 0);
     }
     if (SvLEN(sv) != 0)
 	Safefree(from_start);

Modified: branches/5.9.3merge/perl/proto.h
==============================================================================
--- branches/5.9.3merge/perl/proto.h	(original)
+++ branches/5.9.3merge/perl/proto.h	Thu Mar 16 15:53:42 2006
@@ -3679,6 +3679,7 @@
 STATIC I32	S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask)
 			__attribute__nonnull__(pTHX_1);
 
+PERL_CALLCONV void	Perl_sv_del_backref(pTHX_ SV *target, SV *ref);
 STATIC SV *	S_varname(pTHX_ GV *gv, const char gvtype, PADOFFSET targ, SV *keyname, I32 aindex, int subscript_type)
 			__attribute__warn_unused_result__;
 

Modified: branches/5.9.3merge/perl/regexec.c
==============================================================================
--- branches/5.9.3merge/perl/regexec.c	(original)
+++ branches/5.9.3merge/perl/regexec.c	Thu Mar 16 15:53:42 2006
@@ -1636,7 +1636,6 @@
     SV* oreplsv = GvSV(PL_replgv);
     const bool do_utf8 = DO_UTF8(sv);
     const I32 multiline = prog->reganch & PMf_MULTILINE;
-    I32 multiline = prog->reganch & PMf_MULTILINE;
 #ifdef DEBUGGING
     SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0);
     SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1);
@@ -2409,7 +2408,6 @@
 
     SV *re_debug_flags = NULL;
 
-    SV *re_debug_flags;
 #endif
     U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
 
@@ -3484,7 +3482,6 @@
 		CURCUR* cc = PL_regcc;
 		char * const lastloc = cc->lastloc; /* Detection of 0-len. */
 		I32 cache_offset = 0, cache_bit = 0;
-		I32 cache_offset = 0, cache_bit = 0;
 		
 		n = cc->cur + 1;	/* how many we know we matched */
 		PL_reginput = locinput;

Modified: branches/5.9.3merge/perl/sv.c
==============================================================================
--- branches/5.9.3merge/perl/sv.c	(original)
+++ branches/5.9.3merge/perl/sv.c	Thu Mar 16 15:53:42 2006
@@ -597,50 +597,22 @@
     Parrot_unregister_pmc(PL_Parrot, PL_sv_pining);
 }
 
+/*
+=for apidoc sv_upgrade
 
-
-
-
-
-
-}
-
-
-
-
-
-
-
-
-
+Upgrade an SV to a more complex form.  Generally adds a new body type to the
+SV, then copies across as much information as possible from the old body.
+You generally want to use the C<SvUPGRADE> macro wrapper. See also C<svtype>.
 
 =cut
 */
 
+void
+Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 {
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-	break;
-	break;
-	break;
-	break;
-	break;
-	break;
-	break;
-
-	break;
+    Parrot_PMC_set_intval_intkey(PL_Parrot,MUMBLE(sv), Ponie_I_SV_UPGRADE_func,
+				 mt);
+}
 
 /*
 =for apidoc sv_backoff
@@ -1384,7 +1356,7 @@
 /* The code that the PMC calls back to (for now).  */
 
 IV
-Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
+Perl_sv_2iv_backend(pTHX_ register SV *sv, I32 flags)
 {
     dVAR;
     if (!sv)
@@ -1464,7 +1436,7 @@
 */
 
 UV
-Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
+Perl_sv_2uv_backend(pTHX_ register SV *sv, I32 flags)
 {
     dVAR;
     if (!sv)
@@ -1815,70 +1787,6 @@
     return getlen.pv;
 }
 
-/* asIV(): extract an integer from the string value of an SV.
- * Caller must validate PVX  */
-
-STATIC IV
-S_asIV(pTHX_ SV *sv)
-{
-    UV value;
-    int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
-
-    if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
-	== IS_NUMBER_IN_UV) {
-	/* It's definitely an integer */
-	if (numtype & IS_NUMBER_NEG) {
-	    if (value < (UV)IV_MIN)
-		return -(IV)value;
-	} else {
-	    if (value < (UV)IV_MAX)
-		return (IV)value;
-	}
-    }
-    if (!numtype) {
-	if (ckWARN(WARN_NUMERIC))
-	    not_a_number(sv);
-    }
-    return I_V(Atof(SvPVX(sv)));
-}
-
-/* asUV(): extract an unsigned integer from the string value of an SV
- * Caller must validate PVX  */
-
-STATIC UV
-S_asUV(pTHX_ SV *sv)
-{
-    UV value;
-    int numtype = grok_number(SvPVX(sv), SvCUR(sv), &value);
-
-    if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
-	== IS_NUMBER_IN_UV) {
-	/* It's definitely an integer */
-	if (!(numtype & IS_NUMBER_NEG))
-	    return value;
-    }
-    if (!numtype) {
-	if (ckWARN(WARN_NUMERIC))
-	    not_a_number(sv);
-    }
-    return U_V(Atof(SvPVX(sv)));
-}
-
-/*
-=for apidoc sv_2pv_nolen
-
-Like C<sv_2pv()>, but doesn't return the length too. You should usually
-use the macro wrapper C<SvPV_nolen(sv)> instead.
-=cut
-*/
-
-char *
-Perl_sv_2pv_nolen(pTHX_ register SV *sv)
-{
-    STRLEN n_a;
-    return sv_2pv(sv, &n_a);
-}
-
 /* uiv_2buf(): private routine for use by sv_2pv_flags(): print an IV or
  * UV as a string towards the end of buf, and return pointers to start and
  * end of it.
@@ -3480,22 +3388,6 @@
 }
 
 /*
-=for apidoc sv_force_normal
-
-Undo various types of fakery on an SV: if the PV is a shared string, make
-a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
-an xpvmg. See also C<sv_force_normal_flags>.
-
-=cut
-*/
-
-void
-Perl_sv_force_normal(pTHX_ register SV *sv)
-{
-    sv_force_normal_flags(sv, 0);
-}
-
-/*
 =for apidoc sv_chop
 
 Efficient removal of characters from the beginning of the string buffer.
@@ -3730,7 +3622,7 @@
 =cut
 */
 MAGIC *	
-Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
+Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
 		 const char* name, I32 namlen)
 {
     dVAR;
@@ -8641,7 +8533,7 @@
     register struct ptr_tbl_ent* pte;
     register struct ptr_tbl_ent* pteend;
     XPV *ptr;
-    New(54, ptr, PERL_ARENA_SIZE/sizeof(XPV), XPV);
+    Newx(ptr, PERL_ARENA_SIZE/sizeof(XPV), XPV);
     ptr->xpv_pv = (char*)PL_pte_arenaroot;
     PL_pte_arenaroot = ptr;
 
@@ -8893,6 +8785,7 @@
     Safefree(tbl);
 }
 
+#ifdef USE_ITHREADS
 
 void
 Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param)

Modified: branches/5.9.3merge/perl/sv.h
==============================================================================
--- branches/5.9.3merge/perl/sv.h	(original)
+++ branches/5.9.3merge/perl/sv.h	Thu Mar 16 15:53:42 2006
@@ -982,6 +982,22 @@
 		   const STRLEN _lEnGtH = SvCUR(sv) + 1; \
 		   SvPV_renew(sv, _lEnGtH); \
 		 } STMT_END
+/* FIXME - this should be moved inside the PMC code.
+   Heck, or this should just eliminated when C strings go.  */
+#define SvPV_free(sv)							\
+    STMT_START {							\
+		     assert(SvTYPE(sv) >= SVt_PV);			\
+		     if (SvLEN(sv)) {					\
+			 if(SvOOK(sv)) {				\
+			     SvPV_set(sv, SvPVX_mutable(sv) - SvIVX(sv)); \
+			     Parrot_PMC_set_intval_intkey(PL_Parrot,	\
+							  MUMBLE(sv),	\
+							  Ponie_I_SVf_OOK, \
+							  0);		\
+			 }						\
+			 Safefree(SvPVX(sv));				\
+		     }							\
+		 } STMT_END
 
 #define BmRARE(sv)	(*(U8 *)Parrot_PMC_get_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RARE))
 #define BmUSEFUL(sv)	(*(I32 *)Parrot_PMC_get_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_USEFUL))



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About