cvs commit: ponie/perl av.c cop.h dump.c gv.c handy.h malloc.c mg.c op.c pad.c pad.h perl.c perl.h pp.c pp.h pp_ctl.c pp_hot.c pp_pack.c pp_sort.c pp_sys.c regcomp.c scope.c sv.c sv.h toke.c
[email protected] (Nicholas Clark) 19 Apr 2005 19:04:16 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 05/04/19 12:04:16
Modified: perl av.c cop.h dump.c gv.c handy.h malloc.c mg.c op.c
pad.c pad.h perl.c perl.h pp.c pp.h pp_ctl.c
pp_hot.c pp_pack.c pp_sort.c pp_sys.c regcomp.c
scope.c sv.c sv.h toke.c
Log:
Patches 24239 24240 24241 24243 24244 24245 24246 24248 24249
from blead (*_set macros)
Plus some fixups
[redux. Why didn't CVS get this lot the first time?]
Revision Changes Path
1.10 +10 -10 ponie/perl/av.c
Index: av.c
===================================================================
RCS file: /cvs/public/ponie/perl/av.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- av.c 4 Apr 2005 17:46:11 -0000 1.9
+++ av.c 19 Apr 2005 19:04:13 -0000 1.10
@@ -126,7 +126,7 @@
tmp = AvARRAY(av) - AvALLOC(av);
Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
AvMAX(av) += tmp;
- SvPVX(av) = (char*)AvALLOC(av);
+ SvPV_set(av, (char*)AvALLOC(av));
if (AvREAL(av)) {
while (tmp)
ary[--tmp] = &PL_sv_undef;
@@ -203,7 +203,7 @@
ary[--tmp] = &PL_sv_undef;
}
- SvPVX(av) = (char*)AvALLOC(av);
+ SvPV_set(av, (char*)AvALLOC(av));
AvMAX(av) = newmax;
}
}
@@ -399,7 +399,7 @@
sv_upgrade((SV *)av, SVt_PVAV);
AvREAL_on(av);
AvALLOC(av) = 0;
- SvPVX(av) = 0;
+ SvPV_set(av, (char*)0);
AvMAX(av) = AvFILLp(av) = -1;
return av;
}
@@ -427,7 +427,7 @@
register I32 i;
New(4,ary,size,SV*);
AvALLOC(av) = ary;
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
AvFILLp(av) = size - 1;
AvMAX(av) = size - 1;
for (i = 0; i < size; i++) {
@@ -452,7 +452,7 @@
AvALLOC(av) = ary;
Copy(strp,ary,size,SV*);
AvFLAGS(av) = AVf_REIFY;
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
AvFILLp(av) = size - 1;
AvMAX(av) = size - 1;
while (size--) {
@@ -509,7 +509,7 @@
}
if ((key = AvARRAY(av) - AvALLOC(av))) {
AvMAX(av) += key;
- SvPVX(av) = (char*)AvALLOC(av);
+ SvPV_set(av, (char*)AvALLOC(av));
}
AvFILLp(av) = -1;
@@ -543,7 +543,7 @@
}
Safefree(AvALLOC(av));
AvALLOC(av) = 0;
- SvPVX(av) = 0;
+ SvPV_set(av, (char*)0);
AvMAX(av) = AvFILLp(av) = -1;
if (AvARYLEN(av)) {
SvREFCNT_dec(AvARYLEN(av));
@@ -682,7 +682,7 @@
AvMAX(av) += i;
AvFILLp(av) += i;
- SvPVX(av) = (char*)(AvARRAY(av) - i);
+ SvPV_set(av, (char*)(AvARRAY(av) - i));
}
if (num) {
i = AvFILLp(av);
@@ -699,7 +699,7 @@
/* Make extra elements into a buffer */
AvMAX(av) -= slide;
AvFILLp(av) -= slide;
- SvPVX(av) = (char*)(AvARRAY(av) + slide);
+ SvPV_set(av, (char*)(AvARRAY(av) + slide));
}
}
@@ -742,7 +742,7 @@
retval = *AvARRAY(av);
if (AvREAL(av))
*AvARRAY(av) = &PL_sv_undef;
- SvPVX(av) = (char*)(AvARRAY(av) + 1);
+ SvPV_set(av, (char*)(AvARRAY(av) + 1));
AvMAX(av)--;
AvFILLp(av)--;
if (SvSMAGICAL(av))
1.2 +43 -30 ponie/perl/cop.h
Index: cop.h
===================================================================
RCS file: /cvs/public/ponie/perl/cop.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- cop.h 9 Sep 2003 11:58:48 -0000 1.1
+++ cop.h 19 Apr 2005 19:04:13 -0000 1.2
@@ -1,7 +1,7 @@
/* cop.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
@@ -37,11 +37,11 @@
# define CopFILEGV(c) (CopFILE(c) \
? gv_fetchfile(CopFILE(c)) : Nullgv)
- #ifdef NETWARE
- #define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
- #else
- #define CopFILE_set(c,pv) ((c)->cop_file = savesharedpv(pv))
- #endif
+# ifdef NETWARE
+# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
+# else
+# define CopFILE_set(c,pv) ((c)->cop_file = savesharedpv(pv))
+# endif
# define CopFILESV(c) (CopFILE(c) \
? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
@@ -49,11 +49,11 @@
? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
# define CopSTASHPV(c) ((c)->cop_stashpv)
- #ifdef NETWARE
- #define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
- #else
- #define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savesharedpv(pv))
- #endif
+# ifdef NETWARE
+# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
+# else
+# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savesharedpv(pv))
+# endif
# define CopSTASH(c) (CopSTASHPV(c) \
? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
@@ -62,17 +62,17 @@
&& (CopSTASHPV(c) == HvNAME(hv) \
|| (CopSTASHPV(c) && HvNAME(hv) \
&& strEQ(CopSTASHPV(c), HvNAME(hv)))))
- #ifdef NETWARE
- #define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
- #else
- #define CopSTASH_free(c) PerlMemShared_free(CopSTASHPV(c))
- #endif
-
- #ifdef NETWARE
- #define CopFILE_free(c) SAVECOPFILE_FREE(c)
- #else
- #define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = Nullch))
- #endif
+# ifdef NETWARE
+# define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
+# else
+# define CopSTASH_free(c) PerlMemShared_free(CopSTASHPV(c))
+# endif
+
+# ifdef NETWARE
+# define CopFILE_free(c) SAVECOPFILE_FREE(c)
+# else
+# define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = Nullch))
+# endif
#else
# define CopFILEGV(c) ((c)->cop_filegv)
# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
@@ -119,13 +119,24 @@
U8 hasargs;
U8 lval; /* XXX merge lval and hasargs? */
PAD *oldcomppad;
+ OP * retop; /* op to execute on exit from sub */
};
-/* base for the next two macros. Don't use directly */
+/* base for the next two macros. Don't use directly.
+ * Note that the refcnt of the cv is incremented twice; The CX one is
+ * decremented by LEAVESUB, the other by LEAVE. */
+
#define PUSHSUB_BASE(cx) \
cx->blk_sub.cv = cv; \
cx->blk_sub.olddepth = CvDEPTH(cv); \
- cx->blk_sub.hasargs = hasargs;
+ cx->blk_sub.hasargs = hasargs; \
+ cx->blk_sub.retop = Nullop; \
+ if (!CvDEPTH(cv)) { \
+ (void)SvREFCNT_inc(cv); \
+ (void)SvREFCNT_inc(cv); \
+ SAVEFREESV(cv); \
+ }
+
#define PUSHSUB(cx) \
PUSHSUB_BASE(cx) \
@@ -141,6 +152,7 @@
#define PUSHFORMAT(cx) \
cx->blk_sub.cv = cv; \
cx->blk_sub.gv = gv; \
+ cx->blk_sub.retop = Nullop; \
cx->blk_sub.hasargs = 0; \
cx->blk_sub.dfoutgv = PL_defoutgv; \
(void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
@@ -156,7 +168,7 @@
#define CLEAR_ARGARRAY(ary) \
STMT_START { \
AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary); \
- SvPVX(ary) = (char*)AvALLOC(ary); \
+ SvPV_set(ary, (char*)AvALLOC(ary)); \
AvFILLp(ary) = -1; \
} STMT_END
@@ -200,6 +212,7 @@
OP * old_eval_root;
SV * cur_text;
CV * cv;
+ OP * retop; /* op to execute on exit from eval */
};
#define PUSHEVAL(cx,n,fgv) \
@@ -210,6 +223,7 @@
cx->blk_eval.old_eval_root = PL_eval_root; \
cx->blk_eval.cur_text = PL_linestr; \
cx->blk_eval.cv = Nullcv; /* set by doeval(), as applicable */ \
+ cx->blk_eval.retop = Nullop; \
} STMT_END
#define POPEVAL(cx) \
@@ -289,7 +303,6 @@
struct block {
I32 blku_oldsp; /* stack pointer to copy stuff down to */
COP * blku_oldcop; /* old curcop pointer */
- I32 blku_oldretsp; /* return stack index */
I32 blku_oldmarksp; /* mark stack index */
I32 blku_oldscopesp; /* scope stack index */
PMOP * blku_oldpm; /* values of pattern match vars */
@@ -303,7 +316,6 @@
};
#define blk_oldsp cx_u.cx_blk.blku_oldsp
#define blk_oldcop cx_u.cx_blk.blku_oldcop
-#define blk_oldretsp cx_u.cx_blk.blku_oldretsp
#define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp
#define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp
#define blk_oldpm cx_u.cx_blk.blku_oldpm
@@ -319,7 +331,6 @@
cx->blk_oldcop = PL_curcop, \
cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \
cx->blk_oldscopesp = PL_scopestack_ix, \
- cx->blk_oldretsp = PL_retstack_ix, \
cx->blk_oldpm = PL_curpm, \
cx->blk_gimme = (U8)gimme; \
DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \
@@ -331,7 +342,6 @@
PL_curcop = cx->blk_oldcop, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
- PL_retstack_ix = cx->blk_oldretsp, \
pm = cx->blk_oldpm, \
gimme = cx->blk_gimme; \
DEBUG_SCOPE("POPBLOCK"); \
@@ -343,7 +353,6 @@
PL_stack_sp = PL_stack_base + cx->blk_oldsp, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
- PL_retstack_ix = cx->blk_oldretsp, \
PL_curpm = cx->blk_oldpm; \
DEBUG_SCOPE("TOPBLOCK");
@@ -572,3 +581,7 @@
POPSTACK; \
} \
} STMT_END
+
+#define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
+#define IN_PERL_RUNTIME (PL_curcop != &PL_compiling)
+
1.6 +5 -3 ponie/perl/dump.c
Index: dump.c
===================================================================
RCS file: /cvs/public/ponie/perl/dump.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- dump.c 4 Apr 2005 17:46:11 -0000 1.5
+++ dump.c 19 Apr 2005 19:04:13 -0000 1.6
@@ -229,7 +229,7 @@
if (SvROK(sv)) {
sv_catpv(t, "\\");
if (SvCUR(t) + unref > 10) {
- SvCUR(t) = unref + 3;
+ SvCUR_set(t, unref + 3);
*SvEND(t) = '\0';
sv_catpv(t, "...");
goto finish;
@@ -1198,8 +1198,10 @@
if ((type != SVt_PVHV) && SvUTF8(sv))
sv_catpv(d, "UTF8");
- if (*(SvEND(d) - 1) == ',')
- SvPVX(d)[--SvCUR(d)] = '\0';
+ if (*(SvEND(d) - 1) == ',') {
+ SvCUR_set(d, SvCUR(d) - 1);
+ SvPVX(d)[SvCUR(d)] = '\0';
+ }
sv_catpv(d, ")");
s = SvPVX(d);
1.8 +6 -6 ponie/perl/gv.c
Index: gv.c
===================================================================
RCS file: /cvs/public/ponie/perl/gv.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- gv.c 4 Apr 2005 17:46:11 -0000 1.7
+++ gv.c 19 Apr 2005 19:04:13 -0000 1.8
@@ -153,8 +153,8 @@
sv_upgrade((SV*)gv, SVt_PVGV);
if (SvLEN(gv)) {
if (proto) {
- SvPVX(gv) = NULL;
- SvLEN(gv) = 0;
+ SvPV_set(gv, NULL);
+ SvLEN_set(gv, 0);
SvPOK_off(gv);
} else
Safefree(SvPVX(gv));
@@ -564,8 +564,8 @@
* pass along the same data via some unused fields in the CV
*/
CvSTASH(cv) = stash;
- SvPVX(cv) = (char *)name; /* cast to lose constness warning */
- SvCUR(cv) = len;
+ SvPV_set(cv, (char *)name); /* cast to lose constness warning */
+ SvCUR_set(cv, len);
return gv;
}
@@ -1229,7 +1229,7 @@
/* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
- SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
+ SvSTASH_set(io, (HV*)SvREFCNT_inc(GvHV(iogv)));
return io;
}
@@ -1611,7 +1611,7 @@
*/
SV* newref = newSVsv(tmpRef);
SvOBJECT_on(newref);
- SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(tmpRef));
+ SvSTASH_set(newref, (HV*)SvREFCNT_inc(SvSTASH(tmpRef)));
return newref;
}
}
1.2 +77 -11 ponie/perl/handy.h
Index: handy.h
===================================================================
RCS file: /cvs/public/ponie/perl/handy.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- handy.h 9 Sep 2003 11:58:49 -0000 1.1
+++ handy.h 19 Apr 2005 19:04:13 -0000 1.2
@@ -1,7 +1,7 @@
/* handy.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999,
- * 2000, 2001, 2002, by Larry Wall and others
+ * 2000, 2001, 2002, 2004, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
@@ -159,6 +159,11 @@
# endif
#endif
+/* HMB H.Merijn Brand - a placeholder for preparing Configure patches */
+#if defined(USE_SITECUSTOMIZE) || defined(LIBM_VERSION_TYPE)
+/* Not (yet) used at top level, but mention them for metaconfig */
+#endif
+
/* Mention I8SIZE, U8SIZE, I16SIZE, U16SIZE, I32SIZE, U32SIZE,
I64SIZE, and U64SIZE here so that metaconfig pulls them in. */
@@ -357,7 +362,7 @@
# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
# define isPRINT(c) (((c) > 32 && (c) < 127) || (c) == ' ')
# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
-# define isXDIGIT(c) (isdigit(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
+# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
# define toUPPER(c) (isLOWER(c) ? (c) - ('a' - 'A') : (c))
# define toLOWER(c) (isUPPER(c) ? (c) + ('a' - 'A') : (c))
#endif
@@ -559,16 +564,30 @@
source, C<dest> is the destination, C<nitems> is the number of items, and C<type> is
the type. Can do overlapping moves. See also C<Copy>.
+=for apidoc Am|void *|MoveD|void* src|void* dest|int nitems|type
+Like C<Move> but returns dest. Useful for encouraging compilers to tail-call
+optimise.
+
=for apidoc Am|void|Copy|void* src|void* dest|int nitems|type
The XSUB-writer's interface to the C C<memcpy> function. The C<src> is the
source, C<dest> is the destination, C<nitems> is the number of items, and C<type> is
the type. May fail on overlapping copies. See also C<Move>.
+=for apidoc Am|void *|CopyD|void* src|void* dest|int nitems|type
+
+Like C<Copy> but returns dest. Useful for encouraging compilers to tail-call
+optimise.
+
=for apidoc Am|void|Zero|void* dest|int nitems|type
The XSUB-writer's interface to the C C<memzero> function. The C<dest> is the
destination, C<nitems> is the number of items, and C<type> is the type.
+=for apidoc Am|void *|ZeroD|void* dest|int nitems|type
+
+Like C<Zero> but returns dest. Useful for encouraging compilers to tail-call
+optimise.
+
=for apidoc Am|void|StructCopy|type src|type dest|type
This is an architecture-independent macro to copy one structure to another.
@@ -583,21 +602,49 @@
#define NEWSV(x,len) newSV(len)
-#define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
-#define Newc(x,v,n,t,c) (v = (c*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
-#define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))), \
+#ifdef PERL_MALLOC_WRAP
+#define MEM_WRAP_CHECK(n,t) \
+ (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(PL_memory_wrap),0):0)
+#define MEM_WRAP_CHECK_1(n,t,a) \
+ (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a),0):0)
+#define MEM_WRAP_CHECK_2(n,t,a,b) \
+ (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a,b),0):0)
+#define MEM_WRAP_CHECK_(n,t) MEM_WRAP_CHECK(n,t),
+
+#else
+
+#define MEM_WRAP_CHECK(n,t)
+#define MEM_WRAP_CHECK_1(n,t,a)
+#define MEM_WRAP_CHECK_2(n,t,a,b)
+#define MEM_WRAP_CHECK_(n,t)
+
+#endif
+
+
+#define New(x,v,n,t) (v = (MEM_WRAP_CHECK_(n,t) (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
+#define Newc(x,v,n,t,c) (v = (MEM_WRAP_CHECK_(n,t) (c*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
+#define Newz(x,v,n,t) (v = (MEM_WRAP_CHECK_(n,t) (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))), \
memzero((char*)(v), (n)*sizeof(t))
#define Renew(v,n,t) \
- (v = (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
+ (v = (MEM_WRAP_CHECK_(n,t) (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
#define Renewc(v,n,t,c) \
- (v = (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
+ (v = (MEM_WRAP_CHECK_(n,t) (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
#define Safefree(d) safefree((Malloc_t)(d))
-#define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t))
-#define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
-#define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t))
+#define Move(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define Copy(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define Zero(d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memzero((char*)(d), (n) * sizeof(t)))
+
+#define MoveD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define CopyD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#ifdef HAS_MEMSET
+#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)))
+#else
+/* Using bzero(), which returns void. */
+#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)),d)
+#endif
-#define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
+#define Poison(d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t)))
#else /* lint */
@@ -608,6 +655,9 @@
#define Move(s,d,n,t)
#define Copy(s,d,n,t)
#define Zero(d,n,t)
+#define MoveD(s,d,n,t) d
+#define CopyD(s,d,n,t) d
+#define ZeroD(d,n,t) d
#define Poison(d,n,t)
#define Safefree(d) (d) = (d)
@@ -633,3 +683,19 @@
# endif
#endif
+/* convenience debug macros */
+#ifdef USE_ITHREADS
+#define pTHX_FORMAT "Perl interpreter: 0x%p"
+#define pTHX__FORMAT ", Perl interpreter: 0x%p"
+#define pTHX_VALUE_ (unsigned long)my_perl,
+#define pTHX_VALUE (unsigned long)my_perl
+#define pTHX__VALUE_ ,(unsigned long)my_perl,
+#define pTHX__VALUE ,(unsigned long)my_perl
+#else
+#define pTHX_FORMAT
+#define pTHX__FORMAT
+#define pTHX_VALUE_
+#define pTHX_VALUE
+#define pTHX__VALUE_
+#define pTHX__VALUE
+#endif /* USE_ITHREADS */
1.2 +14 -7 ponie/perl/malloc.c
Index: malloc.c
===================================================================
RCS file: /cvs/public/ponie/perl/malloc.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- malloc.c 9 Sep 2003 11:58:50 -0000 1.1
+++ malloc.c 19 Apr 2005 19:04:13 -0000 1.2
@@ -6,6 +6,12 @@
* "'The Chamber of Records,' said Gimli. 'I guess that is where we now stand.'"
*/
+/* This file contains Perl's own implementation of the malloc library.
+ * It is used if Configure decides that, on your platform, Perl's
+ * version is better than the OS's, or if you give Configure the
+ * -Dusemymalloc command-line option.
+ */
+
/*
Here are some notes on configuring Perl's malloc. (For non-perl
usage see below.)
@@ -357,6 +363,7 @@
# define Free_t void
# endif
# define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
# define PerlEnv_getenv getenv
# define PerlIO_printf fprintf
# define PerlIO_stderr() stderr
@@ -1168,7 +1175,7 @@
}
SvPOK_off(sv);
- SvPVX(sv) = Nullch;
+ SvPV_set(sv, Nullch);
SvCUR(sv) = SvLEN(sv) = 0;
*size = malloced_size(pv) + M_OVERHEAD;
return pv - sizeof(union overhead);
@@ -1219,14 +1226,15 @@
MEM_SIZE rsize = (((size - 1)>>LOG_OF_MIN_ARENA) + 1)<<LOG_OF_MIN_ARENA;
if (size >= BIG_SIZE
- && (!emergency_buffer_last_req || (size < emergency_buffer_last_req))) {
+ && (!emergency_buffer_last_req ||
+ (size < (MEM_SIZE)emergency_buffer_last_req))) {
/* Give the possibility to recover, but avoid an infinite cycle. */
MALLOC_UNLOCK;
emergency_buffer_last_req = size;
emergency_sbrk_croak("Out of memory during \"large\" request for %"UVuf" bytes, total sbrk() is %"UVuf" bytes", (UV)size, (UV)(goodsbrk + sbrk_slack));
}
- if (emergency_buffer_size >= rsize) {
+ if ((MEM_SIZE)emergency_buffer_size >= rsize) {
char *old = emergency_buffer;
emergency_buffer_size -= rsize;
@@ -1666,9 +1674,9 @@
MEM_SIZE slack = 0;
if (sbrk_goodness > 0) {
- if (!last_sbrk_top && require < FIRST_SBRK)
+ if (!last_sbrk_top && require < (MEM_SIZE)FIRST_SBRK)
require = FIRST_SBRK;
- else if (require < MIN_SBRK) require = MIN_SBRK;
+ else if (require < (MEM_SIZE)MIN_SBRK) require = MIN_SBRK;
if (require < goodsbrk * MIN_SBRK_FRAC1000 / 1000)
require = goodsbrk * MIN_SBRK_FRAC1000 / 1000;
@@ -2311,8 +2319,7 @@
MEM_SIZE l = strlen(s);
char *s1 = (char *)Perl_malloc(l+1);
- Copy(s, s1, (MEM_SIZE)(l+1), char);
- return s1;
+ return CopyD(s, s1, (MEM_SIZE)(l+1), char);
}
#ifdef PERL_CORE
1.9 +4 -4 ponie/perl/mg.c
Index: mg.c
===================================================================
RCS file: /cvs/public/ponie/perl/mg.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- mg.c 4 Apr 2005 17:46:11 -0000 1.8
+++ mg.c 19 Apr 2005 19:04:13 -0000 1.9
@@ -417,7 +417,7 @@
SvREFCNT_dec(mg->mg_obj);
Safefree(mg);
}
- SvMAGIC(sv) = 0;
+ SvMAGIC_set(sv, NULL);
return 0;
}
@@ -777,11 +777,11 @@
MAGIC* mg = SvMAGIC(sv);
MAGIC* mgt;
PL_tainted = 1;
- SvMAGIC(sv) = mg->mg_moremagic;
+ SvMAGIC_set(sv, mg->mg_moremagic);
SvTAINT(sv);
if ((mgt = SvMAGIC(sv))) {
mg->mg_moremagic = mgt;
- SvMAGIC(sv) = mg;
+ SvMAGIC_set(sv, mg);
}
} else
SvTAINTED_off(sv);
@@ -1980,7 +1980,7 @@
if (!SvWEAKREF(svp[i]))
Perl_croak(aTHX_ "panic: magic_killbackrefs");
/* XXX Should we check that it hasn't changed? */
- SvRV(svp[i]) = 0;
+ SvRV_set(svp[i], 0);
SvOK_off(svp[i]);
SvWEAKREF_off(svp[i]);
svp[i] = Nullsv;
1.6 +4 -5 ponie/perl/op.c
Index: op.c
===================================================================
RCS file: /cvs/public/ponie/perl/op.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- op.c 12 Apr 2005 11:12:13 -0000 1.5
+++ op.c 19 Apr 2005 19:04:13 -0000 1.6
@@ -3294,7 +3294,7 @@
GV *gv = cGVOPx_gv(curop);
if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation)
break;
- SvCUR(gv) = PL_generation;
+ SvCUR_set(gv, PL_generation);
}
else if (curop->op_type == OP_PADSV ||
curop->op_type == OP_PADAV ||
@@ -3304,8 +3304,7 @@
if (PAD_COMPNAME_GEN(curop->op_targ)
== (STRLEN)PL_generation)
break;
- PAD_COMPNAME_GEN(curop->op_targ)
- = PL_generation;
+ PAD_COMPNAME_GEN_set(curop->op_targ, PL_generation);
}
else if (curop->op_type == OP_RV2CV)
@@ -3327,7 +3326,7 @@
#endif
if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation)
break;
- SvCUR(gv) = PL_generation;
+ SvCUR_set(gv, PL_generation);
}
}
else
@@ -5884,7 +5883,7 @@
if (*s == ':' && s[1] == ':') {
*s = '/';
Move(s+2, s+1, strlen(s+2)+1, char);
- --SvCUR(kid->op_sv);
+ SvCUR_set(kid->op_sv, SvCUR(kid->op_sv) - 1);
}
}
if (SvREADONLY(kid->op_sv)) {
1.6 +1 -1 ponie/perl/pad.c
Index: pad.c
===================================================================
RCS file: /cvs/public/ponie/perl/pad.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- pad.c 10 Apr 2005 04:17:49 -0000 1.5
+++ pad.c 19 Apr 2005 19:04:13 -0000 1.6
@@ -337,7 +337,7 @@
if (typestash) {
SvPADTYPED_on(namesv);
- SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) typestash);
+ SvSTASH_set(namesv, (HV*)SvREFCNT_inc((SV*) typestash));
}
if (ourstash) {
SvPADOUR_on(namesv);
1.2 +15 -3 ponie/perl/pad.h
Index: pad.h
===================================================================
RCS file: /cvs/public/ponie/perl/pad.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- pad.h 9 Sep 2003 11:58:51 -0000 1.1
+++ pad.h 19 Apr 2005 19:04:13 -0000 1.2
@@ -105,6 +105,9 @@
Set the current pad to be pad C<n> in the padlist, saving
the previous current pad.
+=for apidoc m|void|PAD_SET_CUR_NOSAVE |PADLIST padlist|I32 n
+like PAD_SET_CUR, but without the save
+
=for apidoc m|void|PAD_SAVE_SETNULLPAD
Save the current pad then set it to null.
@@ -133,8 +136,7 @@
? AvARRAY((AV*)(AvARRAY(padlist)[1]))[po] : Nullsv;
-#define PAD_SET_CUR(padlist,n) \
- SAVECOMPPAD(); \
+#define PAD_SET_CUR_NOSAVE(padlist,n) \
PL_comppad = (PAD*) (AvARRAY(padlist)[n]); \
PL_curpad = AvARRAY(PL_comppad); \
DEBUG_Xv(PerlIO_printf(Perl_debug_log, \
@@ -142,6 +144,11 @@
PTR2UV(PL_comppad), PTR2UV(PL_curpad), (int)(n)));
+#define PAD_SET_CUR(padlist,n) \
+ SAVECOMPPAD(); \
+ PAD_SET_CUR_NOSAVE(padlist,n);
+
+
#define PAD_SAVE_SETNULLPAD() SAVECOMPPAD(); \
PL_comppad = Null(PAD*); PL_curpad = Null(SV**); \
DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad set_null\n"));
@@ -198,7 +205,12 @@
The generation number of the name at offset C<po> in the current
compiling pad (lvalue). Note that C<SvCUR> is hijacked for this purpose.
+=for apidoc m|STRLEN|PAD_COMPNAME_GEN_set|PADOFFSET po|int gen
+Sets the generation number of the name at offset C<po> in the current
+ling pad (lvalue) to C<gen>. Note that C<SvCUR_set> is hijacked for this purpose.
+
=cut
+
*/
#define PAD_COMPNAME_FLAGS(po) SvFLAGS(*av_fetch(PL_comppad_name, (po), FALSE))
@@ -214,7 +226,7 @@
#define PAD_COMPNAME_GEN(po) SvCUR(AvARRAY(PL_comppad_name)[po])
-
+#define PAD_COMPNAME_GEN_set(po, gen) SvCUR_set(AvARRAY(PL_comppad_name)[po], gen)
/*
1.17 +1 -1 ponie/perl/perl.c
Index: perl.c
===================================================================
RCS file: /cvs/public/ponie/perl/perl.c,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- perl.c 11 Apr 2005 15:30:21 -0000 1.16
+++ perl.c 19 Apr 2005 19:04:13 -0000 1.17
@@ -4627,7 +4627,7 @@
SvFLAGS(PL_thrsv) = SVt_PV;
SvANY(PL_thrsv) = (void*)xpv;
SvREFCNT(PL_thrsv) = 1 << 30; /* practically infinite */
- SvPVX(PL_thrsv) = (char*)thr;
+ SvPV_set(PL_thrsvr, (char*)thr);
SvCUR_set(PL_thrsv, sizeof(thr));
SvLEN_set(PL_thrsv, sizeof(thr));
*SvEND(PL_thrsv) = '\0'; /* in the trailing_nul field */
1.12 +1 -1 ponie/perl/perl.h
Index: perl.h
===================================================================
RCS file: /cvs/public/ponie/perl/perl.h,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- perl.h 4 Apr 2005 17:46:12 -0000 1.11
+++ perl.h 19 Apr 2005 19:04:13 -0000 1.12
@@ -3621,7 +3621,7 @@
};
#define PERL_DEBUG_PAD(i) (PL_debug_pad.pad[i])
-#define PERL_DEBUG_PAD_ZERO(i) (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, SvCUR(PERL_DEBUG_PAD(i)) = 0, PERL_DEBUG_PAD(i))
+#define PERL_DEBUG_PAD_ZERO(i) (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, SvCUR_set(PERL_DEBUG_PAD(i), 0), PERL_DEBUG_PAD(i))
/* Enable variables which are pointers to functions */
typedef void (CPERLscope(*peep_t))(pTHX_ OP* o);
1.6 +7 -6 ponie/perl/pp.c
Index: pp.c
===================================================================
RCS file: /cvs/public/ponie/perl/pp.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- pp.c 10 Apr 2005 04:17:49 -0000 1.5
+++ pp.c 19 Apr 2005 19:04:13 -0000 1.6
@@ -178,9 +178,10 @@
SvOOK_off(sv); /* backoff */
if (SvLEN(sv))
Safefree(SvPVX(sv));
- SvLEN(sv)=SvCUR(sv)=0;
+ SvLEN_set(sv, 0);
+ SvCUR_set(sv, 0);
}
- SvRV(sv) = (SV*)gv;
+ SvRV_set(sv, (SV*)gv);
SvROK_on(sv);
SvSETMAGIC(sv);
goto wasref;
@@ -493,7 +494,7 @@
}
rv = sv_newmortal();
sv_upgrade(rv, SVt_RV);
- SvRV(rv) = sv;
+ SvRV_set(rv, sv);
SvROK_on(rv);
return rv;
}
@@ -1500,7 +1501,7 @@
MEM_WRAP_CHECK_1(max, char, oom_string_extend);
SvGROW(TARG, (count * len) + 1);
repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
- SvCUR(TARG) *= count;
+ SvCUR_set(TARG, SvCUR(TARG) * count);
}
*SvEND(TARG) = '\0';
}
@@ -4264,7 +4265,7 @@
*dst-- = *src--;
}
dst = AvARRAY(ary);
- SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
+ SvPV_set(ary, (char*)(AvARRAY(ary) - diff)); /* diff is negative */
AvMAX(ary) += diff;
}
else {
@@ -4301,7 +4302,7 @@
dst = src - diff;
Move(src, dst, offset, SV*);
}
- SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
+ SvPV_set(ary, (char*)(AvARRAY(ary) - diff));/* diff is positive */
AvMAX(ary) += diff;
AvFILLp(ary) += diff;
}
1.2 +119 -28 ponie/perl/pp.h
Index: pp.h
===================================================================
RCS file: /cvs/public/ponie/perl/pp.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- pp.h 9 Sep 2003 11:58:52 -0000 1.1
+++ pp.h 19 Apr 2005 19:04:13 -0000 1.2
@@ -1,7 +1,7 @@
/* pp.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999,
- * 2000, 2001, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
@@ -20,7 +20,7 @@
=for apidoc AmU||MARK
Stack marker variable for the XSUB. See C<dMARK>.
-=for apidoc Ams||PUSHMARK
+=for apidoc Am|void|PUSHMARK|SP
Opening bracket for arguments on a callback. See C<PUTBACK> and
L<perlcall>.
@@ -55,9 +55,12 @@
#define MARK mark
#define TARG targ
-#define PUSHMARK(p) if (++PL_markstack_ptr == PL_markstack_max) \
- markstack_grow(); \
- *PL_markstack_ptr = (p) - PL_stack_base
+#define PUSHMARK(p) \
+ STMT_START { \
+ if (++PL_markstack_ptr == PL_markstack_max) \
+ markstack_grow(); \
+ *PL_markstack_ptr = (p) - PL_stack_base; \
+ } STMT_END
#define TOPMARK (*PL_markstack_ptr)
#define POPMARK (*PL_markstack_ptr--)
@@ -70,7 +73,7 @@
#define ORIGMARK (PL_stack_base + origmark)
#define SPAGAIN sp = PL_stack_sp
-#define MSPAGAIN sp = PL_stack_sp; mark = ORIGMARK
+#define MSPAGAIN STMT_START { sp = PL_stack_sp; mark = ORIGMARK; } STMT_END
#define GETTARGETSTACKED targ = (PL_op->op_flags & OPf_STACKED ? POPs : PAD_SV(PL_op->op_targ))
#define dTARGETSTACKED SV * GETTARGETSTACKED
@@ -85,6 +88,7 @@
#define NORMAL PL_op->op_next
#define DIE return Perl_die
+#define DIE_NULL return DieNull
/*
=for apidoc Ams||PUTBACK
@@ -162,45 +166,117 @@
=for apidoc Am|void|PUSHs|SV* sv
Push an SV onto the stack. The stack must have room for this element.
-Does not handle 'set' magic. See C<XPUSHs>.
+Does not handle 'set' magic. Does not use C<TARG>. See also C<PUSHmortal>,
+C<XPUSHs> and C<XPUSHmortal>.
=for apidoc Am|void|PUSHp|char* str|STRLEN len
Push a string onto the stack. The stack must have room for this element.
-The C<len> indicates the length of the string. Handles 'set' magic. See
-C<XPUSHp>.
+The C<len> indicates the length of the string. Handles 'set' magic. Uses
+C<TARG>, so C<dTARGET> or C<dXSTARG> should be called to declare it. Do not
+call multiple C<TARG>-oriented macros to return lists from XSUB's - see
+C<mPUSHp> instead. See also C<XPUSHp> and C<mXPUSHp>.
=for apidoc Am|void|PUSHn|NV nv
Push a double onto the stack. The stack must have room for this element.
-Handles 'set' magic. See C<XPUSHn>.
+Handles 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be
+called to declare it. Do not call multiple C<TARG>-oriented macros to
+return lists from XSUB's - see C<mPUSHn> instead. See also C<XPUSHn> and
+C<mXPUSHn>.
=for apidoc Am|void|PUSHi|IV iv
Push an integer onto the stack. The stack must have room for this element.
-Handles 'set' magic. See C<XPUSHi>.
+Handles 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be
+called to declare it. Do not call multiple C<TARG>-oriented macros to
+return lists from XSUB's - see C<mPUSHi> instead. See also C<XPUSHi> and
+C<mXPUSHi>.
=for apidoc Am|void|PUSHu|UV uv
Push an unsigned integer onto the stack. The stack must have room for this
-element. See C<XPUSHu>.
+element. Handles 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG>
+should be called to declare it. Do not call multiple C<TARG>-oriented
+macros to return lists from XSUB's - see C<mPUSHu> instead. See also
+C<XPUSHu> and C<mXPUSHu>.
=for apidoc Am|void|XPUSHs|SV* sv
Push an SV onto the stack, extending the stack if necessary. Does not
-handle 'set' magic. See C<PUSHs>.
+handle 'set' magic. Does not use C<TARG>. See also C<XPUSHmortal>,
+C<PUSHs> and C<PUSHmortal>.
=for apidoc Am|void|XPUSHp|char* str|STRLEN len
Push a string onto the stack, extending the stack if necessary. The C<len>
-indicates the length of the string. Handles 'set' magic. See
-C<PUSHp>.
+indicates the length of the string. Handles 'set' magic. Uses C<TARG>, so
+C<dTARGET> or C<dXSTARG> should be called to declare it. Do not call
+multiple C<TARG>-oriented macros to return lists from XSUB's - see
+C<mXPUSHp> instead. See also C<PUSHp> and C<mPUSHp>.
=for apidoc Am|void|XPUSHn|NV nv
Push a double onto the stack, extending the stack if necessary. Handles
-'set' magic. See C<PUSHn>.
+'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be called to
+declare it. Do not call multiple C<TARG>-oriented macros to return lists
+from XSUB's - see C<mXPUSHn> instead. See also C<PUSHn> and C<mPUSHn>.
=for apidoc Am|void|XPUSHi|IV iv
Push an integer onto the stack, extending the stack if necessary. Handles
-'set' magic. See C<PUSHi>.
+'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be called to
+declare it. Do not call multiple C<TARG>-oriented macros to return lists
+from XSUB's - see C<mXPUSHi> instead. See also C<PUSHi> and C<mPUSHi>.
=for apidoc Am|void|XPUSHu|UV uv
Push an unsigned integer onto the stack, extending the stack if necessary.
-See C<PUSHu>.
+Handles 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be
+called to declare it. Do not call multiple C<TARG>-oriented macros to
+return lists from XSUB's - see C<mXPUSHu> instead. See also C<PUSHu> and
+C<mPUSHu>.
+
+=for apidoc Am|void|PUSHmortal
+Push a new mortal SV onto the stack. The stack must have room for this
+element. Does not handle 'set' magic. Does not use C<TARG>. See also
+C<PUSHs>, C<XPUSHmortal> and C<XPUSHs>.
+
+=for apidoc Am|void|mPUSHp|char* str|STRLEN len
+Push a string onto the stack. The stack must have room for this element.
+The C<len> indicates the length of the string. Handles 'set' magic. Does
+not use C<TARG>. See also C<PUSHp>, C<mXPUSHp> and C<XPUSHp>.
+
+=for apidoc Am|void|mPUSHn|NV nv
+Push a double onto the stack. The stack must have room for this element.
+Handles 'set' magic. Does not use C<TARG>. See also C<PUSHn>, C<mXPUSHn>
+and C<XPUSHn>.
+
+=for apidoc Am|void|mPUSHi|IV iv
+Push an integer onto the stack. The stack must have room for this element.
+Handles 'set' magic. Does not use C<TARG>. See also C<PUSHi>, C<mXPUSHi>
+and C<XPUSHi>.
+
+=for apidoc Am|void|mPUSHu|UV uv
+Push an unsigned integer onto the stack. The stack must have room for this
+element. Handles 'set' magic. Does not use C<TARG>. See also C<PUSHu>,
+C<mXPUSHu> and C<XPUSHu>.
+
+=for apidoc Am|void|XPUSHmortal
+Push a new mortal SV onto the stack, extending the stack if necessary. Does
+not handle 'set' magic. Does not use C<TARG>. See also C<XPUSHs>,
+C<PUSHmortal> and C<PUSHs>.
+
+=for apidoc Am|void|mXPUSHp|char* str|STRLEN len
+Push a string onto the stack, extending the stack if necessary. The C<len>
+indicates the length of the string. Handles 'set' magic. Does not use
+C<TARG>. See also C<XPUSHp>, C<mPUSHp> and C<PUSHp>.
+
+=for apidoc Am|void|mXPUSHn|NV nv
+Push a double onto the stack, extending the stack if necessary. Handles
+'set' magic. Does not use C<TARG>. See also C<XPUSHn>, C<mPUSHn> and
+C<PUSHn>.
+
+=for apidoc Am|void|mXPUSHi|IV iv
+Push an integer onto the stack, extending the stack if necessary. Handles
+'set' magic. Does not use C<TARG>. See also C<XPUSHi>, C<mPUSHi> and
+C<PUSHi>.
+
+=for apidoc Am|void|mXPUSHu|UV uv
+Push an unsigned integer onto the stack, extending the stack if necessary.
+Handles 'set' magic. Does not use C<TARG>. See also C<XPUSHu>, C<mPUSHu>
+and C<PUSHu>.
=cut
*/
@@ -231,6 +307,18 @@
#define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
#define XPUSHundef STMT_START { SvOK_off(TARG); XPUSHs(TARG); } STMT_END
+#define PUSHmortal PUSHs(sv_newmortal())
+#define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l))
+#define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
+#define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
+#define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
+
+#define XPUSHmortal XPUSHs(sv_newmortal())
+#define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END
+#define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END
+#define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END
+#define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END
+
#define SETs(s) (*sp = s)
#define SETTARG STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END
#define SETp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END
@@ -353,17 +441,20 @@
#define tryAMAGICun(meth) tryAMAGICunW(meth,SETsvUN,0,RETURN)
#define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs,0,RETURN)
#define tryAMAGICunTARGET(meth, shift) \
- { dSP; sp--; /* get TARGET from below PL_stack_sp */ \
+ STMT_START { dSP; sp--; /* get TARGET from below PL_stack_sp */ \
{ dTARGETSTACKED; \
- { dSP; tryAMAGICunW(meth,FORCE_SETs,shift,RETURN);}}}
+ { dSP; tryAMAGICunW(meth,FORCE_SETs,shift,RETURN);}}} STMT_END
-#define setAGAIN(ref) sv = ref; \
- if (!SvROK(ref)) \
- Perl_croak(aTHX_ "Overloaded dereference did not return a reference"); \
- if (ref != arg && SvRV(ref) != SvRV(arg)) { \
- arg = ref; \
- goto am_again; \
- }
+#define setAGAIN(ref) \
+ STMT_START { \
+ sv = ref; \
+ if (!SvROK(ref)) \
+ Perl_croak(aTHX_ "Overloaded dereference did not return a reference"); \
+ if (ref != arg && SvRV(ref) != SvRV(arg)) { \
+ arg = ref; \
+ goto am_again; \
+ } \
+ } STMT_END
#define tryAMAGICunDEREF(meth) tryAMAGICunW(meth,setAGAIN,0,(void)0)
@@ -385,8 +476,8 @@
changed SV* ref to SV* tmpRef */
#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); \
if (SvREFCNT(tmpRef)>1) { \
+ SvRV_set(rv, AMG_CALLun(rv,copy)); \
SvREFCNT_dec(tmpRef); \
- SvRV(rv)=AMG_CALLun(rv,copy); \
} } STMT_END
/*
1.7 +4 -4 ponie/perl/pp_ctl.c
Index: pp_ctl.c
===================================================================
RCS file: /cvs/public/ponie/perl/pp_ctl.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- pp_ctl.c 11 Apr 2005 16:31:19 -0000 1.6
+++ pp_ctl.c 19 Apr 2005 19:04:13 -0000 1.7
@@ -244,12 +244,12 @@
if (SvLEN(targ))
Safefree(SvPVX(targ));
}
- SvPVX(targ) = SvPVX(dstr);
+ SvPV_set(targ, SvPVX(dstr));
SvCUR_set(targ, SvCUR(dstr));
SvLEN_set(targ, SvLEN(dstr));
if (DO_UTF8(dstr))
SvUTF8_on(targ);
- SvPVX(dstr) = 0;
+ SvPV_set(dstr, (char*)0);
sv_free(dstr);
TAINT_IF(cx->sb_rxtainted & 1);
@@ -2393,13 +2393,13 @@
ary = AvALLOC(av);
if (AvARRAY(av) != ary) {
AvMAX(av) += AvARRAY(av) - AvALLOC(av);
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
}
if (items >= AvMAX(av) + 1) {
AvMAX(av) = items - 1;
Renew(ary,items+1,SV*);
AvALLOC(av) = ary;
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
}
}
++mark;
1.12 +15 -16 ponie/perl/pp_hot.c
Index: pp_hot.c
===================================================================
RCS file: /cvs/public/ponie/perl/pp_hot.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- pp_hot.c 11 Apr 2005 16:31:19 -0000 1.11
+++ pp_hot.c 19 Apr 2005 19:04:13 -0000 1.12
@@ -1612,7 +1612,7 @@
tmps = SvEND(sv) - 1;
if (*tmps == *SvPVX(PL_rs)) {
*tmps = '\0';
- SvCUR(sv)--;
+ SvCUR_set(sv, SvCUR(sv) - 1);
}
}
for (tmps = SvPVX(sv); *tmps; tmps++)
@@ -1637,19 +1637,16 @@
}
if (gimme == G_ARRAY) {
if (SvLEN(sv) - SvCUR(sv) > 20) {
- SvLEN_set(sv, SvCUR(sv)+1);
- Renew(SvPVX(sv), SvLEN(sv), char);
+ SvPV_shrink_to_cur(sv);
}
sv = sv_2mortal(NEWSV(58, 80));
continue;
}
else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
/* try to reclaim a bit of scalar space (only on 1st alloc) */
- if (SvCUR(sv) < 60)
- SvLEN_set(sv, 80);
- else
- SvLEN_set(sv, SvCUR(sv)+40); /* allow some slop */
- Renew(SvPVX(sv), SvLEN(sv), char);
+ const STRLEN new_len
+ = SvCUR(sv) < 60 ? 80 : SvCUR(sv)+40; /* allow some slop */
+ SvPV_renew(sv, new_len);
}
RETURN;
}
@@ -2270,11 +2267,11 @@
if (SvLEN(TARG))
Safefree(SvPVX(TARG));
}
- SvPVX(TARG) = SvPVX(dstr);
+ SvPV_set(TARG, SvPVX(dstr));
SvCUR_set(TARG, SvCUR(dstr));
SvLEN_set(TARG, SvLEN(dstr));
doutf8 |= DO_UTF8(dstr);
- SvPVX(dstr) = 0;
+ SvPV_set(dstr, (char*)0);
sv_free(dstr);
TAINT_IF(rxtainted & 1);
@@ -2736,13 +2733,13 @@
ary = AvALLOC(av);
if (AvARRAY(av) != ary) {
AvMAX(av) += AvARRAY(av) - AvALLOC(av);
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
}
if (items > AvMAX(av) + 1) {
AvMAX(av) = items - 1;
Renew(ary,items,SV*);
AvALLOC(av) = ary;
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
}
}
Copy(MARK,AvARRAY(av),items,SV*);
@@ -2951,18 +2948,20 @@
else if (SvTYPE(sv) >= SVt_PV) {
SvOOK_off(sv);
Safefree(SvPVX(sv));
- SvPVX(sv) = 0;
+ SvPV_set(sv, 0);
+ SvLEN_set(sv, 0);
+ SvCUR_set(sv, 0);
SvLEN(sv) = SvCUR(sv) = 0;
}
switch (to_what) {
case OPpDEREF_SV:
- SvRV(sv) = NEWSV(355,0);
+ SvRV_set(sv, NEWSV(355,0));
break;
case OPpDEREF_AV:
- SvRV(sv) = (SV*)newAV();
+ SvRV_set(sv, (SV*)newAV());
break;
case OPpDEREF_HV:
- SvRV(sv) = (SV*)newHV();
+ SvRV_set(sv, (SV*)newHV());
break;
}
SvROK_on(sv);
1.3 +13 -13 ponie/perl/pp_pack.c
Index: pp_pack.c
===================================================================
RCS file: /cvs/public/ponie/perl/pp_pack.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- pp_pack.c 4 Apr 2005 17:46:12 -0000 1.2
+++ pp_pack.c 19 Apr 2005 19:04:13 -0000 1.3
@@ -704,7 +704,7 @@
if (utf8) gl *= UTF8_EXPAND; \
if ((cur) + gl >= (start) + SvLEN(cat)) { \
*cur = '\0'; \
- SvCUR(cat) = (cur) - (start); \
+ SvCUR_set((cat), (cur) - (start)); \
(start) = sv_exp_grow(aTHX_ cat, gl); \
(cur) = (start) + SvCUR(cat); \
} \
@@ -2440,7 +2440,7 @@
if (SvOOK(sv)) {
if (SvIVX(sv)) {
- SvLEN(sv) += SvIVX(sv);
+ SvLEN_set(sv, SvLEN(sv) + SvIVX(sv));
from_start -= SvIVX(sv);
SvIV_set(sv, 0);
}
@@ -2448,9 +2448,9 @@
}
if (SvLEN(sv) != 0)
Safefree(from_start);
- SvPVX(sv) = to_start;
- SvCUR(sv) = to_ptr - to_start;
- SvLEN(sv) = len;
+ SvPV_set(sv, to_start);
+ SvCUR_set(sv, to_ptr - to_start);
+ SvLEN_set(sv, len);
SvUTF8_on(sv);
}
@@ -2976,7 +2976,7 @@
W_utf8:
if (cur > end) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
GROWING(0, cat, start, cur, len+UTF8_MAXLEN);
end = start+SvLEN(cat)-UTF8_MAXLEN;
@@ -2989,7 +2989,7 @@
if (auv >= 0x100) {
if (!SvUTF8(cat)) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
marked_upgrade(aTHX_ cat, symptr);
lookahead.flags |= FLAG_DO_UTF8;
lookahead.strbeg = symptr->strbeg;
@@ -3006,7 +3006,7 @@
}
if (cur >= end) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
GROWING(0, cat, start, cur, len+1);
end = start+SvLEN(cat)-1;
}
@@ -3041,7 +3041,7 @@
0 : UNICODE_ALLOW_ANY);
if (cur+(endb-buffer)*UTF8_EXPAND >= end) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
GROWING(0, cat, start, cur,
len+(endb-buffer)*UTF8_EXPAND);
end = start+SvLEN(cat);
@@ -3050,7 +3050,7 @@
} else {
if (cur >= end) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
GROWING(0, cat, start, cur, len+UTF8_MAXLEN);
end = start+SvLEN(cat)-UTF8_MAXLEN;
}
@@ -3283,7 +3283,7 @@
if (anv < 0) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
Perl_croak(aTHX_ "Cannot compress negative numbers in pack");
}
@@ -3529,7 +3529,7 @@
if (!uni_to_bytes(aTHX_ &aptr, aend, buffer, todo,
'u' | TYPE_IS_PACK)) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
Perl_croak(aTHX_ "Assertion: string is shorter than advertised");
}
end = doencodes(hunk, buffer, todo);
@@ -3544,7 +3544,7 @@
}
}
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
no_change:
*symptr = lookahead;
}
1.2 +191 -46 ponie/perl/pp_sort.c
Index: pp_sort.c
===================================================================
RCS file: /cvs/public/ponie/perl/pp_sort.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- pp_sort.c 9 Sep 2003 11:58:53 -0000 1.1
+++ pp_sort.c 19 Apr 2005 19:04:13 -0000 1.2
@@ -1,7 +1,7 @@
/* pp_sort.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
@@ -13,6 +13,17 @@
* rear!' the slave-driver shouted. 'Three files up. And stay there...
*/
+/* This file contains pp ("push/pop") functions that
+ * execute the opcodes that make up a perl program. A typical pp function
+ * expects to find its arguments on the stack, and usually pushes its
+ * results onto the stack, hence the 'pp' terminology. Each OP structure
+ * contains a pointer to the relevant pp_foo() function.
+ *
+ * This particular file just contains pp_sort(), which is complex
+ * enough to merit its own file! See the other pp*.c files for the rest of
+ * the pp_ functions.
+ */
+
#include "EXTERN.h"
#define PERL_IN_PP_SORT_C
#include "perl.h"
@@ -335,8 +346,15 @@
IV runs; /* how many runs must be combined into 1 */
} off_runs; /* pseudo-stack element */
+
+static I32
+cmp_desc(pTHX_ gptr a, gptr b)
+{
+ return -PL_sort_RealCmp(aTHX_ a, b);
+}
+
STATIC void
-S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp)
+S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
{
IV i, run, runs, offset;
I32 sense, level;
@@ -347,8 +365,16 @@
gptr small[SMALLSORT];
gptr *which[3];
off_runs stack[60], *stackp;
+ SVCOMPARE_t savecmp = 0;
if (nmemb <= 1) return; /* sorted trivially */
+
+ if (flags) {
+ savecmp = PL_sort_RealCmp; /* Save current comparison routine, if any */
+ PL_sort_RealCmp = cmp; /* Put comparison routine where cmp_desc can find it */
+ cmp = cmp_desc;
+ }
+
if (nmemb <= SMALLSORT) aux = small; /* use stack for aux array */
else { New(799,aux,nmemb,gptr); } /* allocate auxilliary array */
level = 0;
@@ -531,6 +557,9 @@
}
done:
if (aux != small) Safefree(aux); /* free iff allocated */
+ if (flags) {
+ PL_sort_RealCmp = savecmp; /* Restore current comparison routine, if any */
+ }
return;
}
@@ -1300,8 +1329,23 @@
return sense;
}
+static I32
+cmpindir_desc(pTHX_ gptr a, gptr b)
+{
+ I32 sense;
+ gptr *ap = (gptr *)a;
+ gptr *bp = (gptr *)b;
+
+ /* Reverse the default */
+ if ((sense = PL_sort_RealCmp(aTHX_ *ap, *bp)))
+ return -sense;
+ /* But don't reverse the stability test. */
+ return (ap > bp) ? 1 : ((ap < bp) ? -1 : 0);
+
+}
+
STATIC void
-S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp)
+S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
{
SV *hintsv;
@@ -1323,7 +1367,8 @@
PL_sort_RealCmp = cmp; /* Put comparison routine where cmpindir can find it */
/* sort, with indirection */
- S_qsortsvu(aTHX_ (gptr *)indir, nmemb, cmpindir);
+ S_qsortsvu(aTHX_ (gptr *)indir, nmemb,
+ flags ? cmpindir_desc : cmpindir);
pp = indir;
q = list1;
@@ -1366,6 +1411,13 @@
if (indir != small) { Safefree(indir); }
/* restore prevailing comparison routine */
PL_sort_RealCmp = savecmp;
+ } else if (flags) {
+ SVCOMPARE_t savecmp = PL_sort_RealCmp; /* Save current comparison routine, if any */
+ PL_sort_RealCmp = cmp; /* Put comparison routine where cmp_desc can find it */
+ cmp = cmp_desc;
+ S_qsortsvu(aTHX_ list1, nmemb, cmp);
+ /* restore prevailing comparison routine */
+ PL_sort_RealCmp = savecmp;
} else {
S_qsortsvu(aTHX_ list1, nmemb, cmp);
}
@@ -1388,8 +1440,34 @@
void
Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
{
- void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp) =
- S_mergesortsv;
+ void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
+ = S_mergesortsv;
+ SV *hintsv;
+ I32 hints;
+
+ /* Sun's Compiler (cc: WorkShop Compilers 4.2 30 Oct 1996 C 4.2) used
+ to miscompile this function under optimization -O. If you get test
+ errors related to picking the correct sort() function, try recompiling
+ this file without optimiziation. -- A.D. 4/2002.
+ */
+ hints = SORTHINTS(hintsv);
+ if (hints & HINT_SORT_QUICKSORT) {
+ sortsvp = S_qsortsv;
+ }
+ else {
+ /* The default as of 5.8.0 is mergesort */
+ sortsvp = S_mergesortsv;
+ }
+
+ sortsvp(aTHX_ array, nmemb, cmp, 0);
+}
+
+
+void
+S_sortsv_desc(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
+{
+ void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
+ = S_mergesortsv;
SV *hintsv;
I32 hints;
@@ -1407,15 +1485,15 @@
sortsvp = S_mergesortsv;
}
- sortsvp(aTHX_ array, nmemb, cmp);
+ sortsvp(aTHX_ array, nmemb, cmp, 1);
}
PP(pp_sort)
{
dSP; dMARK; dORIGMARK;
- register SV **up;
- SV **myorigmark = ORIGMARK;
- register I32 max;
+ register SV **p1 = ORIGMARK+1, **p2;
+ register I32 max, i;
+ AV* av = Nullav;
HV *stash;
GV *gv;
CV *cv = 0;
@@ -1424,6 +1502,11 @@
I32 overloading = 0;
bool hasargs = FALSE;
I32 is_xsub = 0;
+ I32 sorting_av = 0;
+ U8 private = PL_op->op_private;
+ U8 flags = PL_op->op_flags;
+ void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
+ = Perl_sortsv;
if (gimme != G_ARRAY) {
SP = MARK;
@@ -1432,8 +1515,8 @@
ENTER;
SAVEVPTR(PL_sortcop);
- if (PL_op->op_flags & OPf_STACKED) {
- if (PL_op->op_flags & OPf_SPECIAL) {
+ if (flags & OPf_STACKED) {
+ if (flags & OPf_SPECIAL) {
OP *kid = cLISTOP->op_first->op_sibling; /* pass pushmark */
kid = kUNOP->op_first; /* pass rv2gv */
kid = kUNOP->op_first; /* pass leave */
@@ -1480,24 +1563,59 @@
stash = CopSTASH(PL_curcop);
}
- up = myorigmark + 1;
- while (MARK < SP) { /* This may or may not shift down one here. */
- /*SUPPRESS 560*/
- if ((*up = *++MARK)) { /* Weed out nulls. */
- SvTEMP_off(*up);
- if (!PL_sortcop && !SvPOK(*up)) {
+ /* optimiser converts "@a = sort @a" to "sort \@a";
+ * in case of tied @a, pessimise: push (@a) onto stack, then assign
+ * result back to @a at the end of this function */
+ if (private & OPpSORT_INPLACE) {
+ assert( MARK+1 == SP && *SP && SvTYPE(*SP) == SVt_PVAV);
+ (void)POPMARK; /* remove mark associated with ex-OP_AASSIGN */
+ av = (AV*)(*SP);
+ max = AvFILL(av) + 1;
+ if (SvMAGICAL(av)) {
+ MEXTEND(SP, max);
+ p2 = SP;
+ for (i=0; i < max; i++) {
+ SV **svp = av_fetch(av, i, FALSE);
+ *SP++ = (svp) ? *svp : Nullsv;
+ }
+ }
+ else {
+ p1 = p2 = AvARRAY(av);
+ sorting_av = 1;
+ }
+ }
+ else {
+ p2 = MARK+1;
+ max = SP - MARK;
+ }
+
+ if (private & OPpSORT_DESCEND) {
+ sortsvp = S_sortsv_desc;
+ }
+
+ /* shuffle stack down, removing optional initial cv (p1!=p2), plus any
+ * nulls; also stringify any args */
+ for (i=max; i > 0 ; i--) {
+ if ((*p1 = *p2++)) { /* Weed out nulls. */
+ SvTEMP_off(*p1);
+ if (!PL_sortcop && !SvPOK(*p1)) {
STRLEN n_a;
- if (SvAMAGIC(*up))
+ if (SvAMAGIC(*p1))
overloading = 1;
else
- (void)sv_2pv(*up, &n_a);
+ (void)sv_2pv(*p1, &n_a);
}
- up++;
+ p1++;
}
+ else
+ max--;
}
- max = --up - myorigmark;
- if (PL_sortcop) {
- if (max > 1) {
+ if (sorting_av)
+ AvFILLp(av) = max-1;
+
+ if (max > 1) {
+ SV **start;
+ if (PL_sortcop) {
PERL_CONTEXT *cx;
SV** newsp;
bool oldcatch = CATCH_GET;
@@ -1520,12 +1638,10 @@
}
PUSHBLOCK(cx, CXt_NULL, PL_stack_base);
- if (!(PL_op->op_flags & OPf_SPECIAL)) {
+ if (!(flags & OPf_SPECIAL)) {
cx->cx_type = CXt_SUB;
cx->blk_gimme = G_SCALAR;
PUSHSUB(cx);
- if (!CvDEPTH(cv))
- (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */
}
PL_sortcxix = cxstack_ix;
@@ -1538,21 +1654,22 @@
CX_CURPAD_SAVE(cx->blk_sub);
cx->blk_sub.argarray = av;
}
- sortsv((myorigmark+1), max,
- is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
+
+ start = p1 - max;
+ sortsvp(aTHX_ start, max,
+ is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
POPBLOCK(cx,PL_curpm);
PL_stack_sp = newsp;
POPSTACK;
CATCH_SET(oldcatch);
}
- }
- else {
- if (max > 1) {
+ else {
MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */
- sortsv(ORIGMARK+1, max,
- (PL_op->op_private & OPpSORT_NUMERIC)
- ? ( (PL_op->op_private & OPpSORT_INTEGER)
+ start = sorting_av ? AvARRAY(av) : ORIGMARK+1;
+ sortsvp(aTHX_ start, max,
+ (private & OPpSORT_NUMERIC)
+ ? ( (private & OPpSORT_INTEGER)
? ( overloading ? amagic_i_ncmp : sv_i_ncmp)
: ( overloading ? amagic_ncmp : sv_ncmp))
: ( IN_LOCALE_RUNTIME
@@ -1560,19 +1677,37 @@
? amagic_cmp_locale
: sv_cmp_locale_static)
: ( overloading ? amagic_cmp : sv_cmp_static)));
- if (PL_op->op_private & OPpSORT_REVERSE) {
- SV **p = ORIGMARK+1;
- SV **q = ORIGMARK+max;
- while (p < q) {
- SV *tmp = *p;
- *p++ = *q;
- *q-- = tmp;
- }
+ }
+ if (private & OPpSORT_REVERSE) {
+ SV **q = start+max-1;
+ while (start < q) {
+ SV *tmp = *start;
+ *start++ = *q;
+ *q-- = tmp;
}
}
}
+ if (av && !sorting_av) {
+ /* simulate pp_aassign of tied AV */
+ SV *sv;
+ SV** base, **didstore;
+ for (base = ORIGMARK+1, i=0; i < max; i++) {
+ sv = newSVsv(base[i]);
+ base[i] = sv;
+ }
+ av_clear(av);
+ av_extend(av, max);
+ for (i=0; i < max; i++) {
+ sv = base[i];
+ didstore = av_store(av, i, sv);
+ if (SvSMAGICAL(sv))
+ mg_set(sv);
+ if (!didstore)
+ sv_2mortal(sv);
+ }
+ }
LEAVE;
- PL_stack_sp = ORIGMARK + max;
+ PL_stack_sp = ORIGMARK + (sorting_av ? 0 : max);
return nextop;
}
@@ -1613,12 +1748,12 @@
SV** ary = AvALLOC(av);
if (AvARRAY(av) != ary) {
AvMAX(av) += AvARRAY(av) - AvALLOC(av);
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
}
if (AvMAX(av) < 1) {
AvMAX(av) = 1;
Renew(ary,2,SV*);
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
}
}
AvFILLp(av) = 1;
@@ -1782,3 +1917,13 @@
}
return sv_cmp_locale(str1, str2);
}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * vim: shiftwidth=4:
+*/
1.2 +216 -87 ponie/perl/pp_sys.c
Index: pp_sys.c
===================================================================
RCS file: /cvs/public/ponie/perl/pp_sys.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- pp_sys.c 9 Sep 2003 11:58:53 -0000 1.1
+++ pp_sys.c 19 Apr 2005 19:04:13 -0000 1.2
@@ -1,7 +1,7 @@
/* pp_sys.c
*
* Copyright (C) 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
@@ -15,6 +15,15 @@
* a rumour and a trouble as of great engines throbbing and labouring.
*/
+/* This file contains system pp ("push/pop") functions that
+ * execute the opcodes that make up a perl program. A typical pp function
+ * expects to find its arguments on the stack, and usually pushes its
+ * results onto the stack, hence the 'pp' terminology. Each OP structure
+ * contains a pointer to the relevant pp_foo() function.
+ *
+ * By 'system', we mean ops which interact with the OS, such as pp_open().
+ */
+
#include "EXTERN.h"
#define PERL_IN_PP_SYS_C
#include "perl.h"
@@ -176,6 +185,18 @@
#include "reentr.h"
+#ifdef __Lynx__
+/* Missing protos on LynxOS */
+void sethostent(int);
+void endhostent(void);
+void setnetent(int);
+void endnetent(void);
+void setprotoent(int);
+void endprotoent(void);
+void setservent(int);
+void endservent(void);
+#endif
+
#undef PERL_EFF_ACCESS_R_OK /* EFFective uid/gid ACCESS R_OK */
#undef PERL_EFF_ACCESS_W_OK
#undef PERL_EFF_ACCESS_X_OK
@@ -301,16 +322,16 @@
STRLEN n_a;
char *tmps = POPpx;
I32 gimme = GIMME_V;
- char *mode = "r";
+ const char *mode = "r";
TAINT_PROPER("``");
if (PL_op->op_private & OPpOPEN_IN_RAW)
mode = "rb";
else if (PL_op->op_private & OPpOPEN_IN_CRLF)
mode = "rt";
- fp = PerlProc_popen(tmps, mode);
+ fp = PerlProc_popen(tmps, (char *)mode);
if (fp) {
- char *type = NULL;
+ const char *type = NULL;
if (PL_curcop->cop_io) {
type = SvPV_nolen(PL_curcop->cop_io);
}
@@ -324,13 +345,14 @@
;
}
else if (gimme == G_SCALAR) {
- SV *oldrs = PL_rs;
+ ENTER;
+ SAVESPTR(PL_rs);
PL_rs = &PL_sv_undef;
sv_setpv(TARG, ""); /* note that this preserves previous buffer */
while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
/*SUPPRESS 530*/
;
- PL_rs = oldrs;
+ LEAVE;
XPUSHs(TARG);
SvTAINTED_on(TARG);
}
@@ -345,8 +367,7 @@
}
XPUSHs(sv_2mortal(sv));
if (SvLEN(sv) - SvCUR(sv) > 20) {
- SvLEN_set(sv, SvCUR(sv)+1);
- Renew(SvPVX(sv), SvLEN(sv), char);
+ SvPV_shrink_to_cur(sv);
}
SvTAINTED_on(sv);
}
@@ -411,7 +432,7 @@
{
dSP; dMARK;
SV *tmpsv;
- char *tmps;
+ const char *tmps;
STRLEN len;
if (SP - MARK != 1) {
dTARGET;
@@ -441,7 +462,7 @@
PP(pp_die)
{
dSP; dMARK;
- char *tmps;
+ const char *tmps;
SV *tmpsv;
STRLEN len;
bool multiarg = 0;
@@ -483,7 +504,7 @@
sv_setsv(error,*PL_stack_sp--);
}
}
- DIE(aTHX_ Nullformat);
+ DIE_NULL;
}
else {
if (SvPOK(error) && SvCUR(error))
@@ -609,8 +630,8 @@
if (PerlProc_pipe(fd) < 0)
goto badexit;
- IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPESOCK_MODE);
- IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPESOCK_MODE);
+ IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPE_OPEN_MODE);
+ IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPE_OPEN_MODE);
IoOFP(rstio) = IoIFP(rstio);
IoIFP(wstio) = IoOFP(wstio);
IoTYPE(rstio) = IoTYPE_RDONLY;
@@ -768,7 +789,7 @@
GV *gv;
SV *sv;
I32 markoff = MARK - PL_stack_base;
- char *methname;
+ const char *methname;
int how = PERL_MAGIC_tied;
U32 items;
@@ -1235,9 +1256,9 @@
ENTER;
SAVETMPS;
- push_return(retop);
PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
PUSHFORMAT(cx);
+ cx->blk_sub.retop = retop;
PAD_SET_CUR(CvPADLIST(cv), 1);
setdefout(gv); /* locally select filehandle so $% et al work */
@@ -1315,17 +1336,17 @@
if (!IoTOP_NAME(io)) {
if (!IoFMT_NAME(io))
IoFMT_NAME(io) = savepv(GvNAME(gv));
- topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", IoFMT_NAME(io)));
- topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM);
+ topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv)));
+ topgv = gv_fetchsv(topname, FALSE, SVt_PVFM);
if ((topgv && GvFORM(topgv)) ||
!gv_fetchpv("top",FALSE,SVt_PVFM))
- IoTOP_NAME(io) = savepv(SvPVX(topname));
+ IoTOP_NAME(io) = savesvpv(topname);
else
- IoTOP_NAME(io) = savepv("top");
+ IoTOP_NAME(io) = savepvn("top", 3);
}
topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM);
if (!topgv || !GvFORM(topgv)) {
- IoLINES_LEFT(io) = 100000000;
+ IoLINES_LEFT(io) = IoPAGE_LEN(io);
goto forget_top;
}
IoTOP_GV(io) = topgv;
@@ -1413,7 +1434,7 @@
/* bad_ofp: */
PL_formtarget = PL_bodytarget;
PUTBACK;
- return pop_return();
+ return cx->blk_sub.retop;
}
PP(pp_prtf)
@@ -1534,6 +1555,8 @@
STRLEN blen;
MAGIC *mg;
int fp_utf8;
+ int buffer_utf8;
+ SV *read_target;
Size_t got = 0;
Size_t wanted;
bool charstart = FALSE;
@@ -1579,11 +1602,13 @@
}
if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
buffer = SvPVutf8_force(bufsv, blen);
- /* UTF8 may not have been set if they are all low bytes */
+ /* UTF-8 may not have been set if they are all low bytes */
SvUTF8_on(bufsv);
+ buffer_utf8 = 0;
}
else {
buffer = SvPV_force(bufsv, blen);
+ buffer_utf8 = !IN_BYTES && SvUTF8(bufsv);
}
if (length < 0)
DIE(aTHX_ "Negative length");
@@ -1644,15 +1669,37 @@
}
if (DO_UTF8(bufsv)) {
/* convert offset-as-chars to offset-as-bytes */
- offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
+ if (offset >= (int)blen)
+ offset += SvCUR(bufsv) - blen;
+ else
+ offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
}
more_bytes:
bufsize = SvCUR(bufsv);
+ /* Allocating length + offset + 1 isn't perfect in the case of reading
+ bytes from a byte file handle into a UTF8 buffer, but it won't harm us
+ unduly.
+ (should be 2 * length + offset + 1, or possibly something longer if
+ PL_encoding is true) */
buffer = SvGROW(bufsv, (STRLEN)(length+offset+1));
if (offset > bufsize) { /* Zero any newly allocated space */
Zero(buffer+bufsize, offset-bufsize, char);
}
buffer = buffer + offset;
+ if (!buffer_utf8) {
+ read_target = bufsv;
+ } else {
+ /* Best to read the bytes into a new SV, upgrade that to UTF8, then
+ concatenate it to the current buffer. */
+
+ /* Truncate the existing buffer to the start of where we will be
+ reading to: */
+ SvCUR_set(bufsv, offset);
+
+ read_target = sv_newmortal();
+ SvUPGRADE(read_target, SVt_PV);
+ buffer = SvGROW(read_target, (STRLEN)(length + 1));
+ }
if (PL_op->op_type == OP_SYSREAD) {
#ifdef PERL_SOCK_SYSREAD_IS_RECV
@@ -1692,9 +1739,9 @@
report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY);
goto say_undef;
}
- SvCUR_set(bufsv, count+(buffer - SvPVX(bufsv)));
- *SvEND(bufsv) = '\0';
- (void)SvPOK_only(bufsv);
+ SvCUR_set(read_target, count+(buffer - SvPVX(read_target)));
+ *SvEND(read_target) = '\0';
+ (void)SvPOK_only(read_target);
if (fp_utf8 && !IN_BYTES) {
/* Look at utf8 we got back and count the characters */
char *bend = buffer + count;
@@ -1730,6 +1777,11 @@
count = got;
SvUTF8_on(bufsv);
}
+ else if (buffer_utf8) {
+ /* Let svcatsv upgrade the bytes we read in to utf8.
+ The buffer is a mortal so will be freed soon. */
+ sv_catsv_nomg(bufsv, read_target);
+ }
SvSETMAGIC(bufsv);
/* This should not be marked tainted if the fp is marked clean */
if (!(IoFLAGS(io) & IOf_UNTAINT))
@@ -1808,7 +1860,11 @@
}
if (PerlIO_isutf8(IoIFP(io))) {
- buffer = SvPVutf8(bufsv, blen);
+ if (!SvUTF8(bufsv)) {
+ bufsv = sv_2mortal(newSVsv(bufsv));
+ buffer = sv_2pvutf8(bufsv, &blen);
+ } else
+ buffer = SvPV(bufsv, blen);
}
else {
if (DO_UTF8(bufsv)) {
@@ -1911,7 +1967,7 @@
if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
IoLINES(io) = 0;
IoFLAGS(io) &= ~IOf_START;
- do_open(gv, "-", 1, FALSE, O_RDONLY, 0, Nullfp);
+ do_open(gv, (char *)"-", 1, FALSE, O_RDONLY, 0, Nullfp);
sv_setpvn(GvSV(gv), "-", 1);
SvSETMAGIC(GvSV(gv));
}
@@ -2053,15 +2109,13 @@
* might not be signed: if it is not, clever compilers will moan. */
/* XXX Configure probe for the signedness of the length type of *truncate() needed? XXX */
SETERRNO(0,0);
-#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
{
- STRLEN n_a;
int result = 1;
GV *tmpgv;
IO *io;
if (PL_op->op_flags & OPf_SPECIAL) {
- tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO);
+ tmpgv = gv_fetchsv(POPs, FALSE, SVt_PVIO);
do_ftruncate_gv:
if (!GvIO(tmpgv))
@@ -2088,7 +2142,8 @@
else {
SV *sv = POPs;
char *name;
-
+ STRLEN n_a;
+
if (SvTYPE(sv) == SVt_PVGV) {
tmpgv = (GV*)sv; /* *main::FRED for example */
goto do_ftruncate_gv;
@@ -2128,9 +2183,6 @@
SETERRNO(EBADF,RMS_IFI);
RETPUSHUNDEF;
}
-#else
- DIE(aTHX_ "truncate not implemented");
-#endif
}
PP(pp_fcntl)
@@ -2143,7 +2195,7 @@
dSP; dTARGET;
SV *argsv = POPs;
unsigned int func = POPu;
- int optype = PL_op->op_type;
+ const int optype = PL_op->op_type;
char *s;
IV retval;
GV *gv = (GV*)POPs;
@@ -2283,8 +2335,8 @@
fd = PerlSock_socket(domain, type, protocol);
if (fd < 0)
RETPUSHUNDEF;
- IoIFP(io) = PerlIO_fdopen(fd, "r"PIPESOCK_MODE); /* stdio gets confused about sockets */
- IoOFP(io) = PerlIO_fdopen(fd, "w"PIPESOCK_MODE);
+ IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE); /* stdio gets confused about sockets */
+ IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
IoTYPE(io) = IoTYPE_SOCKET;
if (!IoIFP(io) || !IoOFP(io)) {
if (IoIFP(io)) PerlIO_close(IoIFP(io));
@@ -2345,11 +2397,11 @@
TAINT_PROPER("socketpair");
if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
RETPUSHUNDEF;
- IoIFP(io1) = PerlIO_fdopen(fd[0], "r"PIPESOCK_MODE);
- IoOFP(io1) = PerlIO_fdopen(fd[0], "w"PIPESOCK_MODE);
+ IoIFP(io1) = PerlIO_fdopen(fd[0], "r"SOCKET_OPEN_MODE);
+ IoOFP(io1) = PerlIO_fdopen(fd[0], "w"SOCKET_OPEN_MODE);
IoTYPE(io1) = IoTYPE_SOCKET;
- IoIFP(io2) = PerlIO_fdopen(fd[1], "r"PIPESOCK_MODE);
- IoOFP(io2) = PerlIO_fdopen(fd[1], "w"PIPESOCK_MODE);
+ IoIFP(io2) = PerlIO_fdopen(fd[1], "r"SOCKET_OPEN_MODE);
+ IoOFP(io2) = PerlIO_fdopen(fd[1], "w"SOCKET_OPEN_MODE);
IoTYPE(io2) = IoTYPE_SOCKET;
if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
@@ -2520,8 +2572,8 @@
goto badexit;
if (IoIFP(nstio))
do_close(ngv, FALSE);
- IoIFP(nstio) = PerlIO_fdopen(fd, "r"PIPESOCK_MODE);
- IoOFP(nstio) = PerlIO_fdopen(fd, "w"PIPESOCK_MODE);
+ IoIFP(nstio) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE);
+ IoOFP(nstio) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
IoTYPE(nstio) = IoTYPE_SOCKET;
if (!IoIFP(nstio) || !IoOFP(nstio)) {
if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
@@ -2790,12 +2842,10 @@
}
sv_setpv(PL_statname, SvPV(sv,n_a));
PL_statgv = Nullgv;
-#ifdef HAS_LSTAT
PL_laststype = PL_op->op_type;
if (PL_op->op_type == OP_LSTAT)
PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, n_a), &PL_statcache);
else
-#endif
PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache);
if (PL_laststatval < 0) {
if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
@@ -2865,13 +2915,23 @@
RETURN;
}
+/* This macro is used by the stacked filetest operators :
+ * if the previous filetest failed, short-circuit and pass its value.
+ * Else, discard it from the stack and continue. --rgs
+ */
+#define STACKED_FTEST_CHECK if (PL_op->op_private & OPpFT_STACKED) { \
+ if (TOPs == &PL_sv_no || TOPs == &PL_sv_undef) { RETURN; } \
+ else { (void)POPs; PUTBACK; } \
+ }
+
PP(pp_ftrread)
{
I32 result;
dSP;
+ STACKED_FTEST_CHECK;
#if defined(HAS_ACCESS) && defined(R_OK)
- STRLEN n_a;
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ STRLEN n_a;
result = access(POPpx, R_OK);
if (result == 0)
RETPUSHYES;
@@ -2896,9 +2956,10 @@
{
I32 result;
dSP;
+ STACKED_FTEST_CHECK;
#if defined(HAS_ACCESS) && defined(W_OK)
- STRLEN n_a;
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ STRLEN n_a;
result = access(POPpx, W_OK);
if (result == 0)
RETPUSHYES;
@@ -2923,9 +2984,10 @@
{
I32 result;
dSP;
+ STACKED_FTEST_CHECK;
#if defined(HAS_ACCESS) && defined(X_OK)
- STRLEN n_a;
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ STRLEN n_a;
result = access(POPpx, X_OK);
if (result == 0)
RETPUSHYES;
@@ -2950,9 +3012,10 @@
{
I32 result;
dSP;
+ STACKED_FTEST_CHECK;
#ifdef PERL_EFF_ACCESS_R_OK
- STRLEN n_a;
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ STRLEN n_a;
result = PERL_EFF_ACCESS_R_OK(POPpx);
if (result == 0)
RETPUSHYES;
@@ -2977,9 +3040,10 @@
{
I32 result;
dSP;
+ STACKED_FTEST_CHECK;
#ifdef PERL_EFF_ACCESS_W_OK
- STRLEN n_a;
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ STRLEN n_a;
result = PERL_EFF_ACCESS_W_OK(POPpx);
if (result == 0)
RETPUSHYES;
@@ -3004,9 +3068,10 @@
{
I32 result;
dSP;
+ STACKED_FTEST_CHECK;
#ifdef PERL_EFF_ACCESS_X_OK
- STRLEN n_a;
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+ STRLEN n_a;
result = PERL_EFF_ACCESS_X_OK(POPpx);
if (result == 0)
RETPUSHYES;
@@ -3029,8 +3094,11 @@
PP(pp_ftis)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
RETPUSHYES;
@@ -3043,8 +3111,11 @@
PP(pp_ftrowned)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ?
@@ -3055,8 +3126,11 @@
PP(pp_ftzero)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (PL_statcache.st_size == 0)
@@ -3066,8 +3140,11 @@
PP(pp_ftsize)
{
- I32 result = my_stat();
+ I32 result;
dSP; dTARGET;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
#if Off_t_size > IVSIZE
@@ -3080,38 +3157,50 @@
PP(pp_ftmtime)
{
- I32 result = my_stat();
+ I32 result;
dSP; dTARGET;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
- PUSHn( (PL_basetime - PL_statcache.st_mtime) / 86400.0 );
+ PUSHn( (((NV)PL_basetime - PL_statcache.st_mtime)) / 86400.0 );
RETURN;
}
PP(pp_ftatime)
{
- I32 result = my_stat();
+ I32 result;
dSP; dTARGET;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
- PUSHn( (PL_basetime - PL_statcache.st_atime) / 86400.0 );
+ PUSHn( (((NV)PL_basetime - PL_statcache.st_atime)) / 86400.0 );
RETURN;
}
PP(pp_ftctime)
{
- I32 result = my_stat();
+ I32 result;
dSP; dTARGET;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
- PUSHn( (PL_basetime - PL_statcache.st_ctime) / 86400.0 );
+ PUSHn( (((NV)PL_basetime - PL_statcache.st_ctime)) / 86400.0 );
RETURN;
}
PP(pp_ftsock)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (S_ISSOCK(PL_statcache.st_mode))
@@ -3121,8 +3210,11 @@
PP(pp_ftchr)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (S_ISCHR(PL_statcache.st_mode))
@@ -3132,8 +3224,11 @@
PP(pp_ftblk)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (S_ISBLK(PL_statcache.st_mode))
@@ -3143,8 +3238,11 @@
PP(pp_ftfile)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (S_ISREG(PL_statcache.st_mode))
@@ -3154,8 +3252,11 @@
PP(pp_ftdir)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (S_ISDIR(PL_statcache.st_mode))
@@ -3165,8 +3266,11 @@
PP(pp_ftpipe)
{
- I32 result = my_stat();
+ I32 result;
dSP;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
+ SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
if (S_ISFIFO(PL_statcache.st_mode))
@@ -3189,7 +3293,9 @@
{
dSP;
#ifdef S_ISUID
- I32 result = my_stat();
+ I32 result;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
@@ -3203,7 +3309,9 @@
{
dSP;
#ifdef S_ISGID
- I32 result = my_stat();
+ I32 result;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
@@ -3217,7 +3325,9 @@
{
dSP;
#ifdef S_ISVTX
- I32 result = my_stat();
+ I32 result;
+ STACKED_FTEST_CHECK;
+ result = my_stat();
SPAGAIN;
if (result < 0)
RETPUSHUNDEF;
@@ -3232,8 +3342,9 @@
dSP;
int fd;
GV *gv;
- char *tmps = Nullch;
- STRLEN n_a;
+ SV *tmpsv = Nullsv;
+
+ STACKED_FTEST_CHECK;
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
@@ -3242,12 +3353,18 @@
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = (GV*)SvRV(POPs);
else
- gv = gv_fetchpv(tmps = POPpx, FALSE, SVt_PVIO);
+ gv = gv_fetchsv(tmpsv = POPs, FALSE, SVt_PVIO);
if (GvIO(gv) && IoIFP(GvIOp(gv)))
fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
- else if (tmps && isDIGIT(*tmps))
- fd = atoi(tmps);
+ else if (tmpsv && SvOK(tmpsv)) {
+ STRLEN n_a;
+ char *tmps = SvPV(tmpsv, n_a);
+ if (isDIGIT(*tmps))
+ fd = atoi(tmps);
+ else
+ RETPUSHUNDEF;
+ }
else
RETPUSHUNDEF;
if (PerlLIO_isatty(fd))
@@ -3277,6 +3394,8 @@
STRLEN n_a;
PerlIO *fp;
+ STACKED_FTEST_CHECK;
+
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
else if (isGV(TOPs))
@@ -3340,7 +3459,6 @@
sv = POPs;
really_filename:
PL_statgv = Nullgv;
- PL_laststatval = -1;
PL_laststype = OP_STAT;
sv_setpv(PL_statname, SvPV(sv, n_a));
if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) {
@@ -4025,27 +4143,28 @@
{
#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
dSP; dTARGET;
- Pid_t childpid;
+ Pid_t pid;
+ Pid_t result;
int optype;
int argflags;
optype = POPi;
- childpid = TOPi;
+ pid = TOPi;
if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
- childpid = wait4pid(childpid, &argflags, optype);
+ result = wait4pid(pid, &argflags, optype);
else {
- while ((childpid = wait4pid(childpid, &argflags, optype)) == -1 &&
+ while ((result = wait4pid(pid, &argflags, optype)) == -1 &&
errno == EINTR) {
PERL_ASYNC_CHECK();
}
}
# if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
/* 0 and -1 are both error returns (the former applies to WNOHANG case) */
- STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
+ STATUS_NATIVE_SET((result && result != -1) ? argflags : -1);
# else
- STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+ STATUS_NATIVE_SET((result > 0) ? argflags : -1);
# endif
- SETi(childpid);
+ SETi(result);
RETURN;
#else
DIE(aTHX_ PL_no_func, "waitpid");
@@ -4407,9 +4526,9 @@
{
dSP;
Time_t when;
- struct tm *tmbuf;
- static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
- static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
+ const struct tm *tmbuf;
+ static const char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
+ static const char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
if (MAXARG < 1)
@@ -5743,3 +5862,13 @@
}
#endif /* LOCKF_EMULATE_FLOCK */
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * vim: shiftwidth=4:
+*/
1.4 +1 -1 ponie/perl/regcomp.c
Index: regcomp.c
===================================================================
RCS file: /cvs/public/ponie/perl/regcomp.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- regcomp.c 4 Apr 2005 17:46:12 -0000 1.3
+++ regcomp.c 19 Apr 2005 19:04:13 -0000 1.4
@@ -2384,7 +2384,7 @@
SvGROW(last_str, (mincount * l) + 1);
repeatcpy(SvPVX(last_str) + l,
SvPVX(last_str), l, mincount - 1);
- SvCUR(last_str) *= mincount;
+ SvCUR_set(last_str, SvCUR(last_str) * mincount);
/* Add additional parts. */
SvCUR_set(data->last_found,
SvCUR(data->last_found) - l);
1.10 +16 -16 ponie/perl/scope.c
Index: scope.c
===================================================================
RCS file: /cvs/public/ponie/perl/scope.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- scope.c 4 Apr 2005 17:46:12 -0000 1.9
+++ scope.c 19 Apr 2005 19:04:13 -0000 1.10
@@ -182,7 +182,7 @@
SV_PRIVSHIFT(osv);
PL_tainted = oldtainted;
}
- SvMAGIC(sv) = SvMAGIC(osv);
+ SvMAGIC_set(sv, SvMAGIC(osv));
/* if it's a special scalar or if it has no 'set' magic,
* propagate the SvREADONLY flag. --rgs 20030922 */
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
@@ -288,7 +288,7 @@
{
SSGROW(6);
SSPUSHIV((IV)SvLEN(gv));
- SvLEN(gv) = 0; /* forget that anything was allocated here */
+ SvLEN_set(gv, 0); /* forget that anything was allocated here */
SSPUSHIV((IV)SvCUR(gv));
SSPUSHPTR(SvPVX(gv));
SvPOK_off(gv);
@@ -335,10 +335,10 @@
GvAV(gv) = Null(AV*);
av = GvAVn(gv);
if (SvMAGIC(oav)) {
- SvMAGIC(av) = SvMAGIC(oav);
+ SvMAGIC_set(av, SvMAGIC(oav));
SvMAGICAL_set((SV*)av,SvMAGICAL(oav));
SvMAGICAL_off(oav);
- SvMAGIC(oav) = 0;
+ SvMAGIC_set(oav, 0);
PL_localizing = 1;
SvSETMAGIC((SV*)av);
PL_localizing = 0;
@@ -359,10 +359,10 @@
GvHV(gv) = Null(HV*);
hv = GvHVn(gv);
if (SvMAGIC(ohv)) {
- SvMAGIC(hv) = SvMAGIC(ohv);
+ SvMAGIC_set(hv, SvMAGIC(ohv));
SvMAGICAL_set((SV*)hv,SvMAGICAL(ohv));
SvMAGICAL_off(ohv);
- SvMAGIC(ohv) = 0;
+ SvMAGIC_set(ohv, 0);
PL_localizing = 1;
SvSETMAGIC((SV*)hv);
PL_localizing = 0;
@@ -746,10 +746,10 @@
SvTYPE(sv) != SVt_PVGV)
{
(void)SvUPGRADE(value, SvTYPE(sv));
- SvMAGIC(value) = SvMAGIC(sv);
+ SvMAGIC_set(value, SvMAGIC(sv));
SvMAGICAL_set(value,SvMAGICAL(sv));
SvMAGICAL_off(sv);
- SvMAGIC(sv) = 0;
+ SvMAGIC_set(sv, 0);
}
/* XXX This branch is pretty bogus. This code irretrievably
* clears(!) the magic on the SV (either to avoid further
@@ -763,7 +763,7 @@
SvMAGICAL_off(value);
/* XXX this is a leak when we get here because the
* mg_get() in save_scalar_at() croaked */
- SvMAGIC(value) = 0;
+ SvMAGIC_set(value, NULL);
}
*(SV**)ptr = value;
SvREFCNT_dec(sv);
@@ -779,10 +779,10 @@
gv = (GV*)SSPOPPTR;
if (GvAV(gv)) {
AV * const goner = GvAV(gv);
- SvMAGIC(av) = SvMAGIC(goner);
+ SvMAGIC_set(av, SvMAGIC(goner));
SvMAGICAL_set((SV*)av, SvMAGICAL(goner));
SvMAGICAL_off(goner);
- SvMAGIC(goner) = 0;
+ SvMAGIC_set(goner, 0);
SvREFCNT_dec(goner);
}
GvAV(gv) = av;
@@ -797,10 +797,10 @@
gv = (GV*)SSPOPPTR;
if (GvHV(gv)) {
HV * const goner = GvHV(gv);
- SvMAGIC(hv) = SvMAGIC(goner);
+ SvMAGIC_set(hv, SvMAGIC(goner));
SvMAGICAL_set(hv, SvMAGICAL(goner));
SvMAGICAL_off(goner);
- SvMAGIC(goner) = 0;
+ SvMAGIC_set(goner, 0);
SvREFCNT_dec(goner);
}
GvHV(gv) = hv;
@@ -865,9 +865,9 @@
if (SvPVX(gv) && SvLEN(gv) > 0) {
Safefree(SvPVX(gv));
}
- SvPVX(gv) = (char *)SSPOPPTR;
- SvCUR(gv) = (STRLEN)SSPOPIV;
- SvLEN(gv) = (STRLEN)SSPOPIV;
+ SvPV_set(gv, (char *)SSPOPPTR);
+ SvCUR_set(gv, (STRLEN)SSPOPIV);
+ SvLEN_set(gv, (STRLEN)SSPOPIV);
gp_free(gv);
GvGP(gv) = (GP*)ptr;
if (GvCVu(gv))
1.61 +160 -155 ponie/perl/sv.c
Index: sv.c
===================================================================
RCS file: /cvs/public/ponie/perl/sv.c,v
retrieving revision 1.60
retrieving revision 1.61
diff -u -r1.60 -r1.61
--- sv.c 12 Apr 2005 11:12:13 -0000 1.60
+++ sv.c 19 Apr 2005 19:04:13 -0000 1.61
@@ -360,10 +360,10 @@
if (SvWEAKREF(sv)) {
sv_del_backref(sv);
SvWEAKREF_off(sv);
- SvRV(sv) = 0;
+ SvRV_set(sv, NULL);
} else {
SvROK_off(sv);
- SvRV(sv) = 0;
+ SvRV_set(sv, NULL);
SvREFCNT_dec(rv);
}
}
@@ -1965,33 +1965,33 @@
case SVt_RV:
SvANY(sv) = 0;
SvPMC_on(sv);
- SvRV(sv) = rv;
+ SvRV_set(sv, rv);
break;
case SVt_PV:
SvANY(sv) = new_XPV();
SvPMC_on(sv);
if (sv_is_rv) {
- SvRV(sv) = rv;
+ SvRV_set(sv, rv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
} else {
- SvPVX(sv) = pv;
+ SvPV_set(sv, pv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
}
- SvCUR(sv) = cur;
- SvLEN(sv) = len;
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
break;
case SVt_PVIV:
SvANY(sv) = new_XPVIV();
SvPMC_on(sv);
if (sv_is_rv) {
- SvRV(sv) = rv;
+ SvRV_set(sv, rv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
} else {
- SvPVX(sv) = pv;
+ SvPV_set(sv, pv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
}
- SvCUR(sv) = cur;
- SvLEN(sv) = len;
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
SvIV_set(sv, iv);
if (SvNIOK(sv))
(void)SvIOK_on(sv);
@@ -2001,14 +2001,14 @@
SvANY(sv) = new_XPVNV();
SvPMC_on(sv);
if (sv_is_rv) {
- SvRV(sv) = rv;
+ SvRV_set(sv, rv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
} else {
- SvPVX(sv) = pv;
+ SvPV_set(sv, pv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
}
- SvCUR(sv) = cur;
- SvLEN(sv) = len;
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
SvIV_set(sv, iv);
SvNV_set(sv, nv);
break;
@@ -2016,35 +2016,35 @@
SvANY(sv) = new_XPVMG();
SvPMC_on(sv);
if (sv_is_rv) {
- SvRV(sv) = rv;
+ SvRV_set(sv, rv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
} else {
- SvPVX(sv) = pv;
+ SvPV_set(sv, pv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
}
- SvCUR(sv) = cur;
- SvLEN(sv) = len;
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
SvIV_set(sv, iv);
SvNV_set(sv, nv);
- SvMAGIC(sv) = magic;
- SvSTASH(sv) = stash;
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
break;
case SVt_PVLV:
SvANY(sv) = new_XPVLV();
SvPMC_on(sv);
if (sv_is_rv) {
- SvRV(sv) = rv;
+ SvRV_set(sv, rv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
} else {
- SvPVX(sv) = pv;
+ SvPV_set(sv, pv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
}
- SvCUR(sv) = cur;
- SvLEN(sv) = len;
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
SvIV_set(sv, iv);
SvNV_set(sv, nv);
- SvMAGIC(sv) = magic;
- SvSTASH(sv) = stash;
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
LvTARGOFF(sv) = 0;
LvTARGLEN(sv) = 0;
LvTARG(sv) = 0;
@@ -2061,18 +2061,18 @@
Safefree(pv);
if (sv_is_rv) {
/* XXX need more paranoia here? */
- SvRV(sv) = 0;
+ SvRV_set(sv, 0);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
} else {
- SvPVX(sv) = 0;
+ SvPV_set(sv, (char*)0);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
}
AvMAX(sv) = -1;
AvFILLp(sv) = -1;
SvIV_set(sv, 0);
SvNV_set(sv, 0.0);
- SvMAGIC(sv) = magic;
- SvSTASH(sv) = stash;
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
AvALLOC(sv) = 0;
AvARYLEN(sv) = 0;
AvFLAGS(sv) = AVf_REAL;
@@ -2083,18 +2083,18 @@
Safefree(pv);
if (sv_is_rv) {
/* XXX need more paranoia here? */
- SvRV(sv) = 0;
+ SvRV_set(sv, 0);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
} else {
- SvPVX(sv) = 0;
+ SvPV_set(sv, (char*)0);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
}
HvFILL(sv) = 0;
HvMAX(sv) = 0;
HvTOTALKEYS(sv) = 0;
HvPLACEHOLDERS(sv) = 0;
- SvMAGIC(sv) = magic;
- SvSTASH(sv) = stash;
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
HvRITER(sv) = 0;
HvEITER(sv) = 0;
HvPMROOT(sv) = 0;
@@ -2105,31 +2105,31 @@
SvPMC_on(sv);
zero_xpvcv(sv);
assert (!sv_is_rv);
- SvPVX(sv) = pv;
+ SvPV_set(sv, pv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
- SvCUR(sv) = cur;
- SvLEN(sv) = len;
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
SvIV_set(sv, iv);
SvNV_set(sv, nv);
- SvMAGIC(sv) = magic;
- SvSTASH(sv) = stash;
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
break;
case SVt_PVGV:
SvANY(sv) = new_XPVGV();
SvPMC_on(sv);
if (sv_is_rv) {
- SvRV(sv) = rv;
+ SvRV_set(sv, rv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
} else {
- SvPVX(sv) = pv;
+ SvPV_set(sv, pv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
}
- SvCUR(sv) = cur;
- SvLEN(sv) = len;
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
SvIV_set(sv, iv);
SvNV_set(sv, nv);
- SvMAGIC(sv) = magic;
- SvSTASH(sv) = stash;
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
GvGP(sv) = 0;
GvNAME(sv) = 0;
GvNAMELEN(sv) = 0;
@@ -2140,18 +2140,18 @@
SvANY(sv) = new_XPVBM();
SvPMC_on(sv);
if (sv_is_rv) {
- SvRV(sv) = rv;
+ SvRV_set(sv, rv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
} else {
- SvPVX(sv) = pv;
+ SvPV_set(sv, pv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
}
- SvCUR(sv) = cur;
- SvLEN(sv) = len;
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
SvIV_set(sv, iv);
SvNV_set(sv, nv);
- SvMAGIC(sv) = magic;
- SvSTASH(sv) = stash;
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
BmRARE(sv) = 0;
BmUSEFUL(sv) = 0;
BmPREVIOUS(sv) = 0;
@@ -2161,36 +2161,36 @@
SvPMC_on(sv);
zero_xpvfm(sv);
if (sv_is_rv) {
- SvRV(sv) = rv;
+ SvRV_set(sv, rv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
} else {
- SvPVX(sv) = pv;
+ SvPV_set(sv, pv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
}
- SvCUR(sv) = cur;
- SvLEN(sv) = len;
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
SvIV_set(sv, iv);
SvNV_set(sv, nv);
- SvMAGIC(sv) = magic;
- SvSTASH(sv) = stash;
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
break;
case SVt_PVIO:
SvANY(sv) = new_XPVIO();
SvPMC_on(sv);
zero_xpvio(sv);
if (sv_is_rv) {
- SvRV(sv) = rv;
+ SvRV_set(sv, rv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_PVX_0, 0);
} else {
- SvPVX(sv) = pv;
+ SvPV_set(sv, pv);
Parrot_PMC_set_pointer_intkey(PL_Parrot,MUMBLE(sv), Ponie_P_RVX_0, 0);
}
- SvCUR(sv) = cur;
- SvLEN(sv) = len;
+ SvCUR_set(sv, cur);
+ SvLEN_set(sv, len);
SvIV_set(sv, iv);
SvNV_set(sv, nv);
- SvMAGIC(sv) = magic;
- SvSTASH(sv) = stash;
+ SvMAGIC_set(sv, magic);
+ SvSTASH_set(sv, stash);
IoPAGE_LEN(sv) = 60;
break;
}
@@ -2213,8 +2213,8 @@
assert(SvOOK(sv));
if (SvIVX(sv)) {
char *s = SvPVX(sv);
- SvLEN(sv) += SvIVX(sv);
- SvPVX(sv) -= SvIVX(sv);
+ SvLEN_set(sv, SvLEN(sv) + SvIVX(sv));
+ SvPV_set(sv, SvPVX(sv) - SvIVX(sv));
SvIV_set(sv, 0);
Move(s, SvPVX(sv), SvCUR(sv)+1, char);
}
@@ -4135,11 +4135,11 @@
(void)SvOOK_off(sv);
s = (U8*)SvPVX(sv);
len = SvCUR(sv) + 1; /* Plus the \0 */
- SvPVX(sv) = (char*)bytes_to_utf8((U8*)s, &len);
- SvCUR(sv) = len - 1;
+ SvPV_set(sv, (char*)bytes_to_utf8((U8*)s, &len));
+ SvCUR_set(sv, len - 1);
if (SvLEN(sv) != 0)
Safefree(s); /* No longer using what was there before. */
- SvLEN(sv) = len; /* No longer know the real size. */
+ SvLEN_set(sv, len); /* No longer know the real size. */
}
/* Mark as UTF-8 even if no hibit - saves scanning loop */
SvUTF8_on(sv);
@@ -4184,7 +4184,7 @@
Perl_croak(aTHX_ "Wide character");
}
}
- SvCUR(sv) = len;
+ SvCUR_set(sv, len);
}
}
SvUTF8_off(sv);
@@ -4626,11 +4626,12 @@
(void)SvOOK_off(dstr); /* backoff */
if (SvLEN(dstr))
Safefree(SvPVX(dstr));
- SvLEN(dstr)=SvCUR(dstr)=0;
+ SvLEN_set(dstr, 0);
+ SvCUR_set(dstr, 0);
}
}
(void)SvOK_off(dstr);
- SvRV(dstr) = SvREFCNT_inc(SvRV(sstr));
+ SvRV_set(dstr, SvREFCNT_inc(SvRV(sstr)));
SvROK_on(dstr);
if (sflags & SVp_NOK) {
SvNOKp_on(dstr);
@@ -5051,7 +5052,7 @@
if (SvPVX(sv) && SvLEN(sv))
Safefree(SvPVX(sv));
Renew(ptr, len+1, char);
- SvPVX(sv) = ptr;
+ SvPV_set(sv, ptr);
SvCUR_set(sv, len);
SvLEN_set(sv, len+1);
*SvEND(sv) = '\0';
@@ -5159,7 +5160,7 @@
SvFAKE_off(sv);
SvREADONLY_off(sv);
/* This SV doesn't own the buffer, so need to New() a new one: */
- SvPVX(sv) = 0;
+ SvPV_set(sv, (char*)0);
SvLEN(sv) = 0;
if (flags & SV_COW_DROP_PV) {
/* OK, so we don't need to copy our buffer. */
@@ -5188,8 +5189,8 @@
U32 hash = SvUVX(sv);
SvFAKE_off(sv);
SvREADONLY_off(sv);
- SvPVX(sv) = 0;
- SvLEN(sv) = 0;
+ SvPV_set(sv, (char*)0);
+ SvLEN_set(sv, 0);
SvGROW(sv, len + 1);
Move(pvx,SvPVX(sv),len,char);
*SvEND(sv) = '\0';
@@ -5260,9 +5261,9 @@
SvOOK_on(sv);
}
SvNIOK_off(sv);
- SvLEN(sv) -= delta;
- SvCUR(sv) -= delta;
- SvPVX(sv) += delta;
+ SvLEN_set(sv, SvLEN(sv) - delta);
+ SvCUR_set(sv, SvCUR(sv) - delta);
+ SvPV_set(sv, SvPVX(sv) + delta);
SvIV_set(sv, SvIVX(sv) + delta);
}
@@ -5307,7 +5308,7 @@
if (sstr == dstr)
sstr = SvPVX(dsv);
Move(sstr, SvPVX(dsv) + dlen, slen, char);
- SvCUR(dsv) += slen;
+ SvCUR_set(dsv, SvCUR(dsv) + slen);
*SvEND(dsv) = '\0';
(void)SvPOK_only_UTF8(dsv); /* validate pointer */
SvTAINT(dsv);
@@ -5430,7 +5431,7 @@
if (ptr == junk)
ptr = SvPVX(sv);
Move(ptr,SvPVX(sv)+tlen,len+1,char);
- SvCUR(sv) += len;
+ SvCUR_set(sv, SvCUR(sv) + len);
(void)SvPOK_only_UTF8(sv); /* validate pointer */
SvTAINT(sv);
}
@@ -5502,7 +5503,7 @@
}
Newz(702,mg, 1, MAGIC);
mg->mg_moremagic = SvMAGIC(sv);
- SvMAGIC(sv) = mg;
+ SvMAGIC_set(sv, mg);
/* Sometimes a magic contains a reference loop, where the sv and
object refer to each other. To prevent a reference loop that
@@ -5909,7 +5910,7 @@
while (midend > mid) /* shove everything down */
*--bigend = *--midend;
Move(little,big+offset,littlelen,char);
- SvCUR(bigstr) += i;
+ SvCUR_set(bigstr, SvCUR(bigstr) + i);
SvSETMAGIC(bigstr);
return;
}
@@ -5989,10 +5990,10 @@
mg_free(nsv);
else
sv_upgrade(nsv, SVt_PVMG);
- SvMAGIC(nsv) = SvMAGIC(sv);
+ SvMAGIC_set(nsv, SvMAGIC(sv));
SvMAGICAL_set(nsv, SvMAGICAL(sv));
SvMAGICAL_off(sv);
- SvMAGIC(sv) = 0;
+ SvMAGIC_set(sv, 0);
}
SvREFCNT(sv) = 0;
sv_clear(sv);
@@ -6083,7 +6084,7 @@
if(SvREFCNT(tmpref) < 2) {
/* tmpref is not kept alive! */
SvREFCNT(sv)--;
- SvRV(tmpref) = 0;
+ SvRV_set(tmpref, NULL);
SvROK_off(tmpref);
}
SvREFCNT_dec(tmpref);
@@ -7597,7 +7598,7 @@
}
/* oh,oh, the number grew */
SvGROW(sv, SvCUR(sv) + 2);
- SvCUR(sv)++;
+ SvCUR_set(sv, SvCUR(sv) + 1);
for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX(sv); d--)
*d = d[-1];
if (isDIGIT(d[1]))
@@ -7867,10 +7868,10 @@
PERL_HASH(hash, src, len);
new_SV(sv);
sv_upgrade(sv, SVt_PVIV);
- SvPVX(sv) = sharepvn(src, is_utf8?-len:len, hash);
- SvCUR(sv) = len;
+ SvPV_set(sv, sharepvn(src, is_utf8?-len:len, hash));
+ SvCUR_set(sv, len);
SvUV_set(sv, hash);
- SvLEN(sv) = 0;
+ SvLEN_set(sv, 0);
SvREADONLY_on(sv);
SvFAKE_on(sv);
SvPOK_on(sv);
@@ -8005,7 +8006,7 @@
new_SV(sv);
sv_upgrade(sv, SVt_RV);
SvTEMP_off(tmpRef);
- SvRV(sv) = tmpRef;
+ SvRV_set(sv, tmpRef);
SvROK_on(sv);
return sv;
}
@@ -8717,7 +8718,7 @@
}
SvOK_off(rv);
- SvRV(rv) = sv;
+ SvRV_set(rv, sv);
SvROK_on(rv);
if (classname) {
@@ -8866,7 +8867,7 @@
if (SvTYPE(tmpRef) != SVt_PVIO)
++PL_sv_objcount;
(void)SvUPGRADE(tmpRef, SVt_PVMG);
- SvSTASH(tmpRef) = (HV*)SvREFCNT_inc(stash);
+ SvSTASH_set(tmpRef, (HV*)SvREFCNT_inc(stash));
if (Gv_AMG(stash))
SvAMAGIC_on(sv);
@@ -8910,8 +8911,8 @@
/* Swap all the pointer related entries using the official API. */
temp_pv = SvPVX(sv);
- SvPVX(sv) = SvPVX(new_mg);
- SvPVX(new_mg) = temp_pv;
+ SvPV_set(sv, SvPVX(new_mg));
+ SvPV_set(new_mg, temp_pv);
temp_len = SvCUR(sv);
SvCUR(sv) = SvCUR(new_mg);
SvCUR(new_mg) = temp_len;
@@ -8969,10 +8970,10 @@
if (SvWEAKREF(sv)) {
sv_del_backref(sv);
SvWEAKREF_off(sv);
- SvRV(sv) = 0;
+ SvRV_set(sv, NULL);
return;
}
- SvRV(sv) = 0;
+ SvRV_set(sv, NULL);
SvROK_off(sv);
/* You can't have a || SvREADONLY(rv) here, as $a = $$a, where $a was
assigned to as BEGIN {$a = \"Foo"} will fail. */
@@ -10299,7 +10300,7 @@
Copy(eptr, p, elen, char);
p += elen;
*p = '\0';
- SvCUR(sv) = p - SvPVX(sv);
+ SvCUR_set(sv, p - SvPVX(sv));
svix = osvix;
continue; /* not "break" */
}
@@ -10365,7 +10366,7 @@
if (has_utf8)
SvUTF8_on(sv);
*p = '\0';
- SvCUR(sv) = p - SvPVX(sv);
+ SvCUR_set(sv, p - SvPVX(sv));
if (vectorize) {
esignlen = 0;
goto vector;
@@ -10902,15 +10903,16 @@
Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param)
{
if (SvROK(sstr)) {
- SvRV(dstr) = SvWEAKREF(sstr)
- ? sv_dup(SvRV(sstr), param)
- : sv_dup_inc(SvRV(sstr), param);
+ SvRV_set(dstr, SvWEAKREF(sstr)
+ ? sv_dup(SvRV(sstr), param)
+ : sv_dup_inc(SvRV(sstr), param));
+
}
else if (SvPVX(sstr)) {
/* Has something there */
if (SvLEN(sstr)) {
/* Normal PV - clone whole allocated space */
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+ SvPV_set(dstr, SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1));
if (SvREADONLY(sstr) && SvFAKE(sstr)) {
/* Not that normal - actually sstr is copy on write.
But we are a true, independant SV, so: */
@@ -10927,25 +10929,28 @@
and they should not have these flags
turned off */
- SvPVX(dstr) = sharepvn(SvPVX(sstr), SvCUR(sstr),
- SvUVX(sstr));
+ SvPV_set(dstr, sharepvn(SvPVX(sstr), SvCUR(sstr),
+ SvUVX(sstr)));
SvUV_set(dstr, SvUVX(sstr));
} else {
- SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr));
+ SvPV_set(dstr, SAVEPVN(SvPVX(sstr), SvCUR(sstr)));
SvFAKE_off(dstr);
SvREADONLY_off(dstr);
}
}
else {
/* Some other special case - random pointer */
- SvPVX(dstr) = SvPVX(sstr);
+ SvPV_set(dstr, SvPVX(sstr));
}
}
}
else {
/* Copy the Null */
- SvPVX(dstr) = SvPVX(sstr);
+ if (SvTYPE(dstr) == SVt_RV)
+ SvRV_set(dstr, NULL);
+ else
+ SvPV_set(dstr, 0);
}
}
@@ -11019,43 +11024,43 @@
break;
case SVt_PV:
SvANY(dstr) = new_XPV();
- SvCUR(dstr) = SvCUR(sstr);
- SvLEN(dstr) = SvLEN(sstr);
+ SvCUR_set(dstr, SvCUR(sstr));
+ SvLEN_set(dstr, SvLEN(sstr));
Perl_rvpv_dup(aTHX_ dstr, sstr, param);
break;
case SVt_PVIV:
SvANY(dstr) = new_XPVIV();
- SvCUR(dstr) = SvCUR(sstr);
- SvLEN(dstr) = SvLEN(sstr);
+ SvCUR_set(dstr, SvCUR(sstr));
+ SvLEN_set(dstr, SvLEN(sstr));
SvIV_set(dstr, SvIVX(sstr));
Perl_rvpv_dup(aTHX_ dstr, sstr, param);
break;
case SVt_PVNV:
SvANY(dstr) = new_XPVNV();
- SvCUR(dstr) = SvCUR(sstr);
- SvLEN(dstr) = SvLEN(sstr);
+ SvCUR_set(dstr, SvCUR(sstr));
+ SvLEN_set(dstr, SvLEN(sstr));
SvIV_set(dstr, SvIVX(sstr));
SvNV_set(dstr, SvNVX(sstr));
Perl_rvpv_dup(aTHX_ dstr, sstr, param);
break;
case SVt_PVMG:
SvANY(dstr) = new_XPVMG();
- SvCUR(dstr) = SvCUR(sstr);
- SvLEN(dstr) = SvLEN(sstr);
+ SvCUR_set(dstr, SvCUR(sstr));
+ SvLEN_set(dstr, SvLEN(sstr));
SvIV_set(dstr, SvIVX(sstr));
SvNV_set(dstr, SvNVX(sstr));
- SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
+ SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
+ SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
Perl_rvpv_dup(aTHX_ dstr, sstr, param);
break;
case SVt_PVBM:
SvANY(dstr) = new_XPVBM();
- SvCUR(dstr) = SvCUR(sstr);
- SvLEN(dstr) = SvLEN(sstr);
+ SvCUR_set(dstr, SvCUR(sstr));
+ SvLEN_set(dstr, SvLEN(sstr));
SvIV_set(dstr, SvIVX(sstr));
SvNV_set(dstr, SvNVX(sstr));
- SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
+ SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
+ SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
Perl_rvpv_dup(aTHX_ dstr, sstr, param);
BmRARE(dstr) = BmRARE(sstr);
BmUSEFUL(dstr) = BmUSEFUL(sstr);
@@ -11063,12 +11068,12 @@
break;
case SVt_PVLV:
SvANY(dstr) = new_XPVLV();
- SvCUR(dstr) = SvCUR(sstr);
- SvLEN(dstr) = SvLEN(sstr);
+ SvCUR_set(dstr, SvCUR(sstr));
+ SvLEN_set(dstr, SvLEN(sstr));
SvIV_set(dstr, SvIVX(sstr));
SvNV_set(dstr, SvNVX(sstr));
- SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
+ SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
+ SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
Perl_rvpv_dup(aTHX_ dstr, sstr, param);
LvTARGOFF(dstr) = LvTARGOFF(sstr); /* XXX sometimes holds PMOP* when DEBUGGING */
LvTARGLEN(dstr) = LvTARGLEN(sstr);
@@ -11095,12 +11100,12 @@
}
}
SvANY(dstr) = new_XPVGV();
- SvCUR(dstr) = SvCUR(sstr);
- SvLEN(dstr) = SvLEN(sstr);
+ SvCUR_set(dstr, SvCUR(sstr));
+ SvLEN_set(dstr, SvLEN(sstr));
SvIV_set(dstr, SvIVX(sstr));
SvNV_set(dstr, SvNVX(sstr));
- SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
+ SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
+ SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
Perl_rvpv_dup(aTHX_ dstr, sstr, param);
GvNAMELEN(dstr) = GvNAMELEN(sstr);
GvNAME(dstr) = SAVEPVN(GvNAME(sstr), GvNAMELEN(sstr));
@@ -11111,12 +11116,12 @@
break;
case SVt_PVIO:
SvANY(dstr) = new_XPVIO();
- SvCUR(dstr) = SvCUR(sstr);
- SvLEN(dstr) = SvLEN(sstr);
+ SvCUR_set(dstr, SvCUR(sstr));
+ SvLEN_set(dstr, SvLEN(sstr));
SvIV_set(dstr, SvIVX(sstr));
SvNV_set(dstr, SvNVX(sstr));
- SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
+ SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
+ SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
Perl_rvpv_dup(aTHX_ dstr, sstr, param);
IoIFP(dstr) = fp_dup(IoIFP(sstr), IoTYPE(sstr), param);
if (IoOFP(sstr) == IoIFP(sstr))
@@ -11153,12 +11158,12 @@
break;
case SVt_PVAV:
SvANY(dstr) = new_XPVAV();
- SvCUR(dstr) = SvCUR(sstr);
- SvLEN(dstr) = SvLEN(sstr);
+ SvCUR_set(dstr, SvCUR(sstr));
+ SvLEN_set(dstr, SvLEN(sstr));
SvIV_set(dstr, SvIVX(sstr));
SvNV_set(dstr, SvNVX(sstr));
- SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
+ SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
+ SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
AvARYLEN((AV*)dstr) = sv_dup_inc(AvARYLEN((AV*)sstr), param);
AvFLAGS((AV*)dstr) = AvFLAGS((AV*)sstr);
if (AvARRAY((AV*)sstr)) {
@@ -11168,7 +11173,7 @@
src_ary = AvARRAY((AV*)sstr);
Newz(0, dst_ary, AvMAX((AV*)sstr)+1, SV*);
ptr_table_store(PL_ptr_table, src_ary, dst_ary);
- SvPVX(dstr) = (char*)dst_ary;
+ SvPV_set(dstr, (char*)dst_ary);
AvALLOC((AV*)dstr) = dst_ary;
if (AvREAL((AV*)sstr)) {
while (items-- > 0)
@@ -11184,18 +11189,18 @@
}
}
else {
- SvPVX(dstr) = Nullch;
+ SvPV_set(dstr, Nullch);
AvALLOC((AV*)dstr) = (SV**)NULL;
}
break;
case SVt_PVHV:
SvANY(dstr) = new_XPVHV();
- SvCUR(dstr) = SvCUR(sstr);
- SvLEN(dstr) = SvLEN(sstr);
+ SvCUR_set(dstr, SvCUR(sstr));
+ SvLEN_set(dstr, SvLEN(sstr));
SvIV_set(dstr, SvIVX(sstr));
SvNV_set(dstr, SvNVX(sstr));
- SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
+ SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
+ SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
HvRITER((HV*)dstr) = HvRITER((HV*)sstr);
if (HvARRAY((HV*)sstr)) {
STRLEN i = 0;
@@ -11213,7 +11218,7 @@
(bool)!!HvSHAREKEYS(sstr), param);
}
else {
- SvPVX(dstr) = Nullch;
+ SvPV_set(dstr, Nullch);
HvEITER((HV*)dstr) = (HE*)NULL;
}
HvPMROOT((HV*)dstr) = HvPMROOT((HV*)sstr); /* XXX */
@@ -11230,12 +11235,12 @@
case SVt_PVCV:
SvANY(dstr) = new_XPVCV();
dup_pvcv:
- SvCUR(dstr) = SvCUR(sstr);
- SvLEN(dstr) = SvLEN(sstr);
+ SvCUR_set(dstr, SvCUR(sstr));
+ SvLEN_set(dstr, SvLEN(sstr));
SvIV_set(dstr, SvIVX(sstr));
SvNV_set(dstr, SvNVX(sstr));
- SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
- SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
+ SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
+ SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
Perl_rvpv_dup(aTHX_ dstr, sstr, param);
CvSTASH(dstr) = hv_dup(CvSTASH(sstr), param); /* NOTE: not refcounted */
CvSTART(dstr) = CvSTART(sstr);
@@ -11912,9 +11917,9 @@
SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
SvFLAGS(&PL_sv_no) = SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
- SvPVX(&PL_sv_no) = SAVEPVN(PL_No, 0);
- SvCUR(&PL_sv_no) = 0;
- SvLEN(&PL_sv_no) = 1;
+ SvPV_set(&PL_sv_no, SAVEPVN(PL_No, 0));
+ SvCUR_set(&PL_sv_no, 0);
+ SvLEN_set(&PL_sv_no, 1);
SvIV_set(&PL_sv_no, 0);
SvNV_set(&PL_sv_no, 0);
ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no);
@@ -11923,9 +11928,9 @@
SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
SvFLAGS(&PL_sv_yes) = SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV;
- SvPVX(&PL_sv_yes) = SAVEPVN(PL_Yes, 1);
- SvCUR(&PL_sv_yes) = 1;
- SvLEN(&PL_sv_yes) = 2;
+ SvPV_set(&PL_sv_yes, SAVEPVN(PL_Yes, 1));
+ SvCUR_set(&PL_sv_yes, 1);
+ SvLEN_set(&PL_sv_yes, 2);
SvIV_set(&PL_sv_yes, 1);
SvNV_set(&PL_sv_yes, 1);
ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
1.65 +27 -4 ponie/perl/sv.h
Index: sv.h
===================================================================
RCS file: /cvs/public/ponie/perl/sv.h,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -r1.64 -r1.65
--- sv.h 12 Apr 2005 11:12:13 -0000 1.64
+++ sv.h 19 Apr 2005 19:04:13 -0000 1.65
@@ -861,24 +861,26 @@
#define SvREPADTMP_off(sv) (SvFLAGS(sv) &= ~SVf_FAKE)
#endif
-#define SvRV(sv) (* Perl_macro_SvRV(aTHX_ (SV*) (sv)))
-#define SvRVx(sv) SvRV(sv)
#ifdef PERL_CORE
+#define SvRV(sv) (0 + * Perl_macro_SvRV(aTHX_ (SV*) (sv)))
#define SvIVX(sv) (0 + * Perl_macro_SvIVX(aTHX_ (SV*) (sv)))
#define SvUVX(sv) (0 + * Perl_macro_SvUVX(aTHX_ (SV*) (sv)))
#define SvNVX(sv) (0.0 + * Perl_macro_SvNVX(aTHX_ (SV*) (sv)))
+#define SvPVX(sv) (0 + * Perl_macro_SvPVX(aTHX_ (SV*) (sv)))
#else
+#define SvRV(sv) (* Perl_macro_SvRV(aTHX_ (SV*) (sv)))
#define SvIVX(sv) (* Perl_macro_SvIVX(aTHX_ (SV*) (sv)))
#define SvUVX(sv) (* Perl_macro_SvUVX(aTHX_ (SV*) (sv)))
#define SvNVX(sv) (* Perl_macro_SvNVX(aTHX_ (SV*) (sv)))
+#define SvPVX(sv) (* Perl_macro_SvPVX(aTHX_ (SV*) (sv)))
#endif
+#define SvRVx(sv) SvRV(sv)
#define SvIVXx(sv) SvIVX(sv)
#define SvUVXx(sv) SvUVX(sv)
#define SvNVXx(sv) SvNVX(sv)
-#define SvPVX(sv) (* Perl_macro_SvPVX(aTHX_ (SV*) (sv)))
#define SvPVXx(sv) SvPVX(sv)
#define SvCUR(sv) ( * Perl_macro_SvCUR(aTHX_ (SV*) (sv)))
#define SvLEN(sv) ( * Perl_macro_SvLEN(aTHX_ (SV*) (sv)))
@@ -905,7 +907,16 @@
(* Perl_macro_SvNVX(aTHX_ (SV*) (sv)) = (val)); } STMT_END
#define SvPV_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
- (SvPVX(sv) = (val)); } STMT_END
+ (* Perl_macro_SvPVX(aTHX_ (SV*) (sv)) = (val)); } STMT_END
+#define SvRV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
+ (* Perl_macro_SvRV(aTHX_ (SV*) (sv)) = (val)); } STMT_END
+#define SvMAGIC_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
+ (* Perl_macro_SvMAGIC(aTHX_ (SV*) (sv)) = (val)); } STMT_END
+#define SvSTASH_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
+ (* Perl_macro_SvSTASH(aTHX_ (SV*) (sv)) = (val)); } STMT_END
#define SvCUR_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
(SvCUR(sv) = (val)); } STMT_END
@@ -916,6 +927,18 @@
STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
(SvCUR(sv) = (val) - SvPVX(sv)); } STMT_END
+#define SvPV_renew(sv,n) \
+ STMT_START { SvLEN_set(sv, n); \
+ SvPV_set((sv), (MEM_WRAP_CHECK_(n,char) \
+ (char*)saferealloc((Malloc_t)SvPVX(sv), \
+ (MEM_SIZE)((n))))); \
+ } STMT_END
+
+#define SvPV_shrink_to_cur(sv) STMT_START { \
+ const STRLEN _lEnGtH = SvCUR(sv) + 1; \
+ SvPV_renew(sv, _lEnGtH); \
+ } STMT_END
+
#define BmRARE(sv) ((XPVBM*) SvANY(sv))->xbm_rare
#define BmUSEFUL(sv) ((XPVBM*) SvANY(sv))->xbm_useful
#define BmPREVIOUS(sv) ((XPVBM*) SvANY(sv))->xbm_previous
1.3 +14 -7 ponie/perl/toke.c
Index: toke.c
===================================================================
RCS file: /cvs/public/ponie/perl/toke.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- toke.c 10 Apr 2005 04:17:49 -0000 1.2
+++ toke.c 19 Apr 2005 19:04:13 -0000 1.3
@@ -1825,8 +1825,7 @@
/* shrink the sv if we allocated more than we used */
if (SvCUR(sv) + 5 < SvLEN(sv)) {
- SvLEN_set(sv, SvCUR(sv) + 1);
- Renew(SvPVX(sv), SvLEN(sv), char);
+ SvPV_shrink_to_cur(sv);
}
/* return the substring (via yylval) only if we parsed anything */
@@ -5268,7 +5267,7 @@
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Illegal character in prototype for %"SVf" : %s",
PL_subname, d);
- SvCUR(PL_lex_stuff) = tmp;
+ SvCUR_set(PL_lex_stuff, tmp);
have_proto = TRUE;
s = skipspace(s);
@@ -9603,8 +9602,7 @@
retval:
PL_multi_end = CopLINE(PL_curcop);
if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
- SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
- Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
+ SvPV_shrink_to_cur(tmpstr);
}
SvREFCNT_dec(herewas);
if (!IN_BYTES) {
@@ -10080,7 +10078,7 @@
/* if we allocated too much space, give some back */
if (SvCUR(sv) + 5 < SvLEN(sv)) {
SvLEN_set(sv, SvCUR(sv) + 1);
- Renew(SvPVX(sv), SvLEN(sv), char);
+ SvPV_renew(sv, SvLEN(sv));
}
/* decide whether this is the first or second quoted string we've read
@@ -10541,7 +10539,7 @@
char *end = SvPVX(stuff) + SvCUR(stuff);
end[-2] = '\n';
end[-1] = '\0';
- SvCUR(stuff)--;
+ SvCUR_set(stuff, SvCUR(stuff) - 1);
}
#endif
}
@@ -10975,3 +10973,12 @@
return (char *)s;
}
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * vim: shiftwidth=4:
+*/