/* grab a new thing from the free list, allocating more if necessary */
STATIC void *
-S_new_body(pTHX_ void **arena_root, void **root, size_t size, size_t offset)
+S_new_body(pTHX_ void **arena_root, void **root, size_t size)
{
void *xpv;
LOCK_SV_MUTEX;
xpv = *root ? *root : S_more_bodies(aTHX_ arena_root, root, size);
*root = *(void**)xpv;
UNLOCK_SV_MUTEX;
- return (void*)((char*)xpv - offset);
+ return xpv;
}
/* return a thing to the free list */
-STATIC void
-S_del_body(pTHX_ void *thing, void **root, size_t offset)
-{
- void **real_thing = (void**)((char *)thing + offset);
- LOCK_SV_MUTEX;
- *real_thing = *root;
- *root = (void*)real_thing;
- UNLOCK_SV_MUTEX;
-}
+#define del_body(thing, root) \
+ STMT_START { \
+ LOCK_SV_MUTEX; \
+ *(void **)thing = *root; \
+ *root = (void*)thing; \
+ UNLOCK_SV_MUTEX; \
+ } STMT_END
/* Conventionally we simply malloc() a big block of memory, then divide it
up into lots of the thing that we're allocating.
#define new_body(TYPE,lctype) \
S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot, \
(void**)&PL_ ## lctype ## _root, \
- sizeof(TYPE), \
- 0)
+ sizeof(TYPE))
+
+#define del_body_type(p,TYPE,lctype) \
+ del_body((void*)p, (void**)&PL_ ## lctype ## _root)
/* But for some types, we cheat. The type starts with some members that are
never accessed. So we allocate the substructure, starting at the first used
no longer allocated. */
#define new_body_allocated(TYPE,lctype,member) \
- S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot, \
- (void**)&PL_ ## lctype ## _root, \
- sizeof(lctype ## _allocated), \
- STRUCT_OFFSET(TYPE, member) \
- - STRUCT_OFFSET(lctype ## _allocated, member))
-
+ (void*)((char*)S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot, \
+ (void**)&PL_ ## lctype ## _root, \
+ sizeof(lctype ## _allocated)) - \
+ STRUCT_OFFSET(TYPE, member) \
+ + STRUCT_OFFSET(lctype ## _allocated, member))
-#define del_body(p,TYPE,lctype) \
- S_del_body(aTHX_ (void*)p, (void**)&PL_ ## lctype ## _root, 0)
#define del_body_allocated(p,TYPE,lctype,member) \
- S_del_body(aTHX_ (void*)p, (void**)&PL_ ## lctype ## _root, \
- STRUCT_OFFSET(TYPE, member) \
- - STRUCT_OFFSET(lctype ## _allocated, member))
+ del_body((void*)((char*)p + STRUCT_OFFSET(TYPE, member) \
+ - STRUCT_OFFSET(lctype ## _allocated, member)), \
+ (void**)&PL_ ## lctype ## _root)
#define my_safemalloc(s) (void*)safemalloc(s)
#define my_safefree(p) safefree((char*)p)
#else /* !PURIFY */
#define new_XNV() new_body(NV, xnv)
-#define del_XNV(p) del_body(p, NV, xnv)
+#define del_XNV(p) del_body_type(p, NV, xnv)
#define new_XPV() new_body_allocated(XPV, xpv, xpv_cur)
#define del_XPV(p) del_body_allocated(p, XPV, xpv, xpv_cur)
#define del_XPVIV(p) del_body_allocated(p, XPVIV, xpviv, xpv_cur)
#define new_XPVNV() new_body(XPVNV, xpvnv)
-#define del_XPVNV(p) del_body(p, XPVNV, xpvnv)
+#define del_XPVNV(p) del_body_type(p, XPVNV, xpvnv)
#define new_XPVCV() new_body(XPVCV, xpvcv)
-#define del_XPVCV(p) del_body(p, XPVCV, xpvcv)
+#define del_XPVCV(p) del_body_type(p, XPVCV, xpvcv)
#define new_XPVAV() new_body_allocated(XPVAV, xpvav, xav_fill)
#define del_XPVAV(p) del_body_allocated(p, XPVAV, xpvav, xav_fill)
#define del_XPVHV(p) del_body_allocated(p, XPVHV, xpvhv, xhv_fill)
#define new_XPVMG() new_body(XPVMG, xpvmg)
-#define del_XPVMG(p) del_body(p, XPVMG, xpvmg)
+#define del_XPVMG(p) del_body_type(p, XPVMG, xpvmg)
#define new_XPVGV() new_body(XPVGV, xpvgv)
-#define del_XPVGV(p) del_body(p, XPVGV, xpvgv)
+#define del_XPVGV(p) del_body_type(p, XPVGV, xpvgv)
#define new_XPVLV() new_body(XPVLV, xpvlv)
-#define del_XPVLV(p) del_body(p, XPVLV, xpvlv)
+#define del_XPVLV(p) del_body_type(p, XPVLV, xpvlv)
#define new_XPVBM() new_body(XPVBM, xpvbm)
-#define del_XPVBM(p) del_body(p, XPVBM, xpvbm)
+#define del_XPVBM(p) del_body_type(p, XPVBM, xpvbm)
#endif /* PURIFY */
size_t old_body_offset;
size_t old_body_length; /* Well, the length to copy. */
void* old_body;
+#ifndef NV_ZERO_IS_ALLBITS_ZERO
+ /* If NV 0.0 is store as all bits 0 then Zero() already creates a correct
+ 0.0 for us. */
bool zero_nv = TRUE;
+#endif
void* new_body;
size_t new_body_length;
size_t new_body_offset;
case SVt_NV:
old_body_arena = (void **) &PL_xnv_root;
old_body_length = sizeof(NV);
+#ifndef NV_ZERO_IS_ALLBITS_ZERO
zero_nv = FALSE;
-
+#endif
if (mt < SVt_PVNV)
mt = SVt_PVNV;
break;
old_body_arena = (void **) &PL_xpvnv_root;
old_body_length = STRUCT_OFFSET(XPVNV, xiv_u)
+ sizeof (((XPVNV*)SvANY(sv))->xiv_u);
+#ifndef NV_ZERO_IS_ALLBITS_ZERO
zero_nv = FALSE;
+#endif
break;
case SVt_PVMG:
/* Because the XPVMG of PL_mess_sv isn't allocated from the arena,
old_body_arena = (void **) &PL_xpvmg_root;
old_body_length = STRUCT_OFFSET(XPVMG, xmg_stash)
+ sizeof (((XPVMG*)SvANY(sv))->xmg_stash);
+#ifndef NV_ZERO_IS_ALLBITS_ZERO
zero_nv = FALSE;
+#endif
break;
default:
Perl_croak(aTHX_ "Can't upgrade that kind of scalar");
new_body_arenaroot = (void **) &PL_xpv_arenaroot;
new_body_no_NV:
/* PV and PVIV don't have an NV slot. */
+#ifndef NV_ZERO_IS_ALLBITS_ZERO
zero_nv = FALSE;
+#endif
- {
- new_body:
- assert(new_body_length);
+ new_body:
+ assert(new_body_length);
#ifndef PURIFY
- new_body = S_new_body(aTHX_ new_body_arenaroot, new_body_arena,
- new_body_length, new_body_offset);
+ /* This points to the start of the allocated area. */
+ new_body = S_new_body(aTHX_ new_body_arenaroot, new_body_arena,
+ new_body_length);
#else
- /* We always allocated the full length item with PURIFY */
- new_body_length += new_body_offset;
- new_body_offset = 0;
- new_body = my_safemalloc(new_body_length);
+ /* We always allocated the full length item with PURIFY */
+ new_body_length += new_body_offset;
+ new_body_offset = 0;
+ new_body = my_safemalloc(new_body_length);
#endif
- zero:
- Zero(((char *)new_body) + new_body_offset, new_body_length, char);
- SvANY(sv) = new_body;
-
- if (old_body_length) {
- Copy((char *)old_body + old_body_offset,
- (char *)new_body + old_body_offset,
- old_body_length, char);
- }
-
- /* FIXME - add a Configure test to determine if NV 0.0 is actually
- all bits zero. If it is, we can skip this initialisation. */
- if (zero_nv)
- SvNV_set(sv, 0);
+ zero:
+ Zero(new_body, new_body_length, char);
+ new_body = ((char *)new_body) - new_body_offset;
+ SvANY(sv) = new_body;
- if (mt == SVt_PVIO)
- IoPAGE_LEN(sv) = 60;
- if (old_type < SVt_RV)
- SvPV_set(sv, 0);
+ if (old_body_length) {
+ Copy((char *)old_body + old_body_offset,
+ (char *)new_body + old_body_offset,
+ old_body_length, char);
}
+
+#ifndef NV_ZERO_IS_ALLBITS_ZERO
+ if (zero_nv)
+ SvNV_set(sv, 0);
+#endif
+
+ if (mt == SVt_PVIO)
+ IoPAGE_LEN(sv) = 60;
+ if (old_type < SVt_RV)
+ SvPV_set(sv, 0);
break;
default:
Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu", mt);
#ifdef PURIFY
my_safefree(old_body);
#else
- S_del_body(aTHX_ old_body, old_body_arena, old_body_offset);
+ del_body((void*)((char*)old_body + old_body_offset),
+ old_body_arena);
#endif
}
}
#endif
#define new_pte() new_body(struct ptr_tbl_ent, pte)
-#define del_pte(p) del_body(p, struct ptr_tbl_ent, pte)
+#define del_pte(p) del_body_type(p, struct ptr_tbl_ent, pte)
/* map an existing pointer using a table */
new_body:
assert(new_body_length);
#ifndef PURIFY
- new_body = S_new_body(aTHX_ new_body_arenaroot, new_body_arena,
- new_body_length, new_body_offset);
+ new_body = (void*)((char*)S_new_body(aTHX_ new_body_arenaroot,
+ new_body_arena,
+ new_body_length)
+ - new_body_offset);
#else
/* We always allocated the full length item with PURIFY */
new_body_length += new_body_offset;
SvFLAGS(dstr) |= SVf_OOK;
hvname = saux->xhv_name;
- daux->xhv_name = hvname ? hek_dup(hvname, param) : hvname;
+ daux->xhv_name
+ = hvname ? hek_dup(hvname, param) : hvname;
daux->xhv_riter = saux->xhv_riter;
daux->xhv_eiter = saux->xhv_eiter
- ? he_dup(saux->xhv_eiter, (bool)!!HvSHAREKEYS(sstr),
- param) : 0;
+ ? he_dup(saux->xhv_eiter,
+ (bool)!!HvSHAREKEYS(sstr), param) : 0;
}
}
else {
PL_mess_sv = Nullsv;
PL_ors_sv = sv_dup_inc(proto_perl->Iors_sv, param);
- PL_ofmt = SAVEPV(proto_perl->Iofmt);
/* interpreter atexit processing */
PL_exitlistlen = proto_perl->Iexitlistlen;
projects / p5sagit/p5-mst-13.2.git / blobdiff