Skip to content

Commit 24c3369

Browse files
leonerdleonerd
committed
Create a specific SV type for object instances
1 parent 99b497a commit 24c3369

File tree

9 files changed

+148
-31
lines changed

9 files changed

+148
-31
lines changed

‎class.c

+24-8
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,20 @@ Perl_croak_kw_unless_class(pTHX_ const char *kw)
3030
croak("Cannot '%s' outside of a 'class'", kw);
3131
}
3232

33+
#define newSVobject(fieldcount) Perl_newSVobject(aTHX_ fieldcount)
34+
SV *
35+
Perl_newSVobject(pTHX_ Size_t fieldcount)
36+
{
37+
SV *sv = newSV_type(SVt_PVOBJ);
38+
39+
Newx(ObjectFIELDS(sv), fieldcount, SV *);
40+
ObjectMAXFIELD(sv) = fieldcount - 1;
41+
42+
Zero(ObjectFIELDS(sv), fieldcount, SV *);
43+
44+
return sv;
45+
}
46+
3347
XS(injected_constructor);
3448
XS(injected_constructor)
3549
{
@@ -65,10 +79,12 @@ XS(injected_constructor)
6579
}
6680
}
6781

68-
AV *fields = newAV();
69-
SV *self = sv_2mortal(newRV_noinc((SV *)fields));
82+
SV *instance = newSVobject(aux->xhv_class_next_fieldix);
83+
SV *self = sv_2mortal(newRV_noinc(instance));
7084
sv_bless(self, stash);
7185

86+
SV **fields = ObjectFIELDS(instance);
87+
7288
/* create fields */
7389
for(PADOFFSET fieldix = 0; fieldix < aux->xhv_class_next_fieldix; fieldix++) {
7490
PADNAME *pn = PadnamelistARRAY(aux->xhv_class_fields)[fieldix];
@@ -93,7 +109,7 @@ XS(injected_constructor)
93109
NOT_REACHED;
94110
}
95111

96-
av_push(fields, val);
112+
fields[fieldix] = val;
97113
}
98114

99115
if(aux->xhv_class_adjust_blocks) {
@@ -164,7 +180,7 @@ PP(pp_methstart)
164180

165181
if(!SvROK(self) ||
166182
!SvOBJECT((rv = SvRV(self))) ||
167-
SvTYPE(rv) != SVt_PVAV) { /* TODO: SVt_INSTANCE */
183+
SvTYPE(rv) != SVt_PVOBJ) {
168184
HEK *namehek = CvGvNAME_HEK(curcv);
169185
croak(
170186
namehek ? "Cannot invoke method %" HEKf_QUOTEDPREFIX " on a non-instance" :
@@ -182,14 +198,14 @@ PP(pp_methstart)
182198

183199
UNOP_AUX_item *aux = cUNOP_AUX->op_aux;
184200
if(aux) {
185-
assert(SvTYPE(SvRV(self)) == SVt_PVAV);
186-
AV *fields = MUTABLE_AV(SvRV(self));
187-
SV **fieldp = AvARRAY(fields);
201+
assert(SvTYPE(SvRV(self)) == SVt_PVOBJ);
202+
SV *instance = SvRV(self);
203+
SV **fieldp = ObjectFIELDS(instance);
188204

189205
U32 fieldcount = (aux++)->uv;
190206
U32 max_fieldix = (aux++)->uv;
191207

192-
assert(av_count(fields) > max_fieldix);
208+
assert(ObjectMAXFIELD(instance)+1 > max_fieldix);
193209
PERL_UNUSED_VAR(max_fieldix);
194210

195211
for(Size_t i = 0; i < fieldcount; i++) {

‎dump.c

+30-7
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,8 @@ static const char* const svtypenames[SVt_LAST] = {
4545
"PVHV",
4646
"PVCV",
4747
"PVFM",
48-
"PVIO"
48+
"PVIO",
49+
"PVOBJ",
4950
};
5051

5152

@@ -65,7 +66,8 @@ static const char* const svshorttypenames[SVt_LAST] = {
6566
"HV",
6667
"CV",
6768
"FM",
68-
"IO"
69+
"IO",
70+
"OBJ",
6971
};
7072

7173
struct flag_to_name {
@@ -2004,8 +2006,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
20042006

20052007
/* Dump general SV fields */
20062008

2007-
if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
2008-
&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO
2009+
if ((type >= SVt_PVIV && type <= SVt_PVLV
20092010
&& type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
20102011
|| (type == SVt_IV && !SvROK(sv))) {
20112012
if (SvIsUV(sv)
@@ -2016,9 +2017,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
20162017
(void)PerlIO_putc(file, '\n');
20172018
}
20182019

2019-
if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV
2020-
&& type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP
2021-
&& type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
2020+
if ((type >= SVt_PVNV && type <= SVt_PVLV
2021+
&& type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv))
20222022
|| type == SVt_NV) {
20232023
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
20242024
STORE_LC_NUMERIC_SET_STANDARD();
@@ -2704,6 +2704,29 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
27042704
maxnest, dumpops, pvlim);
27052705
}
27062706
break;
2707+
case SVt_PVOBJ:
2708+
Perl_dump_indent(aTHX_ level, file, " MAXFIELD = %" IVdf "\n",
2709+
(IV)ObjectMAXFIELD(sv));
2710+
Perl_dump_indent(aTHX_ level, file, " FIELDS = 0x%" UVxf "\n",
2711+
PTR2UV(ObjectFIELDS(sv)));
2712+
if (nest < maxnest && ObjectFIELDS(sv)) {
2713+
SSize_t count;
2714+
SV **svp = ObjectFIELDS(sv);
2715+
PADNAME **pname = PadnamelistARRAY(HvAUX(SvSTASH(sv))->xhv_class_fields);
2716+
for (count = 0;
2717+
count <= ObjectMAXFIELD(sv) && count < maxnest;
2718+
count++, svp++)
2719+
{
2720+
SV *const field = *svp;
2721+
PADNAME *pn = pname[count];
2722+
2723+
Perl_dump_indent(aTHX_ level + 1, file, "Field No. %" IVdf " (%s)\n",
2724+
(IV)count, PadnamePV(pn));
2725+
2726+
do_sv_dump(level+1, file, field, nest+1, maxnest, dumpops, pvlim);
2727+
}
2728+
}
2729+
break;
27072730
}
27082731
SvREFCNT_dec_NN(d);
27092732
}

‎ext/B/B.pm

+2-1
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ sub import {
2020
# walkoptree comes from B.xs
2121

2222
BEGIN {
23-
$B::VERSION = '1.87';
23+
$B::VERSION = '1.88';
2424
@B::EXPORT_OK = ();
2525

2626
# Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
@@ -62,6 +62,7 @@ push @B::EXPORT_OK, (qw(minus_c ppname save_BEGINs
6262
@B::CV::ISA = 'B::PVMG';
6363
@B::IO::ISA = 'B::PVMG';
6464
@B::FM::ISA = 'B::CV';
65+
@B::OBJ::ISA = 'B::PVMG';
6566

6667
@B::OP::ISA = 'B::OBJECT';
6768
@B::UNOP::ISA = 'B::OP';

‎ext/B/B.xs

+1
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@ static const char* const svclassnames[] = {
4040
"B::CV",
4141
"B::FM",
4242
"B::IO",
43+
"B::OBJ",
4344
};
4445

4546

‎perl.h

+8-7
Original file line numberDiff line numberDiff line change
@@ -3249,6 +3249,7 @@ typedef struct xpvcv XPVCV;
32493249
typedef struct xpvbm XPVBM;
32503250
typedef struct xpvfm XPVFM;
32513251
typedef struct xpvio XPVIO;
3252+
typedef struct xobject XPVOBJ;
32523253
typedef struct mgvtbl MGVTBL;
32533254
typedef union any ANY;
32543255
typedef struct ptr_tbl_ent PTR_TBL_ENT_t;
@@ -6256,19 +6257,19 @@ EXTCONST U8 PL_magic_data[256];
62566257
#endif
62576258

62586259
#ifdef DOINIT
6259-
/* NL IV NV PV INV PI PN MG RX GV LV AV HV CV FM IO */
6260+
/* NL IV NV PV INV PI PN MG RX GV LV AV HV CV FM IO OBJ */
62606261
EXTCONST bool
6261-
PL_valid_types_IVX[] = { 0, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
6262+
PL_valid_types_IVX[] = { 0, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0 };
62626263
EXTCONST bool
6263-
PL_valid_types_NVX[] = { 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0 };
6264+
PL_valid_types_NVX[] = { 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0 };
62646265
EXTCONST bool
6265-
PL_valid_types_PVX[] = { 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1 };
6266+
PL_valid_types_PVX[] = { 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0 };
62666267
EXTCONST bool
6267-
PL_valid_types_RV[] = { 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1 };
6268+
PL_valid_types_RV[] = { 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0 };
62686269
EXTCONST bool
6269-
PL_valid_types_IV_set[] = { 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1 };
6270+
PL_valid_types_IV_set[] = { 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 0 };
62706271
EXTCONST bool
6271-
PL_valid_types_NV_set[] = { 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 };
6272+
PL_valid_types_NV_set[] = { 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0 };
62726273

62736274
EXTCONST U8
62746275
PL_deBruijn_bitpos_tab32[] = {

‎sv.c

+37-2
Original file line numberDiff line numberDiff line change
@@ -1041,6 +1041,7 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type)
10411041
return;
10421042
case SVt_PVHV:
10431043
case SVt_PVAV:
1044+
case SVt_PVOBJ:
10441045
assert(new_type_details->body_size);
10451046

10461047
#ifndef PURIFY
@@ -1056,14 +1057,16 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type)
10561057
new_body = new_NOARENAZ(new_type_details);
10571058
#endif
10581059
SvANY(sv) = new_body;
1059-
if (new_type == SVt_PVAV) {
1060+
switch(new_type) {
1061+
case SVt_PVAV:
10601062
*((XPVAV*) SvANY(sv)) = (XPVAV) {
10611063
.xmg_stash = NULL, .xmg_u = {.xmg_magic = NULL},
10621064
.xav_fill = -1, .xav_max = -1, .xav_alloc = 0
10631065
};
10641066

10651067
AvREAL_only(sv);
1066-
} else {
1068+
break;
1069+
case SVt_PVHV:
10671070
*((XPVHV*) SvANY(sv)) = (XPVHV) {
10681071
.xmg_stash = NULL, .xmg_u = {.xmg_magic = NULL},
10691072
.xhv_keys = 0,
@@ -1076,6 +1079,16 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type)
10761079
#ifndef NODEFAULT_SHAREKEYS
10771080
HvSHAREKEYS_on(sv); /* key-sharing on by default */
10781081
#endif
1082+
break;
1083+
case SVt_PVOBJ:
1084+
*((XPVOBJ*) SvANY(sv)) = (XPVOBJ) {
1085+
.xmg_stash = NULL, .xmg_u = {.xmg_magic = NULL},
1086+
.xobject_maxfield = -1,
1087+
.xobject_fields = NULL,
1088+
};
1089+
break;
1090+
default:
1091+
NOT_REACHED;
10791092
}
10801093

10811094
/* SVt_NULL isn't the only thing upgraded to AV or HV.
@@ -6757,6 +6770,16 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
67576770
Safefree(AvALLOC(av));
67586771
}
67596772

6773+
break;
6774+
case SVt_PVOBJ:
6775+
if(ObjectMAXFIELD(sv) > -1) {
6776+
next_sv = ObjectFIELDS(sv)[ObjectMAXFIELD(sv)--];
6777+
/* save old iter_sv in top-most field, and pray that it
6778+
* doesn't get wiped in the meantime */
6779+
ObjectFIELDS(sv)[(ObjectITERSVAT(sv) = ObjectMAXFIELD(sv) + 1)] = iter_sv;
6780+
iter_sv = sv;
6781+
goto get_next_sv;
6782+
}
67606783
break;
67616784
case SVt_PVLV:
67626785
if (LvTYPE(sv) == 'T') { /* for tie: return HE to pool */
@@ -6944,6 +6967,17 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
69446967
Safefree(AvALLOC(av));
69456968
goto free_body;
69466969
}
6970+
} else if (SvTYPE(iter_sv) == SVt_PVOBJ) {
6971+
if (ObjectMAXFIELD(iter_sv) > -1) {
6972+
sv = ObjectFIELDS(iter_sv)[ObjectMAXFIELD(iter_sv)--];
6973+
}
6974+
else { /* no more fields in the current SV to free */
6975+
sv = iter_sv;
6976+
type = SvTYPE(sv);
6977+
iter_sv = ObjectFIELDS(sv)[ObjectITERSVAT(sv)];
6978+
Safefree(ObjectFIELDS(sv));
6979+
goto free_body;
6980+
}
69476981
} else if (SvTYPE(iter_sv) == SVt_PVHV) {
69486982
sv = Perl_hfree_next_entry(aTHX_ (HV*)iter_sv, &hash_index);
69496983
if (!sv && !HvTOTALKEYS((HV *)iter_sv)) {
@@ -10435,6 +10469,7 @@ Perl_sv_reftype(pTHX_ const SV *const sv, const int ob)
1043510469
case SVt_PVIO: return "IO";
1043610470
case SVt_INVLIST: return "INVLIST";
1043710471
case SVt_REGEXP: return "REGEXP";
10472+
case SVt_PVOBJ: return "OBJECT";
1043810473
default: return "UNKNOWN";
1043910474
}
1044010475
}

‎sv.h

+24-1
Original file line numberDiff line numberDiff line change
@@ -38,9 +38,11 @@ The types are:
3838
SVt_PVCV
3939
SVt_PVFM
4040
SVt_PVIO
41+
SVt_PVOBJ
4142
4243
These are most easily explained from the bottom up.
4344
45+
C<SVt_PVOBJ> is for object instances of the new `use feature 'class'` kind.
4446
C<SVt_PVIO> is for I/O objects, C<SVt_PVFM> for formats, C<SVt_PVCV> for
4547
subroutines, C<SVt_PVHV> for hashes and C<SVt_PVAV> for arrays.
4648
@@ -120,6 +122,9 @@ Type flag for formats. See L</svtype>.
120122
=for apidoc AmnU||SVt_PVIO
121123
Type flag for I/O objects. See L</svtype>.
122124
125+
=for apidoc AmnUx||SVt_PVOBJ
126+
Type flag for object instances. See L</svtype>.
127+
123128
=cut
124129
125130
These are ordered so that the simpler types have a lower value; SvUPGRADE
@@ -149,7 +154,8 @@ typedef enum {
149154
SVt_PVCV, /* 13 */
150155
SVt_PVFM, /* 14 */
151156
SVt_PVIO, /* 15 */
152-
/* 16-31: Unused, though one should be reserved for a
157+
SVt_PVOBJ, /* 16 */
158+
/* 17-31: Unused, though one should be reserved for a
153159
* freed sv, if the other 3 bits below the flags ones
154160
* get allocated */
155161
SVt_LAST /* keep last in enum. used to size arrays */
@@ -273,6 +279,11 @@ struct invlist {
273279
_SV_HEAD_UNION;
274280
};
275281

282+
struct object {
283+
_SV_HEAD(XPVOBJ*); /* pointer to xobject body */
284+
_SV_HEAD_UNION;
285+
};
286+
276287
#undef _SV_HEAD
277288
#undef _SV_HEAD_UNION /* ensure no pollution */
278289

@@ -667,6 +678,18 @@ struct xpvio {
667678
#define IOf_FAKE_DIRP 64 /* xio_dirp is fake (source filters kludge)
668679
Also, when this is set, SvPVX() is valid */
669680

681+
struct xobject {
682+
HV* xmg_stash;
683+
union _xmgu xmg_u;
684+
SSize_t xobject_maxfield;
685+
SSize_t xobject_iter_sv_at; /* this is only used by Perl_sv_clear() */
686+
SV** xobject_fields;
687+
};
688+
689+
#define ObjectMAXFIELD(inst) ((XPVOBJ *)SvANY(inst))->xobject_maxfield
690+
#define ObjectITERSVAT(inst) ((XPVOBJ *)SvANY(inst))->xobject_iter_sv_at
691+
#define ObjectFIELDS(inst) ((XPVOBJ *)SvANY(inst))->xobject_fields
692+
670693
/* The following macros define implementation-independent predicates on SVs. */
671694

672695
/*

0 commit comments

Comments
 (0)