X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=2d6d84d8c16f17b2d0719435a40809a9663072f2;hb=2522aa67345a7f37d0050d70f341ab3a0b6165b0;hp=b9e9cfa219f90dcb4ff580d438e9adca39ba6bd7;hpb=662fb8b24094b55abe53130309c03b869194e0f3;p=p5sagit%2Fp5-mst-13.2.git diff --git a/sv.c b/sv.c index b9e9cfa..2d6d84d 100644 --- a/sv.c +++ b/sv.c @@ -1106,27 +1106,25 @@ S_more_bodies (pTHX_ void **arena_root, void **root, size_t size) /* 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. @@ -1141,8 +1139,10 @@ S_del_body(pTHX_ void *thing, void **root, size_t offset) #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 @@ -1165,20 +1165,17 @@ S_del_body(pTHX_ void *thing, void **root, size_t offset) 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) @@ -1221,7 +1218,7 @@ S_del_body(pTHX_ void *thing, void **root, size_t offset) #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) @@ -1230,10 +1227,10 @@ S_del_body(pTHX_ void *thing, void **root, size_t offset) #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) @@ -1242,16 +1239,16 @@ S_del_body(pTHX_ void *thing, void **root, size_t offset) #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 */ @@ -1278,7 +1275,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) 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; @@ -1355,8 +1356,9 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) 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; @@ -1386,7 +1388,9 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) 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, @@ -1400,7 +1404,9 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) 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"); @@ -1523,41 +1529,43 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) 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); @@ -1568,7 +1576,8 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 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 } } @@ -10094,7 +10103,7 @@ Perl_ptr_table_new(pTHX) #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 */ @@ -10503,8 +10512,10 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param) 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; @@ -10642,12 +10653,13 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param) 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 { @@ -11572,7 +11584,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, 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;