From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 17 Nov 2005 22:50:07 +0000 (+0000)
Subject: "Can you see what it is yet?"
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a2fd015ef0ad9c0113b835ff60d62684050408f4;p=p5sagit%2Fp5-mst-13.2.git
"Can you see what it is yet?"
Next steps towards making as much as possible table driven.
p4raw-id: //depot/perl@26151
---
diff --git a/sv.c b/sv.c
index 7267fa7..148dcec 100644
--- a/sv.c
+++ b/sv.c
@@ -1227,56 +1227,58 @@ struct body_details {
size_t size; /* Size to allocate */
size_t copy; /* Size of structure to copy (may be shorter) */
int offset;
+ bool cant_upgrade; /* Can upgrade this type */
+ bool zero_nv; /* zero the NV when upgrading from this */
};
struct body_details bodies_by_type[] = {
- {0, 0, 0},
+ {0, 0, 0, FALSE, TRUE},
/* IVs are in the head, so the allocation size is 0 */
- {0, sizeof(IV), STRUCT_OFFSET(XPVIV, xiv_iv)},
+ {0, sizeof(IV), STRUCT_OFFSET(XPVIV, xiv_iv), FALSE, TRUE},
/* 8 bytes on most ILP32 with IEEE doubles */
- {sizeof(NV), sizeof(NV), 0},
+ {sizeof(NV), sizeof(NV), 0, FALSE, FALSE},
/* RVs are in the head now */
- {0, 0, 0},
+ {0, 0, 0, FALSE, TRUE},
/* 8 bytes on most ILP32 with IEEE doubles */
{sizeof(xpv_allocated),
STRUCT_OFFSET(XPV, xpv_len) + sizeof (((XPV*)SvANY((SV*)0))->xpv_len)
- - STRUCT_OFFSET(xpv_allocated, xpv_cur) + STRUCT_OFFSET(XPV, xpv_cur),
+ + STRUCT_OFFSET(xpv_allocated, xpv_cur) - STRUCT_OFFSET(XPV, xpv_cur),
+ STRUCT_OFFSET(xpv_allocated, xpv_cur) - STRUCT_OFFSET(XPV, xpv_cur)
- },
+ , FALSE, TRUE},
/* 12 */
{sizeof(xpviv_allocated),
STRUCT_OFFSET(XPVIV, xiv_u) + sizeof (((XPVIV*)SvANY((SV*)0))->xiv_u)
- - STRUCT_OFFSET(xpviv_allocated, xpv_cur) + STRUCT_OFFSET(XPVIV, xpv_cur),
+ + STRUCT_OFFSET(xpviv_allocated, xpv_cur) - STRUCT_OFFSET(XPVIV, xpv_cur),
+ STRUCT_OFFSET(xpviv_allocated, xpv_cur) - STRUCT_OFFSET(XPVIV, xpv_cur)
- },
+ , FALSE, TRUE},
/* 20 */
{sizeof(XPVNV),
STRUCT_OFFSET(XPVNV, xiv_u) + sizeof (((XPVNV*)SvANY((SV*)0))->xiv_u),
- 0},
+ 0, FALSE, FALSE},
/* 28 */
{sizeof(XPVMG),
STRUCT_OFFSET(XPVMG, xmg_stash) + sizeof (((XPVMG*)SvANY((SV*)0))->xmg_stash),
- 0},
+ 0, FALSE, FALSE},
/* 36 */
- {sizeof(XPVBM), 0, 0},
+ {sizeof(XPVBM), 0, 0, TRUE, FALSE},
/* 48 */
- {sizeof(XPVGV), 0, 0},
+ {sizeof(XPVGV), 0, 0, TRUE, FALSE},
/* 64 */
- {sizeof(XPVLV), 0, 0},
+ {sizeof(XPVLV), 0, 0, TRUE, FALSE},
/* 20 */
{sizeof(xpvav_allocated), 0,
STRUCT_OFFSET(xpvav_allocated, xav_fill)
- - STRUCT_OFFSET(XPVAV, xav_fill)},
+ - STRUCT_OFFSET(XPVAV, xav_fill), TRUE, FALSE},
/* 20 */
{sizeof(xpvhv_allocated), 0,
STRUCT_OFFSET(xpvhv_allocated, xhv_fill)
- - STRUCT_OFFSET(XPVHV, xhv_fill)},
+ - STRUCT_OFFSET(XPVHV, xhv_fill), TRUE, FALSE},
/* 76 */
- {sizeof(XPVCV), 0, 0},
+ {sizeof(XPVCV), 0, 0, TRUE, FALSE},
/* 80 */
- {sizeof(XPVFM), 0, 0},
+ {sizeof(XPVFM), 0, 0, TRUE, FALSE},
/* 84 */
- {sizeof(XPVIO), 0, 0}
+ {sizeof(XPVIO), 0, 0, TRUE, FALSE}
};
#define new_body_type(sv_type) \
@@ -1396,17 +1398,14 @@ 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;
void** new_body_arena;
void** new_body_arenaroot;
const U32 old_type = SvTYPE(sv);
+ const struct body_details *const old_type_details
+ = bodies_by_type + old_type;
if (mt != SVt_PV && SvIsCOW(sv)) {
sv_force_normal_flags(sv, 0);
@@ -1471,15 +1470,12 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
mt = SVt_PVNV;
else if (mt < SVt_PVIV)
mt = SVt_PVIV;
- old_body_offset = bodies_by_type[old_type].offset;
- old_body_length = bodies_by_type[old_type].copy;
+ old_body_offset = old_type_details->offset;
+ old_body_length = old_type_details->copy;
break;
case SVt_NV:
old_body_arena = &PL_body_roots[old_type];
- old_body_length = bodies_by_type[old_type].copy;
-#ifndef NV_ZERO_IS_ALLBITS_ZERO
- zero_nv = FALSE;
-#endif
+ old_body_length = old_type_details->copy;
if (mt < SVt_PVNV)
mt = SVt_PVNV;
break;
@@ -1488,9 +1484,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
case SVt_PV:
old_body_arena = &PL_body_roots[SVt_PV];
old_body_offset = - bodies_by_type[SVt_PV].offset;
- old_body_length = STRUCT_OFFSET(XPV, xpv_len)
- + sizeof (((XPV*)SvANY(sv))->xpv_len)
- - old_body_offset;
+ old_body_length = bodies_by_type[SVt_PV].copy;
if (mt <= SVt_IV)
mt = SVt_PVIV;
else if (mt == SVt_NV)
@@ -1499,17 +1493,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
case SVt_PVIV:
old_body_arena = &PL_body_roots[SVt_PVIV];
old_body_offset = - bodies_by_type[SVt_PVIV].offset;
- old_body_length = STRUCT_OFFSET(XPVIV, xiv_u);
- old_body_length += sizeof (((XPVIV*)SvANY(sv))->xiv_u);
- old_body_length -= old_body_offset;
+ old_body_length = bodies_by_type[SVt_PVIV].copy;
break;
case SVt_PVNV:
old_body_arena = &PL_body_roots[SVt_PVNV];
- old_body_length = STRUCT_OFFSET(XPVNV, xiv_u)
- + sizeof (((XPVNV*)SvANY(sv))->xiv_u);
-#ifndef NV_ZERO_IS_ALLBITS_ZERO
- zero_nv = FALSE;
-#endif
+ old_body_length = bodies_by_type[SVt_PVNV].copy;
break;
case SVt_PVMG:
/* Because the XPVMG of PL_mess_sv isn't allocated from the arena,
@@ -1521,14 +1509,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
on anything that can get upgraded. */
assert((SvFLAGS(sv) & SVpad_TYPED) == 0);
old_body_arena = &PL_body_roots[SVt_PVMG];
- old_body_length = STRUCT_OFFSET(XPVMG, xmg_stash)
- + sizeof (((XPVMG*)SvANY(sv))->xmg_stash);
-#ifndef NV_ZERO_IS_ALLBITS_ZERO
- zero_nv = FALSE;
-#endif
+ old_body_length = bodies_by_type[SVt_PVMG].copy;
break;
default:
- Perl_croak(aTHX_ "Can't upgrade that kind of scalar");
+ if (old_type_details->cant_upgrade)
+ Perl_croak(aTHX_ "Can't upgrade that kind of scalar");
}
SvFLAGS(sv) &= ~SVTYPEMASK;
@@ -1627,9 +1612,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
new_body_arenaroot = &PL_body_arenaroots[SVt_PV];
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);
@@ -1655,7 +1637,9 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
}
#ifndef NV_ZERO_IS_ALLBITS_ZERO
- if (zero_nv)
+ /* If NV 0.0 is store as all bits 0 then Zero() already creates a correct
+ 0.0 for us. */
+ if (old_type_details->zero_nv)
SvNV_set(sv, 0);
#endif