File Coverage

object.c

Criterion	Covered	Total	%
statement	1850	2358	78.4
branch	1140	2096	54.3
condition			n/a
subroutine			n/a
pod			n/a
total	2990	4454	67.1

line	stmt	bran	code
1			#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
4			#include "include/object_compat.h"
5
6			/* Object flags - stored in mg_private */
7			#define OBJ_FLAG_LOCKED 0x01
8			#define OBJ_FLAG_FROZEN 0x02
9
10			/* Built-in type IDs for inline checks */
11			typedef enum {
12			TYPE_NONE = 0,
13			TYPE_ANY,
14			TYPE_DEFINED,
15			TYPE_STR,
16			TYPE_INT,
17			TYPE_NUM,
18			TYPE_BOOL,
19			TYPE_ARRAYREF,
20			TYPE_HASHREF,
21			TYPE_CODEREF,
22			TYPE_OBJECT,
23			TYPE_CUSTOM /* Uses registered or callback check */
24			} BuiltinTypeID;
25
26			/* Type check/coerce function signatures for external plugins */
27			typedef bool (ObjectTypeCheckFunc)(pTHX_ SV val);
28			typedef SV* (ObjectTypeCoerceFunc)(pTHX_ SV val);
29
30			/* Registered type entry (for plugins) */
31			typedef struct {
32			char *name;
33			ObjectTypeCheckFunc check; /* C function for type check */
34			ObjectTypeCoerceFunc coerce; /* C function for coercion */
35			SV perl_check; / Fallback Perl callback */
36			SV perl_coerce; / Fallback Perl coercion */
37			} RegisteredType;
38
39			/* Per-slot specification - parsed from "name:Type:default(val)" */
40			typedef struct {
41			char *name;
42			BuiltinTypeID type_id; /* Built-in type or TYPE_CUSTOM */
43			RegisteredType registered; / For external XS types */
44			SV default_sv; / Default value (immutable, refcnt'd) */
45			SV trigger_cb; / Trigger callback */
46			SV coerce_cb; / Coercion callback (Perl) */
47			SV builder_name; / Builder method name for lazy attrs */
48			U8 is_required; /* Croak if not provided in new() */
49			U8 is_readonly; /* Croak if set after new() */
50			U8 is_lazy; /* Build on first access, not at new() */
51			U8 has_default;
52			U8 has_trigger;
53			U8 has_coerce;
54			U8 has_type;
55			U8 has_builder; /* Has builder method */
56			U8 has_clearer; /* Generate clear_X method */
57			U8 has_predicate; /* Generate has_X method */
58			U8 is_weak; /* Weaken references when stored */
59			U8 has_checks; /* is_readonly \| is_required \| has_coerce \| TYPE_CUSTOM — skip block when 0 */
60			SV clearer_name; / Custom clearer method name */
61			SV predicate_name; / Custom predicate method name */
62			SV reader_name; / Custom reader method name (get_X style) */
63			SV writer_name; / Custom writer method name (set_X style) */
64			SV init_arg; / Alternate constructor argument name */
65			} SlotSpec;
66
67			/* Custom op definitions */
68			static XOP object_new_xop;
69			static XOP object_get_xop;
70			static XOP object_set_xop;
71			static XOP object_set_typed_xop;
72
73			/* Per-class metadata */
74			typedef struct ClassMeta_s ClassMeta; /* Forward declaration */
75
76			/* Method modifier chain - linked list for each type */
77			typedef struct MethodModifier_s {
78			SV *callback;
79			struct MethodModifier_s *next;
80			} MethodModifier;
81
82			/* Modified method wrapper */
83			typedef struct {
84			CV *original_cv;
85			MethodModifier *before_chain;
86			MethodModifier *after_chain;
87			MethodModifier *around_chain;
88			} ModifiedMethod;
89
90			/* Role metadata */
91			typedef struct {
92			char *role_name;
93			char *required_methods; / Methods consuming class MUST have */
94			IV required_count;
95			SlotSpec *slots; / Slots the role provides */
96			IV slot_count;
97			HV stash; / Role's stash for provided methods */
98			} RoleMeta;
99
100			/* Per-class metadata */
101			struct ClassMeta_s {
102			char *class_name;
103			HV prop_to_idx; / property name -> slot index */
104			HV arg_to_idx; / constructor argument name -> slot index (init_arg or property name) */
105			char *idx_to_prop; / slot index -> property name */
106			IV slot_count;
107			HV stash; / cached stash pointer */
108			/* Type system extensions */
109			SlotSpec *slots; / Per-slot specifications, NULL if no specs */
110			U8 has_any_types; /* Quick check: any slot has type checking? */
111			U8 has_any_defaults; /* Quick check: any slot has defaults? */
112			U8 has_any_triggers; /* Quick check: any slot has triggers? */
113			U8 has_any_required; /* Quick check: any slot is required? */
114			U8 has_any_lazy; /* Quick check: any slot is lazy? */
115			U8 has_any_builders; /* Quick check: any slot has builders? */
116			U8 has_any_weak; /* Quick check: any slot has weak refs? */
117			/* Singleton support */
118			SV singleton_instance; / Cached singleton instance, NULL if not a singleton */
119			U8 is_singleton; /* Flag: class is a singleton */
120			/* DEMOLISH support - only set if class has DEMOLISH method */
121			CV demolish_cv; / Cached DEMOLISH method, NULL if none */
122			/* BUILD support - called after new() */
123			CV build_cv; / Cached BUILD method, NULL if none */
124			U8 has_build; /* Flag: class has BUILD method */
125			/* Role support */
126			RoleMeta *consumed_roles; / Array of consumed roles, NULL if none */
127			IV role_count;
128			/* Method modifier registry - only allocated if modifiers are used */
129			HV modified_methods; / method name -> ModifiedMethod, NULL if none /
130			/* Inheritance support */
131			char *parent_classes; / Array of parent class names, NULL if no parents */
132			struct ClassMeta_s *parent_metas; / Array of parent ClassMeta pointers */
133			IV parent_count; /* Number of parent classes */
134			};
135
136			/* Global class registry */
137			static HV g_class_registry = NULL; / class name -> ClassMeta* */
138
139			/* Global type registry for external plugins */
140			static HV g_type_registry = NULL; / type name -> RegisteredType* */
141
142			/* Global role registry */
143			static HV g_role_registry = NULL; / role name -> RoleMeta* */
144
145			/* Forward declaration for FuncAccessorData */
146			typedef struct FuncAccessorData_s FuncAccessorData;
147
148			/* Global registry for function accessor data (to avoid storing pointers in op_targ) */
149			static FuncAccessorData **g_func_accessor_registry = NULL;
150			static IV g_func_accessor_count = 0;
151			static IV g_func_accessor_capacity = 0;
152
153			/* Forward declarations */
154			static ClassMeta* get_class_meta(pTHX_ const char *class_name, STRLEN len);
155			static void install_constructor(pTHX_ const char class_name, ClassMeta meta);
156			static void install_accessor(pTHX_ const char class_name, const char prop_name, IV idx);
157			static void install_accessor_typed(pTHX_ const char class_name, const char prop_name, IV idx, ClassMeta *meta);
158			static void install_clearer(pTHX_ const char class_name, const char prop_name, IV idx, ClassMeta meta, SV custom_name);
159			static void install_predicate(pTHX_ const char class_name, const char prop_name, IV idx, ClassMeta meta, SV custom_name);
160			static void install_destroy_wrapper(pTHX_ const char class_name, ClassMeta meta);
161			static RoleMeta* get_role_meta(pTHX_ const char *role_name, STRLEN len);
162			static XS(xs_prototype);
163			static XS(xs_set_prototype);
164
165			/* ============================================
166			Built-in type checking (inline)
167			============================================ */
168
169	4341		OBJECT_INLINE BuiltinTypeID parse_builtin_type(const char *type_str, STRLEN len) {
170	4341	100	if (len == 3 && strEQ(type_str, "Str")) return TYPE_STR;
		100
171	1201	100	if (len == 3 && strEQ(type_str, "Int")) return TYPE_INT;
		100
172	1118	100	if (len == 3 && strEQ(type_str, "Num")) return TYPE_NUM;
		100
173	1105	100	if (len == 3 && strEQ(type_str, "Any")) return TYPE_ANY;
		50
174	1048	100	if (len == 4 && strEQ(type_str, "Bool")) return TYPE_BOOL;
		50
175	1043	100	if (len == 6 && strEQ(type_str, "Object")) return TYPE_OBJECT;
		100
176	1036	100	if (len == 7 && strEQ(type_str, "Defined")) return TYPE_DEFINED;
		100
177	1035	100	if (len == 7 && strEQ(type_str, "CodeRef")) return TYPE_CODEREF;
		100
178	1034	100	if (len == 7 && strEQ(type_str, "HashRef")) return TYPE_HASHREF;
		50
179	1029	100	if (len == 8 && strEQ(type_str, "ArrayRef")) return TYPE_ARRAYREF;
		50
180	1015		return TYPE_NONE; /* Unknown - could be custom */
181			}
182
183			/* Inline type check - returns true if value passes check */
184	34893		OBJECT_INLINE bool check_builtin_type(pTHX_ SV *val, BuiltinTypeID type_id) {
185	34893		switch (type_id) {
186	66		case TYPE_ANY:
187	66		return true;
188	5		case TYPE_DEFINED:
189			/* Be defensive: SvOK may not catch all defined values in older Perls */
190	5	100	return SvOK(val) \|\| SvIOK(val) \|\| SvNOK(val) \|\| SvPOK(val);
		50
		50
		50
191	15630		case TYPE_STR:
192	15630	100	return SvOK(val) && !SvROK(val); /* defined non-ref */
		100
193	10937		case TYPE_INT:
194	10937	100	if (SvIOK(val)) return true;
195	15	100	if (SvPOK(val)) {
196			/* Use strtoll for fast integer parsing */
197			STRLEN len;
198	14		const char *pv = SvPV(val, len);
199			char *endp;
200	14	50	if (len == 0) return false;
201	14		errno = 0;
202	14		(void)strtoll(pv, &endp, 10);
203	14	50	return errno == 0 && endp == pv + len && *pv != '\0';
		100
		50
204			}
205	1		return false;
206	3224		case TYPE_NUM:
207	3224	100	if (SvNIOK(val)) return true;
208	2	50	if (SvPOK(val)) {
209			/* Use strtod for fast number parsing */
210			STRLEN len;
211	2		const char *pv = SvPV(val, len);
212			char *endp;
213	2	50	if (len == 0) return false;
214	2		errno = 0;
215	2		(void)strtod(pv, &endp);
216	2	50	return errno == 0 && endp == pv + len && *pv != '\0';
		100
		50
217			}
218	0		return false;
219	8		case TYPE_BOOL:
220			/* Accept 0, 1, "", or boolean SVs */
221	8	100	if (SvIOK(val)) {
222	5		IV iv = SvIV(val);
223	5	100	return iv == 0 \|\| iv == 1;
		100
224			}
225	3	100	return SvTRUE(val) \|\| !SvOK(val) \|\| (SvPOK(val) && SvCUR(val) == 0);
		50
		50
		50
226	3005		case TYPE_ARRAYREF:
227	3005	50	return SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVAV;
		100
228	2006		case TYPE_HASHREF:
229	2006	50	return SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV;
		100
230	2		case TYPE_CODEREF:
231	2	100	return SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVCV;
		50
232	10		case TYPE_OBJECT:
233	10	100	return SvROK(val) && sv_isobject(val);
		100
234	0		default:
235	0		return true; /* No check or unknown */
236			}
237			}
238
239			/* Get type name for error messages */
240	10853		static const char* type_id_to_name(BuiltinTypeID type_id) {
241	10853		switch (type_id) {
242	0		case TYPE_ANY: return "Any";
243	2		case TYPE_DEFINED: return "Defined";
244	5626		case TYPE_STR: return "Str";
245	2615		case TYPE_INT: return "Int";
246	1		case TYPE_NUM: return "Num";
247	1		case TYPE_BOOL: return "Bool";
248	2602		case TYPE_ARRAYREF: return "ArrayRef";
249	1		case TYPE_HASHREF: return "HashRef";
250	1		case TYPE_CODEREF: return "CodeRef";
251	4		case TYPE_OBJECT: return "Object";
252	0		case TYPE_CUSTOM: return "custom";
253	0		default: return "unknown";
254			}
255			}
256
257			/* Apply coercion to a value for a slot (slot-level, C-level, and Perl-registered) */
258	17		static SV* apply_slot_coercion(pTHX_ SV val, SlotSpec spec) {
259			/* Slot-level coerce(callback) */
260	17	50	if (spec->has_coerce && spec->coerce_cb) {
		0
261	0		dSP;
262	0	0	PUSHMARK(SP);
263	0	0	XPUSHs(val);
264	0		PUTBACK;
265	0		call_sv(spec->coerce_cb, G_SCALAR);
266	0		SPAGAIN;
267	0		val = POPs;
268	0		PUTBACK;
269			}
270			/* C-registered type coercion (fast path) */
271	17	50	if (spec->type_id == TYPE_CUSTOM && spec->registered && spec->registered->coerce) {
		50
		50
272	0		val = spec->registered->coerce(aTHX_ val);
273			}
274			/* Perl-registered type coercion (from register_type) */
275	17	50	if (spec->type_id == TYPE_CUSTOM && spec->registered && spec->registered->perl_coerce) {
		50
		100
276	4		dSP;
277	4	50	PUSHMARK(SP);
278	4	50	XPUSHs(val);
279	4		PUTBACK;
280	4		call_sv(spec->registered->perl_coerce, G_SCALAR);
281	4		SPAGAIN;
282	4		val = POPs;
283	4		PUTBACK;
284			}
285	17		return val;
286			}
287
288			/* Check a value against a slot's type constraint (handles both C and Perl callbacks) */
289	34910		static bool check_slot_type(pTHX_ SV val, SlotSpec spec) {
290	34910	50	if (!spec \|\| !spec->has_type) return true;
		50
291
292	34910	100	if (spec->type_id != TYPE_CUSTOM) {
293	34893		return check_builtin_type(aTHX_ val, spec->type_id);
294			}
295
296	17	50	if (!spec->registered) return true;
297
298			/* Try C function first (fast path - ~5 cycles) */
299	17	50	if (spec->registered->check) {
300	0		return spec->registered->check(aTHX_ val);
301			}
302
303			/* Fall back to Perl callback (~100 cycles) */
304	17	50	if (spec->registered->perl_check) {
305	17		dSP;
306			int count;
307	17		bool result = false;
308			SV *result_sv;
309	17		ENTER;
310	17		SAVETMPS;
311	17	50	PUSHMARK(SP);
312	17	50	XPUSHs(val);
313	17		PUTBACK;
314	17		count = call_sv(spec->registered->perl_check, G_SCALAR);
315	17		SPAGAIN;
316	17	50	if (count > 0) {
317	17		result_sv = POPs;
318	17		result = SvTRUE(result_sv);
319			}
320	17		PUTBACK;
321	17	50	FREETMPS;
322	17		LEAVE;
323	17		return result;
324			}
325
326	0		return true;
327			}
328
329			/* ============================================
330			Slot spec parser: "name:Type:default(val)"
331			============================================ */
332
333	495		static SlotSpec* parse_slot_spec(pTHX_ const char *spec_str, STRLEN len) {
334			SlotSpec *spec;
335	495		const char *p = spec_str;
336	495		const char *end = spec_str + len;
337			const char name_start, name_end;
338			STRLEN name_len;
339
340	495		Newxz(spec, 1, SlotSpec);
341
342			/* Parse property name (before first ':') */
343	495		name_start = p;
344	3000	100	while (p < end && *p != ':') p++;
		100
345	495		name_end = p;
346
347	495		name_len = name_end - name_start;
348	495		Newx(spec->name, name_len + 1, char);
349	495		Copy(name_start, spec->name, name_len, char);
350	495		spec->name[name_len] = '\0';
351
352			/* Parse modifiers after name */
353	1055	100	while (p < end) {
354			const char *mod_start;
355			const char *arg_start;
356			const char *arg_end;
357			STRLEN mod_len;
358			STRLEN arg_len;
359			int paren_depth;
360
361	560	50	if (p == ':') p++; / Skip separator */
362	560	50	if (p >= end) break;
363
364	560		mod_start = p;
365
366			/* Check for function-style modifiers: default(...), trigger(...) */
367	3283	100	while (p < end && p != ':' && p != '(') p++;
		100
		100
368
369	560		mod_len = p - mod_start;
370
371	560	100	if (p < end && *p == '(') {
		100
372			/* Function-style: default(value) or trigger(&callback) */
373	140		p++;
374	140		arg_start = p;
375	140		paren_depth = 1;
376	1093	100	while (p < end && paren_depth > 0) {
		100
377	953	50	if (*p == '(') paren_depth++;
378	953	100	else if (*p == ')') paren_depth--;
379	953		p++;
380			}
381	140		arg_end = p - 1; /* Before closing paren */
382	140		arg_len = arg_end - arg_start;
383
384	140	100	if (mod_len == 7 && strncmp(mod_start, "default", 7) == 0) {
		100
385			/* Parse default value */
386	80		spec->has_default = 1;
387			/* Simple default: copy as string and eval at runtime */
388			/* For now, support literal numbers and strings */
389	80	50	if (arg_len > 0) {
390			char *arg_copy;
391	80		Newx(arg_copy, arg_len + 1, char);
392	80		Copy(arg_start, arg_copy, arg_len, char);
393	80		arg_copy[arg_len] = '\0';
394
395			/* Try to parse as number */
396	80	100	if (arg_copy[0] >= '0' && arg_copy[0] <= '9') {
		100
397	96	100	if (strchr(arg_copy, '.')) {
398	4		spec->default_sv = newSVnv(atof(arg_copy));
399			} else {
400	44		spec->default_sv = newSViv(atoi(arg_copy));
401			}
402	32	50	} else if (arg_copy[0] == '-' && arg_len > 1) {
		0
403	0	0	if (strchr(arg_copy, '.')) {
404	0		spec->default_sv = newSVnv(atof(arg_copy));
405			} else {
406	0		spec->default_sv = newSViv(atoi(arg_copy));
407			}
408	32	50	} else if (arg_copy[0] == '\'' \|\| arg_copy[0] == '"') {
		100
409			/* String literal - strip quotes */
410	1	50	if (arg_len >= 2) {
411	1		spec->default_sv = newSVpvn(arg_copy + 1, arg_len - 2);
412			} else {
413	0		spec->default_sv = newSVpvn("", 0);
414			}
415	31	100	} else if (strncmp(arg_copy, "undef", 5) == 0) {
416	1		spec->default_sv = newSV(0);
417	30	100	} else if (strncmp(arg_copy, "[]", 2) == 0) {
418	6		spec->default_sv = newRV_noinc((SV*)newAV());
419	24	100	} else if (strncmp(arg_copy, "{}", 2) == 0) {
420	2		spec->default_sv = newRV_noinc((SV*)newHV());
421			} else {
422			/* Default to string */
423	22		spec->default_sv = newSVpvn(arg_copy, arg_len);
424			}
425	80		Safefree(arg_copy);
426			}
427	60	100	} else if (mod_len == 7 && strncmp(mod_start, "trigger", 7) == 0) {
		100
428			/* trigger(&callback) - store callback name for later resolution */
429	4		spec->has_trigger = 1;
430			/* Note: callback resolution happens at runtime in Perl layer */
431			/* For now, store as string - will be resolved in object.pm */
432	4	50	if (arg_len > 0) {
433			char *cb_copy;
434	4		Newx(cb_copy, arg_len + 1, char);
435	4		Copy(arg_start, cb_copy, arg_len, char);
436	4		cb_copy[arg_len] = '\0';
437			/* Store as SV for later resolution */
438	4		spec->trigger_cb = newSVpvn(cb_copy, arg_len);
439	4		Safefree(cb_copy);
440			}
441	56	100	} else if (mod_len == 6 && strncmp(mod_start, "coerce", 6) == 0) {
		50
442			/* coerce(&callback) */
443	0		spec->has_coerce = 1;
444	0	0	if (arg_len > 0) {
445			char *cb_copy;
446	0		Newx(cb_copy, arg_len + 1, char);
447	0		Copy(arg_start, cb_copy, arg_len, char);
448	0		cb_copy[arg_len] = '\0';
449	0		spec->coerce_cb = newSVpvn(cb_copy, arg_len);
450	0		Safefree(cb_copy);
451			}
452	56	100	} else if (mod_len == 7 && strncmp(mod_start, "builder", 7) == 0) {
		100
453			/* builder(method_name) - builder method, called at new() unless :lazy */
454	20		spec->has_builder = 1;
455	20	100	if (arg_len > 0) {
456			char *cb_copy;
457	18		Newx(cb_copy, arg_len + 1, char);
458	18		Copy(arg_start, cb_copy, arg_len, char);
459	18		cb_copy[arg_len] = '\0';
460	18		spec->builder_name = newSVpvn(cb_copy, arg_len);
461	18		Safefree(cb_copy);
462			} else {
463			/* Default builder name: _build_ */
464			char build_name[256];
465	2		snprintf(build_name, sizeof(build_name), "_build_%s", spec->name);
466	2		spec->builder_name = newSVpv(build_name, 0);
467			}
468	36	100	} else if (mod_len == 7 && strncmp(mod_start, "clearer", 7) == 0) {
		50
469			/* clearer(method_name) - custom clearer method name */
470	3		spec->has_clearer = 1;
471	3	50	if (arg_len > 0) {
472			char *name_copy;
473	3		Newx(name_copy, arg_len + 1, char);
474	3		Copy(arg_start, name_copy, arg_len, char);
475	3		name_copy[arg_len] = '\0';
476	3		spec->clearer_name = newSVpvn(name_copy, arg_len);
477	3		Safefree(name_copy);
478			}
479	33	100	} else if (mod_len == 9 && strncmp(mod_start, "predicate", 9) == 0) {
		50
480			/* predicate(method_name) - custom predicate method name */
481	3		spec->has_predicate = 1;
482	3	50	if (arg_len > 0) {
483			char *name_copy;
484	3		Newx(name_copy, arg_len + 1, char);
485	3		Copy(arg_start, name_copy, arg_len, char);
486	3		name_copy[arg_len] = '\0';
487	3		spec->predicate_name = newSVpvn(name_copy, arg_len);
488	3		Safefree(name_copy);
489			}
490	30	100	} else if (mod_len == 6 && strncmp(mod_start, "reader", 6) == 0) {
		100
491			/* reader(method_name) - custom getter method name */
492	10	50	if (arg_len > 0) {
493			char *name_copy;
494	10		Newx(name_copy, arg_len + 1, char);
495	10		Copy(arg_start, name_copy, arg_len, char);
496	10		name_copy[arg_len] = '\0';
497	10		spec->reader_name = newSVpvn(name_copy, arg_len);
498	10		Safefree(name_copy);
499			}
500	20	100	} else if (mod_len == 6 && strncmp(mod_start, "writer", 6) == 0) {
		50
501			/* writer(method_name) - custom setter method name */
502	11	50	if (arg_len > 0) {
503			char *name_copy;
504	11		Newx(name_copy, arg_len + 1, char);
505	11		Copy(arg_start, name_copy, arg_len, char);
506	11		name_copy[arg_len] = '\0';
507	11		spec->writer_name = newSVpvn(name_copy, arg_len);
508	11		Safefree(name_copy);
509			}
510	9	50	} else if (mod_len == 3 && strncmp(mod_start, "arg", 3) == 0) {
		50
511			/* arg(init_arg_name) - alternate constructor argument name */
512	9	50	if (arg_len > 0) {
513			char *name_copy;
514	9		Newx(name_copy, arg_len + 1, char);
515	9		Copy(arg_start, name_copy, arg_len, char);
516	9		name_copy[arg_len] = '\0';
517	9		spec->init_arg = newSVpvn(name_copy, arg_len);
518	9		Safefree(name_copy);
519			}
520			}
521			} else {
522			/* Simple modifier: type name or flag */
523	420	100	if (mod_len == 8 && strncmp(mod_start, "required", 8) == 0) {
		100
524	34		spec->is_required = 1;
525	386	100	} else if (mod_len == 8 && strncmp(mod_start, "readonly", 8) == 0) {
		100
526	13		spec->is_readonly = 1;
527	373	100	} else if (mod_len == 4 && strncmp(mod_start, "lazy", 4) == 0) {
		100
528	14		spec->is_lazy = 1;
529	359	100	} else if (mod_len == 4 && strncmp(mod_start, "weak", 4) == 0) {
		100
530	7		spec->is_weak = 1;
531	352	100	} else if (mod_len == 7 && strncmp(mod_start, "clearer", 7) == 0) {
		100
532	11		spec->has_clearer = 1;
533			/* Default clearer name: clear_ */
534	341	100	} else if (mod_len == 9 && strncmp(mod_start, "predicate", 9) == 0) {
		50
535	10		spec->has_predicate = 1;
536			/* Default predicate name: has_ */
537			} else {
538			/* Try as type name */
539			char *type_copy;
540			BuiltinTypeID type_id;
541
542	331		Newx(type_copy, mod_len + 1, char);
543	331		Copy(mod_start, type_copy, mod_len, char);
544	331		type_copy[mod_len] = '\0';
545
546	331		type_id = parse_builtin_type(type_copy, mod_len);
547	331	100	if (type_id != TYPE_NONE) {
548	323		spec->type_id = type_id;
549	323		spec->has_type = 1;
550			} else {
551			/* Check type registry for custom types */
552	8	50	if (g_type_registry) {
553	8		SV **svp = hv_fetch(g_type_registry, type_copy, mod_len, 0);
554	8	100	if (svp) {
555	7		spec->registered = INT2PTR(RegisteredType, SvIV(svp));
556	7		spec->type_id = TYPE_CUSTOM;
557	7		spec->has_type = 1;
558			}
559			}
560			}
561	331		Safefree(type_copy);
562			}
563			}
564			}
565
566	495		spec->has_checks = spec->is_readonly \| spec->is_required \| spec->has_coerce
567	495		\| (spec->type_id == TYPE_CUSTOM ? 1 : 0);
568
569	495		return spec;
570			}
571
572			/* Magic vtable for object flags */
573			static MGVTBL object_magic_vtbl = {
574			NULL, /* get */
575			NULL, /* set */
576			NULL, /* len */
577			NULL, /* clear */
578			NULL, /* free */
579			NULL, /* copy */
580			NULL, /* dup */
581			NULL /* local */
582			};
583
584			/* Validate that an SV is a blessed array-backed object */
585			#define VALIDATE_OBJECT(sv, funcname) \
586			if (!SvROK(sv) \|\| SvTYPE(SvRV(sv)) != SVt_PVAV \|\| !SvOBJECT(SvRV(sv))) \
587			croak("%s: argument is not an Object::Proto object", funcname)
588
589			/* Get object magic (for flags) */
590	43220		static MAGIC* get_object_magic(pTHX_ SV *obj) {
591			MAGIC *mg;
592	43220	50	if (!SvROK(obj)) return NULL;
593	43220		mg = mg_find(SvRV(obj), PERL_MAGIC_ext);
594	43220	100	while (mg) {
595	6225	50	if (mg->mg_virtual == &object_magic_vtbl) return mg;
596	0		mg = mg->mg_moremagic;
597			}
598	36995		return NULL;
599			}
600
601			/* Add object magic */
602	22		static MAGIC* add_object_magic(pTHX_ SV *obj) {
603			MAGIC *mg;
604	22		SV *rv = SvRV(obj);
605	22		mg = sv_magicext(rv, NULL, PERL_MAGIC_ext, &object_magic_vtbl, NULL, 0);
606	22		mg->mg_private = 0; /* flags */
607	22		return mg;
608			}
609
610			/* ============================================
611			Class definition and registration
612			============================================ */
613
614			/* Clone a SlotSpec (deep copy for inheritance) */
615	66		static SlotSpec* clone_slot_spec(pTHX_ const SlotSpec *src) {
616			SlotSpec *dst;
617			STRLEN name_len;
618
619	66		Newxz(dst, 1, SlotSpec);
620
621	66		name_len = strlen(src->name);
622	66		Newx(dst->name, name_len + 1, char);
623	66		Copy(src->name, dst->name, name_len + 1, char);
624
625	66		dst->type_id = src->type_id;
626	66		dst->registered = src->registered;
627	66		dst->is_required = src->is_required;
628	66		dst->is_readonly = src->is_readonly;
629	66		dst->is_lazy = src->is_lazy;
630	66		dst->is_weak = src->is_weak;
631	66		dst->has_default = src->has_default;
632	66		dst->has_trigger = src->has_trigger;
633	66		dst->has_coerce = src->has_coerce;
634	66		dst->has_type = src->has_type;
635	66		dst->has_builder = src->has_builder;
636	66		dst->has_clearer = src->has_clearer;
637	66		dst->has_predicate = src->has_predicate;
638
639	66	100	if (src->default_sv) dst->default_sv = SvREFCNT_inc(src->default_sv);
640	66	50	if (src->trigger_cb) dst->trigger_cb = SvREFCNT_inc(src->trigger_cb);
641	66	50	if (src->coerce_cb) dst->coerce_cb = SvREFCNT_inc(src->coerce_cb);
642	66	100	if (src->builder_name) dst->builder_name = SvREFCNT_inc(src->builder_name);
643	66	50	if (src->clearer_name) dst->clearer_name = SvREFCNT_inc(src->clearer_name);
644	66	50	if (src->predicate_name) dst->predicate_name = SvREFCNT_inc(src->predicate_name);
645	66	100	if (src->reader_name) dst->reader_name = SvREFCNT_inc(src->reader_name);
646	66	100	if (src->writer_name) dst->writer_name = SvREFCNT_inc(src->writer_name);
647	66	100	if (src->init_arg) dst->init_arg = SvREFCNT_inc(src->init_arg);
648
649	66		return dst;
650			}
651
652			/* Merge child override modifiers onto a clone of parent spec.
653			* Only fields that are explicitly set in override are applied.
654			* This enables Moo/Moose-style '+attr' syntax for inheritance.
655			* Called at define-time only - zero runtime overhead. */
656	11		static SlotSpec* merge_slot_spec(pTHX_ const SlotSpec parent, const SlotSpec override) {
657	11		SlotSpec *merged = clone_slot_spec(aTHX_ parent);
658
659			/* Override type if specified */
660	11	50	if (override->has_type) {
661	0		merged->type_id = override->type_id;
662	0		merged->registered = override->registered;
663	0		merged->has_type = 1;
664			}
665
666			/* Override default if specified */
667	11	100	if (override->has_default) {
668	9	100	if (merged->default_sv) SvREFCNT_dec(merged->default_sv);
669	9	50	merged->default_sv = override->default_sv ? SvREFCNT_inc(override->default_sv) : NULL;
670	9		merged->has_default = 1;
671			}
672
673			/* Override trigger if specified */
674	11	100	if (override->has_trigger) {
675	1	50	if (merged->trigger_cb) SvREFCNT_dec(merged->trigger_cb);
676	1	50	merged->trigger_cb = override->trigger_cb ? SvREFCNT_inc(override->trigger_cb) : NULL;
677	1		merged->has_trigger = 1;
678			}
679
680			/* Override coerce if specified */
681	11	50	if (override->has_coerce) {
682	0	0	if (merged->coerce_cb) SvREFCNT_dec(merged->coerce_cb);
683	0	0	merged->coerce_cb = override->coerce_cb ? SvREFCNT_inc(override->coerce_cb) : NULL;
684	0		merged->has_coerce = 1;
685			}
686
687			/* Override builder if specified */
688	11	100	if (override->has_builder) {
689	1	50	if (merged->builder_name) SvREFCNT_dec(merged->builder_name);
690	1	50	merged->builder_name = override->builder_name ? SvREFCNT_inc(override->builder_name) : NULL;
691	1		merged->has_builder = 1;
692			}
693
694			/* Boolean flags - only set if explicitly enabled in override */
695	11	50	if (override->is_required) merged->is_required = 1;
696	11	100	if (override->is_readonly) merged->is_readonly = 1;
697	11	50	if (override->is_lazy) merged->is_lazy = 1;
698	11	50	if (override->is_weak) merged->is_weak = 1;
699
700			/* Clearer/predicate */
701	11	50	if (override->has_clearer) {
702	0		merged->has_clearer = 1;
703	0	0	if (override->clearer_name) {
704	0	0	if (merged->clearer_name) SvREFCNT_dec(merged->clearer_name);
705	0		merged->clearer_name = SvREFCNT_inc(override->clearer_name);
706			}
707			}
708	11	50	if (override->has_predicate) {
709	0		merged->has_predicate = 1;
710	0	0	if (override->predicate_name) {
711	0	0	if (merged->predicate_name) SvREFCNT_dec(merged->predicate_name);
712	0		merged->predicate_name = SvREFCNT_inc(override->predicate_name);
713			}
714			}
715
716			/* Reader/writer/init_arg */
717	11	50	if (override->reader_name) {
718	0	0	if (merged->reader_name) SvREFCNT_dec(merged->reader_name);
719	0		merged->reader_name = SvREFCNT_inc(override->reader_name);
720			}
721	11	50	if (override->writer_name) {
722	0	0	if (merged->writer_name) SvREFCNT_dec(merged->writer_name);
723	0		merged->writer_name = SvREFCNT_inc(override->writer_name);
724			}
725	11	50	if (override->init_arg) {
726	0	0	if (merged->init_arg) SvREFCNT_dec(merged->init_arg);
727	0		merged->init_arg = SvREFCNT_inc(override->init_arg);
728			}
729
730			/* Recompute has_checks flag */
731	11		merged->has_checks = merged->is_readonly \| merged->is_required \| merged->has_coerce
732	11		\| (merged->type_id == TYPE_CUSTOM ? 1 : 0);
733
734	11		return merged;
735			}
736
737	249		static ClassMeta* create_class_meta(pTHX_ const char *class_name, STRLEN len) {
738			ClassMeta *meta;
739	249		Newxz(meta, 1, ClassMeta);
740	249		Newxz(meta->class_name, len + 1, char);
741	249		Copy(class_name, meta->class_name, len, char);
742	249		meta->class_name[len] = '\0';
743	249		meta->prop_to_idx = newHV();
744	249		meta->arg_to_idx = newHV();
745	249		meta->idx_to_prop = NULL;
746	249		meta->slot_count = 1; /* slot 0 reserved for prototype */
747	249		meta->stash = gv_stashpvn(class_name, len, GV_ADD);
748	249		return meta;
749			}
750
751	27824		static ClassMeta* get_class_meta(pTHX_ const char *class_name, STRLEN len) {
752			SV **svp;
753	27824	50	if (!g_class_registry) return NULL;
754	27824		svp = hv_fetch(g_class_registry, class_name, len, 0);
755	27824	100	if (svp && SvIOK(*svp)) {
		50
756	21569		return INT2PTR(ClassMeta, SvIV(svp));
757			}
758	6255		return NULL;
759			}
760
761	249		static void register_class_meta(pTHX_ const char class_name, STRLEN len, ClassMeta meta) {
762	249	50	if (!g_class_registry) {
763	0		g_class_registry = newHV();
764			}
765	249		hv_store(g_class_registry, class_name, len, newSViv(PTR2IV(meta)), 0);
766	249		}
767
768			/* ============================================
769			Custom OP: object constructor
770			============================================ */
771
772			/* pp_object_new - create new object, class info in op_targ, args on stack */
773	0		static OP* pp_object_new(pTHX) {
774	0		dSP; dMARK;
775	0		IV items = SP - MARK;
776	0		ClassMeta meta = INT2PTR(ClassMeta, PL_op->op_targ);
777			AV *obj_av;
778			SV *obj_sv;
779			SV **ary;
780			IV i;
781	0		IV slot_count = meta->slot_count;
782	0		U32 is_named = PL_op->op_private; /* 1 = named pairs, 0 = positional */
783
784			/* Create array with pre-extended size and get direct pointer */
785	0		obj_av = newAV();
786	0		av_extend(obj_av, slot_count - 1);
787	0		AvFILLp(obj_av) = slot_count - 1;
788	0		ary = AvARRAY(obj_av);
789
790			/* Slot 0 = prototype (initially undef - read-only is fine, never written via setter) */
791	0		ary[0] = &PL_sv_undef;
792
793	0	0	if (is_named) {
794			/* Fast path: no types, no defaults, no required */
795	0	0	if (!meta->has_any_types && !meta->has_any_defaults && !meta->has_any_required) {
		0
		0
796			/* Don't pre-fill slots - use newSVsv directly to avoid double-touch.
797			Initialize ary to NULL, assign directly, then fill unfilled with newSV(0). */
798	0	0	Zero(&ary[1], slot_count - 1, SV*);
799
800	0	0	for (i = 0; i < items; i += 2) {
801	0		SV *key_sv = MARK[i + 1];
802	0	0	SV *val_sv = (i + 1 < items) ? MARK[i + 2] : &PL_sv_undef;
803			STRLEN key_len;
804	0		const char *key = SvPV(key_sv, key_len);
805	0		SV **idx_svp = hv_fetch(meta->arg_to_idx, key, key_len, 0);
806	0	0	if (idx_svp) {
807	0		IV idx = SvIVX(*idx_svp);
808	0		ary[idx] = newSVsv(val_sv);
809			}
810			}
811
812			/* Fill remaining NULL slots with writable undef */
813	0	0	for (i = 1; i < slot_count; i++) {
814	0	0	if (!ary[i]) ary[i] = newSV(0);
815			}
816			} else {
817			/* Slow path: has types/defaults/required
818			Use NULL-init + direct newSVsv for provided slots to avoid double-touch */
819	0	0	Zero(&ary[1], slot_count - 1, SV*);
820
821	0	0	for (i = 0; i < items; i += 2) {
822	0		SV *key_sv = MARK[i + 1];
823	0	0	SV *val_sv = (i + 1 < items) ? MARK[i + 2] : &PL_sv_undef;
824			STRLEN key_len;
825	0		const char *key = SvPV(key_sv, key_len);
826	0		SV **idx_svp = hv_fetch(meta->arg_to_idx, key, key_len, 0);
827	0	0	if (idx_svp) {
828	0		IV idx = SvIVX(*idx_svp);
829
830	0	0	if (meta->has_any_types && meta->slots[idx] && meta->slots[idx]->has_type) {
		0
		0
831	0		SlotSpec *spec = meta->slots[idx];
832	0	0	if (spec->type_id != TYPE_CUSTOM) {
833	0	0	if (!check_builtin_type(aTHX_ val_sv, spec->type_id)) {
834	0		croak("Type constraint failed for '%s' in new(): expected %s",
835			spec->name, type_id_to_name(spec->type_id));
836			}
837	0	0	} else if (spec->registered && spec->registered->check) {
		0
838	0	0	if (!spec->registered->check(aTHX_ val_sv)) {
839	0		croak("Type constraint failed for '%s' in new(): expected %s",
840			spec->name, spec->registered->name);
841			}
842			}
843			}
844	0		ary[idx] = newSVsv(val_sv);
845			}
846			}
847
848			/* Fill defaults and check required; allocate undef for unfilled slots */
849	0	0	for (i = 1; i < slot_count; i++) {
850	0	0	if (!ary[i] \|\| !SvOK(ary[i])) {
		0
851	0		SlotSpec *spec = meta->slots[i];
852
853	0	0	if (spec && spec->is_required) {
		0
854	0		croak("Required slot '%s' not provided in new()", spec->name);
855			}
856
857	0	0	if (spec && spec->has_default && spec->default_sv) {
		0
		0
858	0	0	if (SvROK(spec->default_sv)) {
859	0	0	if (ary[i]) SvREFCNT_dec(ary[i]);
860	0	0	if (SvTYPE(SvRV(spec->default_sv)) == SVt_PVAV) {
861	0		ary[i] = newRV_noinc((SV*)newAV());
862	0	0	} else if (SvTYPE(SvRV(spec->default_sv)) == SVt_PVHV) {
863	0		ary[i] = newRV_noinc((SV*)newHV());
864			} else {
865	0		ary[i] = newSVsv(spec->default_sv);
866			}
867			} else {
868	0	0	if (ary[i]) { sv_setsv(ary[i], spec->default_sv); }
869	0		else { ary[i] = newSVsv(spec->default_sv); }
870			}
871	0	0	} else if (!ary[i]) {
872	0		ary[i] = newSV(0);
873			}
874			}
875			}
876			}
877			} else {
878			/* Positional: value, value, value — newSVsv directly, no pre-fill needed */
879	0		IV provided = items;
880	0	0	if (provided > slot_count - 1) provided = slot_count - 1;
881
882	0	0	if (!meta->has_any_types) {
883	0	0	for (i = 0; i < provided; i++) {
884	0		ary[i + 1] = newSVsv(MARK[i + 1]);
885			}
886			} else {
887	0	0	for (i = 0; i < provided; i++) {
888	0		IV idx = i + 1;
889	0		SV *val_sv = MARK[i + 1];
890
891	0	0	if (meta->slots[idx] && meta->slots[idx]->has_type) {
		0
892	0		SlotSpec *spec = meta->slots[idx];
893	0	0	if (spec->type_id != TYPE_CUSTOM) {
894	0	0	if (!check_builtin_type(aTHX_ val_sv, spec->type_id)) {
895	0		croak("Type constraint failed for '%s' in new(): expected %s",
896			spec->name, type_id_to_name(spec->type_id));
897			}
898	0	0	} else if (spec->registered && spec->registered->check) {
		0
899	0	0	if (!spec->registered->check(aTHX_ val_sv)) {
900	0		croak("Type constraint failed for '%s' in new(): expected %s",
901			spec->name, spec->registered->name);
902			}
903			}
904			}
905	0		ary[idx] = newSVsv(val_sv);
906			}
907			}
908
909			/* Fill remaining empty slots with writable undef */
910	0	0	for (i = provided + 1; i < slot_count; i++) {
911	0		ary[i] = newSV(0);
912			}
913
914			/* Fill defaults/required for positional when class has them */
915	0	0	if (meta->has_any_defaults \|\| meta->has_any_required) {
		0
916	0	0	for (i = 1; i < slot_count; i++) {
917	0	0	if (!SvOK(ary[i])) {
918	0		SlotSpec *spec = meta->slots[i];
919
920	0	0	if (spec && spec->is_required) {
		0
921	0		croak("Required slot '%s' not provided in new()", spec->name);
922			}
923
924	0	0	if (spec && spec->has_default && spec->default_sv) {
		0
		0
925	0	0	if (SvROK(spec->default_sv)) {
926	0	0	if (SvTYPE(SvRV(spec->default_sv)) == SVt_PVAV) {
927	0		SvREFCNT_dec(ary[i]);
928	0		ary[i] = newRV_noinc((SV*)newAV());
929	0	0	} else if (SvTYPE(SvRV(spec->default_sv)) == SVt_PVHV) {
930	0		SvREFCNT_dec(ary[i]);
931	0		ary[i] = newRV_noinc((SV*)newHV());
932			} else {
933	0		sv_setsv(ary[i], spec->default_sv);
934			}
935			} else {
936	0		sv_setsv(ary[i], spec->default_sv);
937			}
938			}
939			}
940			}
941			}
942			}
943
944			/* Create blessed reference */
945	0		obj_sv = newRV_noinc((SV*)obj_av);
946	0		sv_bless(obj_sv, meta->stash);
947
948			/* Call builders for non-lazy builder slots that weren't set */
949	0	0	if (meta->has_any_builders) {
950	0	0	for (i = 1; i < slot_count; i++) {
951	0		SlotSpec *spec = meta->slots[i];
952	0	0	if (spec && spec->has_builder && !spec->is_lazy && !SvOK(ary[i])) {
		0
		0
		0
953			/* Call builder method */
954	0		dSP;
955			IV count;
956	0		ENTER;
957	0		SAVETMPS;
958	0	0	PUSHMARK(SP);
959	0	0	XPUSHs(obj_sv);
960	0		PUTBACK;
961	0		count = call_method(SvPV_nolen(spec->builder_name), G_SCALAR);
962	0		SPAGAIN;
963	0	0	if (count > 0) {
964	0		SV *built_val = POPs;
965
966			/* Coerce + type check the built value */
967	0	0	if (spec->has_type) {
968	0	0	if (spec->has_coerce \|\| spec->type_id == TYPE_CUSTOM)
		0
969	0		built_val = apply_slot_coercion(aTHX_ built_val, spec);
970	0	0	if (!check_slot_type(aTHX_ built_val, spec)) {
971	0	0	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
972	0		? spec->registered->name
973	0	0	: type_id_to_name(spec->type_id);
974	0		croak("Type constraint failed for '%s' in builder: expected %s",
975			spec->name, type_name);
976			}
977			}
978
979	0		sv_setsv(ary[i], built_val);
980			}
981	0		PUTBACK;
982	0	0	FREETMPS;
983	0		LEAVE;
984			}
985			}
986			}
987
988			/* Weaken references if any slots have is_weak */
989	0	0	if (meta->has_any_weak) {
990	0	0	for (i = 1; i < slot_count; i++) {
991	0		SlotSpec *spec = meta->slots[i];
992	0	0	if (spec && spec->is_weak && SvROK(ary[i])) {
		0
		0
993	0		sv_rvweaken(ary[i]);
994			}
995			}
996			}
997
998			/* Call BUILD if defined. Use tri-state: 0=unchecked, 1=has BUILD, 2=no BUILD.
999			Avoids gv_fetchmeth on every construction once checked. */
1000	0	0	if (meta->has_build == 0) {
1001	0		GV *gv = gv_fetchmeth(meta->stash, "BUILD", 5, 0);
1002	0	0	if (gv && GvCV(gv)) {
		0
1003	0		meta->has_build = 1;
1004	0		meta->build_cv = GvCV(gv);
1005			} else {
1006	0		meta->has_build = 2;
1007			}
1008			}
1009	0	0	if (meta->has_build == 1) {
1010	0		dSP;
1011	0		ENTER;
1012	0		SAVETMPS;
1013	0	0	PUSHMARK(SP);
1014	0	0	XPUSHs(obj_sv);
1015	0		PUTBACK;
1016	0		call_method("BUILD", G_VOID \| G_DISCARD);
1017	0	0	FREETMPS;
1018	0		LEAVE;
1019			}
1020
1021	0		SP = MARK;
1022	0	0	XPUSHs(obj_sv);
1023	0		PUTBACK;
1024	0		return NORMAL;
1025			}
1026
1027			/* ============================================
1028			Prototype chain resolution
1029			============================================ */
1030
1031			#define MAX_PROTOTYPE_DEPTH 100
1032
1033			/* Resolve a property through the full prototype chain.
1034			* Returns the value if found, or &PL_sv_undef if not.
1035			* Detects circular references using depth limit and pointer tracking.
1036			*/
1037	45595		static SV* resolve_property_chain(pTHX_ AV *av, IV idx) {
1038	45595		int depth = 0;
1039			AV visited[MAX_PROTOTYPE_DEPTH]; / Simple stack-based cycle detection */
1040			int i;
1041
1042	45621	50	while (av && depth < MAX_PROTOTYPE_DEPTH) {
		50
1043			/* Check for circular reference */
1044	45655	100	for (i = 0; i < depth; i++) {
1045	35	100	if (visited[i] == av) {
1046	1		warn("Circular prototype reference detected");
1047	1		return &PL_sv_undef;
1048			}
1049			}
1050	45620		visited[depth] = av;
1051
1052			/* Try to fetch the property at this level */
1053	45620	50	if (idx <= AvFILLp(av)) {
1054	45620		SV *slot = AvARRAY(av)[idx];
1055	45620	50	if (slot && SvOK(slot)) return slot;
		100
1056			}
1057
1058			/* Follow prototype chain (slot 0) */
1059	7860	50	if (AvFILLp(av) < 0) break;
1060			{
1061	7860		SV *proto_sv = AvARRAY(av)[0];
1062	7860	50	if (!proto_sv \|\| !SvROK(proto_sv) \|\| SvTYPE(SvRV(proto_sv)) != SVt_PVAV) break;
		100
		50
1063	26		av = (AV*)SvRV(proto_sv);
1064			}
1065	26		depth++;
1066			}
1067
1068	7834	50	if (depth >= MAX_PROTOTYPE_DEPTH) {
1069	0		warn("Prototype chain too deep (max %d levels)", MAX_PROTOTYPE_DEPTH);
1070			}
1071
1072	7834		return &PL_sv_undef;
1073			}
1074
1075			/* ============================================
1076			Custom OP: property accessor (get)
1077			============================================ */
1078
1079	0		static OP* pp_object_get(pTHX) {
1080	0		dSP;
1081	0		SV *obj = TOPs;
1082	0		IV idx = PL_op->op_targ;
1083			AV *av;
1084			SV *sv;
1085
1086	0	0	if (!SvROK(obj) \|\| SvTYPE(SvRV(obj)) != SVt_PVAV) {
		0
1087	0		croak("Not an object");
1088			}
1089
1090	0		av = (AV*)SvRV(obj);
1091
1092			/* Fast path: direct slot access (common case - no prototype chain) */
1093	0	0	if (idx <= AvFILLp(av)) {
1094	0		sv = AvARRAY(av)[idx];
1095	0	0	if (sv && SvOK(sv)) {
		0
1096	0		SETs(sv);
1097	0		RETURN;
1098			}
1099			}
1100
1101			/* Slow path: check prototype chain only if prototype exists.
1102			Slot 0 is always allocated - use direct access instead of av_fetch(). */
1103			{
1104	0		SV *proto_sv = AvARRAY(av)[0];
1105	0	0	if (proto_sv && SvROK(proto_sv) && SvTYPE(SvRV(proto_sv)) == SVt_PVAV) {
		0
		0
1106	0		SV *result = resolve_property_chain(aTHX_ av, idx);
1107	0		SETs(result);
1108	0		RETURN;
1109			}
1110			}
1111
1112	0		SETs(&PL_sv_undef);
1113	0		RETURN;
1114			}
1115
1116			/* ============================================
1117			Custom OP: property accessor (set)
1118			============================================ */
1119
1120	0		static OP* pp_object_set(pTHX) {
1121	0		dSP;
1122	0		SV *val = POPs;
1123	0		SV *obj = TOPs;
1124	0		IV idx = PL_op->op_targ;
1125			SV *rv;
1126			AV *av;
1127
1128	0		rv = SvRV(obj);
1129	0	0	if (!SvROK(obj) \|\| SvTYPE(rv) != SVt_PVAV) {
		0
1130	0		croak("Not an object");
1131			}
1132
1133	0		av = (AV*)rv;
1134
1135			/* Only check magic if object has any (lazy magic - most objects don't) */
1136	0	0	if (SvMAGICAL(rv)) {
1137	0		MAGIC *mg = get_object_magic(aTHX_ obj);
1138	0	0	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		0
1139	0		croak("Cannot modify frozen object");
1140			}
1141			}
1142
1143			/* In-place update if slot already has an SV (avoids alloc/dealloc) */
1144	0	0	if (idx <= AvFILLp(av)) {
1145	0		SV *slot = AvARRAY(av)[idx];
1146	0	0	if (slot) {
1147	0		sv_setsv(slot, val);
1148	0		SETs(val);
1149	0		RETURN;
1150			}
1151			}
1152
1153	0		av_store(av, idx, newSVsv(val));
1154	0		SETs(val);
1155	0		RETURN;
1156			}
1157
1158			/* ============================================
1159			Custom OP: property accessor (set) with type check
1160			Uses op_private to store type ID for inline check
1161			============================================ */
1162
1163			/* Helper struct to pass both idx and meta through op */
1164			typedef struct {
1165			IV slot_idx;
1166			ClassMeta *meta;
1167			} SlotOpData;
1168
1169			/* Helper struct for function-style accessors (cross-class support) */
1170			struct FuncAccessorData_s {
1171			IV slot_idx;
1172			ClassMeta expected_class; / Class this accessor expects */
1173			IV registry_id; /* ID in g_func_accessor_registry */
1174			};
1175
1176			/* Register a FuncAccessorData and return its ID */
1177	97		static IV register_func_accessor_data(pTHX_ FuncAccessorData *data) {
1178	97	100	if (g_func_accessor_count >= g_func_accessor_capacity) {
1179	8	50	IV new_capacity = g_func_accessor_capacity ? g_func_accessor_capacity * 2 : 64;
1180	8	50	Renew(g_func_accessor_registry, new_capacity, FuncAccessorData*);
1181	8		g_func_accessor_capacity = new_capacity;
1182			}
1183	97		data->registry_id = g_func_accessor_count;
1184	97		g_func_accessor_registry[g_func_accessor_count] = data;
1185	97		return g_func_accessor_count++;
1186			}
1187
1188			/* Look up FuncAccessorData by ID — inlined for hot path performance */
1189	84636		OBJECT_INLINE FuncAccessorData* get_func_accessor_data(IV id) {
1190	84636		return g_func_accessor_registry[id];
1191			}
1192
1193	0		static OP* pp_object_set_typed(pTHX) {
1194	0		dSP;
1195	0		SV *val = POPs;
1196	0		SV *obj = TOPs;
1197	0		SlotOpData data = INT2PTR(SlotOpData, PL_op->op_targ);
1198	0		IV idx = data->slot_idx;
1199	0		ClassMeta *meta = data->meta;
1200	0		SlotSpec *spec = meta->slots[idx];
1201			AV *av;
1202
1203	0	0	if (!SvROK(obj) \|\| SvTYPE(SvRV(obj)) != SVt_PVAV) {
		0
1204	0		croak("Not an object");
1205			}
1206
1207	0		av = (AV*)SvRV(obj);
1208
1209			/* Check frozen/locked — only walk magic list if object has magic */
1210	0	0	if (SvMAGICAL(av)) {
1211	0		MAGIC *mg = get_object_magic(aTHX_ obj);
1212	0	0	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		0
1213	0		croak("Cannot modify frozen object");
1214			}
1215			}
1216
1217			/* Fast-skip readonly/required/coerce when none apply */
1218	0	0	if (spec->has_checks) {
1219	0	0	if (spec->is_readonly) {
1220	0		croak("Cannot modify readonly slot '%s'", spec->name);
1221			}
1222	0	0	if (spec->is_required && !SvOK(val)) {
		0
1223	0		croak("Cannot set required slot '%s' to undef", spec->name);
1224			}
1225	0	0	if (spec->has_coerce \|\| spec->type_id == TYPE_CUSTOM) {
		0
1226	0		val = apply_slot_coercion(aTHX_ val, spec);
1227			}
1228			}
1229
1230			/* Type check using helper (handles both C and Perl callbacks) */
1231	0	0	if (spec->has_type) {
1232	0	0	if (!check_slot_type(aTHX_ val, spec)) {
1233	0	0	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
1234	0		? spec->registered->name
1235	0	0	: type_id_to_name(spec->type_id);
1236	0		croak("Type constraint failed for '%s': expected %s",
1237			spec->name, type_name);
1238			}
1239			}
1240
1241			/* Trigger callback ($self, $new_value) */
1242	0	0	if (spec->has_trigger && spec->trigger_cb) {
		0
1243	0		dSP;
1244	0	0	PUSHMARK(SP);
1245	0	0	XPUSHs(obj);
1246	0	0	XPUSHs(val);
1247	0		PUTBACK;
1248	0		call_method(SvPV_nolen(spec->trigger_cb), G_DISCARD);
1249			}
1250
1251	0	0	if (!spec->is_weak) {
1252			/* In-place update avoids newSVsv allocation (common case) */
1253	0	0	if (idx <= AvFILLp(av)) {
1254	0		SV *slot = AvARRAY(av)[idx];
1255	0	0	if (slot) {
1256	0		sv_setsv(slot, val);
1257	0		SETs(val);
1258	0		RETURN;
1259			}
1260			}
1261	0		av_store(av, idx, newSVsv(val));
1262			} else {
1263	0		SV *stored = newSVsv(val);
1264	0		av_store(av, idx, stored);
1265	0	0	if (SvROK(stored)) sv_rvweaken(stored);
1266			}
1267	0		SETs(val);
1268	0		RETURN;
1269			}
1270
1271			/* ============================================
1272			Call checker for accessor
1273			============================================ */
1274
1275	0		static OP* accessor_call_checker(pTHX_ OP entersubop, GV namegv, SV *ckobj) {
1276	0		IV idx = SvIV(ckobj);
1277			OP pushop, cvop, selfop, argop;
1278			OP *newop;
1279
1280			PERL_UNUSED_ARG(namegv);
1281
1282	0		pushop = cUNOPx(entersubop)->op_first;
1283	0	0	if (!OpHAS_SIBLING(pushop)) {
1284	0		pushop = cUNOPx(pushop)->op_first;
1285			}
1286
1287	0	0	selfop = OpSIBLING(pushop);
1288	0		cvop = selfop;
1289	0		argop = selfop;
1290	0	0	while (OpHAS_SIBLING(cvop)) {
1291	0		argop = cvop;
1292	0	0	cvop = OpSIBLING(cvop);
1293			}
1294
1295			/* Check if there's an argument after self (setter call) */
1296	0	0	if (argop != selfop) {
1297			/* Setter: $obj->name($value) */
1298	0	0	OP *valop = OpSIBLING(selfop);
1299
1300			/* Detach self and val */
1301	0		OpMORESIB_set(pushop, cvop);
1302	0		OpLASTSIB_set(valop, NULL);
1303	0		OpLASTSIB_set(selfop, NULL);
1304
1305			/* Create binop with self and val */
1306	0		newop = newBINOP(OP_CUSTOM, 0, selfop, valop);
1307	0		newop->op_ppaddr = pp_object_set;
1308	0		newop->op_targ = idx;
1309
1310	0		op_free(entersubop);
1311	0		return newop;
1312			} else {
1313			/* Getter: $obj->name */
1314	0		OpMORESIB_set(pushop, cvop);
1315	0		OpLASTSIB_set(selfop, NULL);
1316
1317	0		newop = newUNOP(OP_CUSTOM, 0, selfop);
1318	0		newop->op_ppaddr = pp_object_get;
1319	0		newop->op_targ = idx;
1320
1321	0		op_free(entersubop);
1322	0		return newop;
1323			}
1324			}
1325
1326			/* ============================================
1327			XS Fallback functions
1328			============================================ */
1329
1330			/* XS fallback for new (when call checker can't optimize) */
1331	5127		static XS(xs_object_new_fallback) {
1332	5127		dXSARGS;
1333	5127		ClassMeta meta = INT2PTR(ClassMeta, CvXSUBANY(cv).any_iv);
1334			AV *obj_av;
1335			SV *obj_sv;
1336			SV **ary;
1337			IV i;
1338	5127		IV start_arg = 0;
1339			IV arg_count;
1340	5127		IV slot_count = meta->slot_count;
1341	5127		int is_named = 0;
1342
1343			/* Skip class name if passed as invocant (Cat->new or new Cat).
1344			* Fast path: compare stash pointer instead of string compare. */
1345	5127	50	if (items > 0 && SvPOK(ST(0)) && !SvROK(ST(0))) {
		50
		50
1346			/* The class name is always the first arg for Cat->new() or new Cat() style */
1347	5127		start_arg = 1;
1348			}
1349
1350	5127		arg_count = items - start_arg;
1351
1352			/* Detect named pairs: even count and first arg is a known property name or init_arg */
1353	5127	100	if (arg_count > 0 && (arg_count % 2) == 0 && SvPOK(ST(start_arg))) {
		100
		100
1354			STRLEN len;
1355	3807		const char *pv = SvPV(ST(start_arg), len);
1356	3807	100	if (hv_exists(meta->prop_to_idx, pv, len) \|\| hv_exists(meta->arg_to_idx, pv, len)) {
		100
1357	3745		is_named = 1;
1358			}
1359			}
1360
1361			/* Create array with pre-extended size and get direct pointer */
1362	5127		obj_av = newAV();
1363	5127		av_extend(obj_av, slot_count - 1);
1364			/* Fill array length so AvARRAY access is safe */
1365	5127		AvFILLp(obj_av) = slot_count - 1;
1366	5127		ary = AvARRAY(obj_av);
1367
1368			/* Slot 0 = prototype (initially undef - read-only is fine, never written via setter) */
1369	5127		ary[0] = &PL_sv_undef;
1370
1371			/* Fill slots with defaults or writable undef in a single pass */
1372	15760	100	for (i = 1; i < slot_count; i++) {
1373	10633		SlotSpec *spec = meta->slots[i];
1374	10633	50	if (spec && spec->has_default && spec->default_sv) {
		100
		50
1375	2384	100	if (SvROK(spec->default_sv)) {
1376	33	100	if (SvTYPE(SvRV(spec->default_sv)) == SVt_PVAV) {
1377	30		ary[i] = newRV_noinc((SV*)newAV());
1378	3	50	} else if (SvTYPE(SvRV(spec->default_sv)) == SVt_PVHV) {
1379	3		ary[i] = newRV_noinc((SV*)newHV());
1380			} else {
1381	0		ary[i] = newSVsv(spec->default_sv);
1382			}
1383			} else {
1384	2351		ary[i] = newSVsv(spec->default_sv);
1385			}
1386			} else {
1387	8249		ary[i] = newSV(0);
1388			}
1389			}
1390
1391			/* Create blessed reference NOW so triggers can do method dispatch */
1392	5127		obj_sv = newRV_noinc((SV*)obj_av);
1393	5127		sv_bless(obj_sv, meta->stash);
1394
1395	5127	100	if (is_named) {
1396			/* Named arguments */
1397	8448	100	for (i = start_arg; i < items; i += 2) {
1398	4716		SV *key_sv = ST(i);
1399	4716	50	SV *val_sv = (i + 1 < items) ? ST(i + 1) : &PL_sv_undef;
1400			STRLEN key_len;
1401	4716		const char *key = SvPV(key_sv, key_len);
1402	4716		SV **idx_svp = hv_fetch(meta->arg_to_idx, key, key_len, 0);
1403	4716	100	if (idx_svp) {
1404	4713		IV idx = SvIVX(*idx_svp);
1405	4713		SlotSpec *spec = meta->slots[idx];
1406
1407			/* Coerce + type check */
1408	4713	50	if (spec && spec->has_type) {
		100
1409	4673	50	if (spec->has_coerce \|\| spec->type_id == TYPE_CUSTOM)
		100
1410	11		val_sv = apply_slot_coercion(aTHX_ val_sv, spec);
1411	4673	100	if (!check_slot_type(aTHX_ val_sv, spec)) {
1412	3	50	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
1413	3		? spec->registered->name
1414	16	100	: type_id_to_name(spec->type_id);
1415	13		croak("Type constraint failed for '%s' in new(): expected %s",
1416			spec->name, type_name);
1417			}
1418			}
1419
1420			/* Trigger callback */
1421	4700	50	if (spec && spec->has_trigger && spec->trigger_cb) {
		100
		50
1422	3		dSP;
1423	3	50	PUSHMARK(SP);
1424	3	50	XPUSHs(obj_sv);
1425	3	50	XPUSHs(val_sv);
1426	3		PUTBACK;
1427	3		call_method(SvPV_nolen(spec->trigger_cb), G_DISCARD);
1428			}
1429
1430	4700		sv_setsv(ary[idx], val_sv);
1431			}
1432			}
1433			} else {
1434			/* Positional arguments */
1435	1382		IV provided = items - start_arg;
1436	1382	100	if (provided > slot_count - 1) provided = slot_count - 1;
1437
1438	2178	100	for (i = 0; i < provided; i++) {
1439	798		IV idx = i + 1;
1440	798		SV *val_sv = ST(start_arg + i);
1441	798		SlotSpec *spec = meta->slots[idx];
1442
1443			/* Coerce + type check */
1444	798	50	if (spec && spec->has_type) {
		100
1445	309	50	if (spec->has_coerce \|\| spec->type_id == TYPE_CUSTOM)
		50
1446	0		val_sv = apply_slot_coercion(aTHX_ val_sv, spec);
1447	309	100	if (!check_slot_type(aTHX_ val_sv, spec)) {
1448	0	0	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
1449	0		? spec->registered->name
1450	2	50	: type_id_to_name(spec->type_id);
1451	2		croak("Type constraint failed for '%s' in new(): expected %s",
1452			spec->name, type_name);
1453			}
1454			}
1455
1456			/* Trigger callback */
1457	796	50	if (spec && spec->has_trigger && spec->trigger_cb) {
		50
		0
1458	0		dSP;
1459	0	0	PUSHMARK(SP);
1460	0	0	XPUSHs(obj_sv);
1461	0	0	XPUSHs(val_sv);
1462	0		PUTBACK;
1463	0		call_method(SvPV_nolen(spec->trigger_cb), G_DISCARD);
1464			}
1465
1466	796		sv_setsv(ary[idx], val_sv);
1467			}
1468			}
1469
1470			/* Call builders for non-lazy builder slots that weren't set */
1471	5112	100	if (meta->has_any_builders) {
1472	9704	100	for (i = 1; i < slot_count; i++) {
1473	6470		SlotSpec *spec = meta->slots[i];
1474	6470	50	if (spec && spec->has_builder && !spec->is_lazy && !SvOK(ary[i])) {
		100
		100
		100
1475			/* Call builder method */
1476	7		dSP;
1477			IV count;
1478	7		ENTER;
1479	7		SAVETMPS;
1480	7	50	PUSHMARK(SP);
1481	7	50	XPUSHs(obj_sv);
1482	7		PUTBACK;
1483	7		count = call_method(SvPV_nolen(spec->builder_name), G_SCALAR);
1484	7		SPAGAIN;
1485	7	50	if (count > 0) {
1486	7		SV *built_val = POPs;
1487
1488			/* Coerce + type check the built value */
1489	7	50	if (spec->has_type) {
1490	7	50	if (spec->has_coerce \|\| spec->type_id == TYPE_CUSTOM)
		50
1491	0		built_val = apply_slot_coercion(aTHX_ built_val, spec);
1492	7	50	if (!check_slot_type(aTHX_ built_val, spec)) {
1493	0	0	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
1494	0		? spec->registered->name
1495	0	0	: type_id_to_name(spec->type_id);
1496	0		croak("Type constraint failed for '%s' in builder: expected %s",
1497			spec->name, type_name);
1498			}
1499			}
1500
1501	7		sv_setsv(ary[i], built_val);
1502			}
1503	7		PUTBACK;
1504	7	50	FREETMPS;
1505	7		LEAVE;
1506			}
1507			}
1508			}
1509
1510			/* Check required slots */
1511	5112	100	if (meta->has_any_required) {
1512	6931	100	for (i = 1; i < slot_count; i++) {
1513	4657		SlotSpec *spec = meta->slots[i];
1514	4657	50	if (spec && spec->is_required && !SvOK(ary[i])) {
		100
		100
1515	9		croak("Required slot '%s' not provided in new()", spec->name);
1516			}
1517			}
1518			}
1519
1520			/* Weaken references if any slots have is_weak */
1521	5103	100	if (meta->has_any_weak) {
1522	12	100	for (i = 1; i < slot_count; i++) {
1523	6		SlotSpec *spec = meta->slots[i];
1524	6	50	if (spec && spec->is_weak && SvROK(ary[i])) {
		50
		100
1525	3		sv_rvweaken(ary[i]);
1526			}
1527			}
1528			}
1529
1530			/* Call BUILD if defined. Use tri-state: 0=unchecked, 1=has BUILD, 2=no BUILD.
1531			Avoids gv_fetchmeth on every construction once checked. */
1532	5103	100	if (meta->has_build == 0) {
1533	212		GV *gv = gv_fetchmeth(meta->stash, "BUILD", 5, 0);
1534	212	100	if (gv && GvCV(gv)) {
		50
1535	12		meta->has_build = 1;
1536	12		meta->build_cv = GvCV(gv);
1537			} else {
1538	200		meta->has_build = 2;
1539			}
1540			}
1541	5103	100	if (meta->has_build == 1) {
1542	25		dSP;
1543	25		ENTER;
1544	25		SAVETMPS;
1545	25	50	PUSHMARK(SP);
1546	25	50	XPUSHs(obj_sv);
1547	25		PUTBACK;
1548	25		call_method("BUILD", G_VOID \| G_DISCARD);
1549	25	50	FREETMPS;
1550	25		LEAVE;
1551			}
1552
1553	5103		ST(0) = sv_2mortal(obj_sv);
1554	5103		XSRETURN(1);
1555			}
1556
1557			/* XS fallback accessor */
1558	204		static XS(xs_accessor_fallback) {
1559	204		dXSARGS;
1560	204		IV idx = CvXSUBANY(cv).any_iv;
1561	204		SV *self = ST(0);
1562			AV *av;
1563			SV *rv;
1564
1565	204		rv = SvRV(self);
1566	204	50	if (!SvROK(self) \|\| SvTYPE(rv) != SVt_PVAV) {
		50
1567	0		croak("Not an object");
1568			}
1569	204		av = (AV*)rv;
1570
1571	204	100	if (items > 1) {
1572			/* Setter */
1573	32	100	if (SvMAGICAL(rv)) {
1574	1		MAGIC *mg = get_object_magic(aTHX_ self);
1575	1	50	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		50
1576	1		croak("Cannot modify frozen object");
1577			}
1578			}
1579			/* In-place update if slot already has an SV */
1580	31	50	if (idx <= AvFILLp(av)) {
1581	31		SV *slot = AvARRAY(av)[idx];
1582	31	50	if (slot) {
1583	31		sv_setsv(slot, ST(1));
1584	31		ST(0) = ST(1);
1585	31		XSRETURN(1);
1586			}
1587			}
1588	0		av_store(av, idx, newSVsv(ST(1)));
1589	0		ST(0) = ST(1);
1590	0		XSRETURN(1);
1591			} else {
1592			/* Getter - fast path: direct slot access */
1593	172	50	if (idx <= AvFILLp(av)) {
1594	172		SV *sv = AvARRAY(av)[idx];
1595	172	50	if (sv && SvOK(sv)) {
		100
1596	149		ST(0) = sv;
1597	149		XSRETURN(1);
1598			}
1599			}
1600			/* Slow path: check prototype chain */
1601			{
1602	23		SV **proto = av_fetch(av, 0, 0);
1603	23	50	if (proto && SvROK(proto) && SvTYPE(SvRV(proto)) == SVt_PVAV) {
		100
		50
1604	20		SV *result = resolve_property_chain(aTHX_ av, idx);
1605	20		ST(0) = result;
1606	20		XSRETURN(1);
1607			}
1608			}
1609	3		ST(0) = &PL_sv_undef;
1610	3		XSRETURN(1);
1611			}
1612			}
1613
1614			/* ============================================
1615			Install constructor into class
1616			============================================ */
1617
1618	248		static void install_constructor(pTHX_ const char class_name, ClassMeta meta) {
1619			char full_name[256];
1620			CV *cv;
1621
1622	248		snprintf(full_name, sizeof(full_name), "%s::new", class_name);
1623
1624			/* Create a minimal CV that will be replaced by call checker */
1625	248		cv = newXS(full_name, xs_object_new_fallback, __FILE__);
1626	248		CvXSUBANY(cv).any_iv = PTR2IV(meta);
1627	248		}
1628
1629			/* ============================================
1630			Custom OP: fast function-style getter
1631			op_targ = registry ID, reads object from stack
1632			============================================ */
1633			static XOP object_func_get_xop;
1634			static XOP object_func_set_xop;
1635
1636	80297		static OP* pp_object_func_get(pTHX) {
1637	80297		dSP;
1638	80297		SV obj = TOPs; / peek, don't pop */
1639	80297		FuncAccessorData *data = get_func_accessor_data(PL_op->op_targ);
1640	80297		IV idx = data->slot_idx;
1641			SV *rv;
1642			AV *av;
1643			SV *sv;
1644
1645	80297	50	if (!SvROK(obj)) croak("Not an object");
1646	80297		rv = SvRV(obj);
1647	80297	50	if (SvTYPE(rv) != SVt_PVAV) croak("Not an object");
1648	80297		av = (AV*)rv;
1649
1650			/* Validate object is of expected class (stash pointer comparison) */
1651	80297	50	if (data->expected_class && SvSTASH(rv) != data->expected_class->stash) {
		0
1652	0	0	croak("Expected object of class '%s', got '%s'",
		0
		0
		0
		0
		0
1653			data->expected_class->class_name,
1654			HvNAME(SvSTASH(rv)));
1655			}
1656
1657			/* Direct array access — no SvOK needed (func path has no prototype chain) */
1658	80297	50	if (idx <= AvFILLp(av)) {
1659	80297		sv = AvARRAY(av)[idx];
1660	80297	50	if (sv) {
1661	80297		SETs(sv);
1662	80297		RETURN;
1663			}
1664			}
1665
1666	0		SETs(&PL_sv_undef);
1667	0		RETURN;
1668			}
1669
1670	4053		static OP* pp_object_func_set(pTHX) {
1671	4053		dSP;
1672	4053		SV val = POPs; / Pop value first */
1673	4053		SV obj = TOPs; / Object left on stack */
1674	4053		FuncAccessorData *data = get_func_accessor_data(PL_op->op_targ);
1675	4053		IV idx = data->slot_idx;
1676			SV *rv;
1677			AV *av;
1678
1679	4053	50	if (!SvROK(obj)) croak("Not an object");
1680	4053		rv = SvRV(obj);
1681	4053	50	if (SvTYPE(rv) != SVt_PVAV) croak("Not an object");
1682	4053		av = (AV*)rv;
1683
1684			/* Validate object is of expected class (stash pointer comparison) */
1685	4053	50	if (data->expected_class && SvSTASH(rv) != data->expected_class->stash) {
		0
1686	0	0	croak("Expected object of class '%s', got '%s'",
		0
		0
		0
		0
		0
1687			data->expected_class->class_name,
1688			HvNAME(SvSTASH(rv)));
1689			}
1690
1691			/* In-place update if slot already has an SV (avoids alloc/dealloc) */
1692	4053	50	if (idx <= AvFILLp(av)) {
1693	4053		SV *slot = AvARRAY(av)[idx];
1694	4053	50	if (slot) {
1695	4053		sv_setsv(slot, val);
1696	4053		SETs(val);
1697	4053		RETURN;
1698			}
1699			}
1700
1701	0		av_store(av, idx, newSVsv(val));
1702	0		SETs(val); /* Replace object with value */
1703	0		RETURN;
1704			}
1705
1706			/* Check if an op is "simple" (can be safely used in optimized accessor) */
1707	346		OBJECT_INLINE bool is_simple_op(OP *op) {
1708	346	50	if (!op) return false;
1709			/* Simple ops: pad variables, constants, global variables */
1710	346	100	switch (op->op_type) {
1711	238		case OP_PADSV: /* $lexical */
1712			case OP_CONST: /* literal value */
1713			case OP_GV: /* glob /
1714			case OP_GVSV: /* $global */
1715			case OP_AELEMFAST:/* $array[const] */
1716			#if defined(OP_AELEMFAST_LEX) && OP_AELEMFAST_LEX != OP_AELEMFAST
1717			case OP_AELEMFAST_LEX:
1718			#endif
1719			case OP_NULL: /* Often wraps simple ops */
1720	238		return true;
1721	108		default:
1722	108		return false;
1723			}
1724			}
1725
1726			/* Call checker for function-style accessor: name($obj) or name($obj, $val) */
1727	286		static OP* func_accessor_call_checker(pTHX_ OP entersubop, GV namegv, SV *ckobj) {
1728	286		IV registry_id = SvIV(ckobj);
1729	286		FuncAccessorData *data = get_func_accessor_data(registry_id);
1730			OP pushop, cvop, objop, argop, *valop;
1731			OP *newop;
1732
1733			PERL_UNUSED_ARG(namegv);
1734
1735	286	50	if (!data) {
1736	0		return entersubop; /* Fallback if data not found */
1737			}
1738
1739	286		pushop = cUNOPx(entersubop)->op_first;
1740	286	50	if (!OpHAS_SIBLING(pushop)) {
1741	286		pushop = cUNOPx(pushop)->op_first;
1742			}
1743
1744			/* Walk the op tree like the method-style accessor checker */
1745	286	50	objop = OpSIBLING(pushop);
1746	286		cvop = objop;
1747	286		argop = objop;
1748	642	100	while (OpHAS_SIBLING(cvop)) {
1749	356		argop = cvop;
1750	356	50	cvop = OpSIBLING(cvop);
1751			}
1752
1753			/* Check if there's an argument after obj (setter call) */
1754	286	100	if (argop != objop) {
1755			/* Setter: name($obj, $val) - optimize to custom binop */
1756	70	50	OP *valop = OpSIBLING(objop);
1757
1758			/* Only optimize if exactly 2 args and both are simple ops */
1759	140	50	if (valop && OpSIBLING(valop) == cvop &&
		50
1760	130	100	is_simple_op(objop) && is_simple_op(valop)) {
1761	30		OpMORESIB_set(pushop, cvop);
1762	30		OpLASTSIB_set(valop, NULL);
1763	30		OpLASTSIB_set(objop, NULL);
1764
1765	30		newop = newBINOP(OP_CUSTOM, 0, objop, valop);
1766	30		newop->op_ppaddr = pp_object_func_set;
1767	30		newop->op_targ = data->registry_id;
1768
1769	30		op_free(entersubop);
1770	30		return newop;
1771			}
1772
1773			/* Complex args - fall back to XS */
1774	40		return op_contextualize(entersubop, G_SCALAR);
1775			}
1776
1777			/* Getter: name($obj) - optimize only if objop is simple */
1778	216	100	if (!is_simple_op(objop)) {
1779	68		return entersubop;
1780			}
1781
1782	148		OpMORESIB_set(pushop, cvop);
1783	148		OpLASTSIB_set(objop, NULL);
1784
1785	148		newop = newUNOP(OP_CUSTOM, 0, objop);
1786	148		newop->op_ppaddr = pp_object_func_get;
1787	148		newop->op_targ = data->registry_id;
1788
1789	148		op_free(entersubop);
1790	148		return newop;
1791			}
1792
1793			/* XS fallback for function-style accessor */
1794	20340		static XS(xs_func_accessor_fallback) {
1795	20340		dXSARGS;
1796	20340		FuncAccessorData data = INT2PTR(FuncAccessorData, CvXSUBANY(cv).any_iv);
1797	20340		IV idx = data->slot_idx;
1798	20340		SV *obj = ST(0);
1799			AV *av;
1800
1801	20340	50	if (!SvROK(obj) \|\| SvTYPE(SvRV(obj)) != SVt_PVAV) {
		50
1802	0		croak("Not an object");
1803			}
1804	20340		av = (AV*)SvRV(obj);
1805
1806			/* Validate object is of expected class */
1807	20340	50	if (data->expected_class && SvSTASH(SvRV(obj)) != data->expected_class->stash) {
		0
1808	0	0	croak("Expected object of class '%s', got '%s'",
		0
		0
		0
		0
		0
1809			data->expected_class->class_name,
1810			HvNAME(SvSTASH(SvRV(obj))));
1811			}
1812
1813	20340	100	if (items > 1) {
1814			/* In-place update if slot already has an SV */
1815	4136	50	if (idx <= AvFILLp(av)) {
1816	4136		SV *slot = AvARRAY(av)[idx];
1817	4136	50	if (slot) {
1818	4136		sv_setsv(slot, ST(1));
1819	4136		ST(0) = ST(1);
1820	4136		XSRETURN(1);
1821			}
1822			}
1823	0		av_store(av, idx, newSVsv(ST(1)));
1824	0		ST(0) = ST(1);
1825			} else {
1826			/* Direct array access */
1827	16204	50	if (idx <= AvFILLp(av)) {
1828	16204		SV *sv = AvARRAY(av)[idx];
1829	16204	50	ST(0) = (sv && SvOK(sv)) ? sv : &PL_sv_undef;
		50
1830			} else {
1831	0		ST(0) = &PL_sv_undef;
1832			}
1833			}
1834	16204		XSRETURN(1);
1835			}
1836
1837			/* Install function-style accessor in caller's namespace */
1838	97		static void install_func_accessor(pTHX_ const char pkg, const char prop_name, IV idx, ClassMeta *expected_class, int force) {
1839			char full_name[256];
1840			CV *cv;
1841			SV *ckobj;
1842			FuncAccessorData *data;
1843			IV registry_id;
1844
1845	97		snprintf(full_name, sizeof(full_name), "%s::%s", pkg, prop_name);
1846
1847			/* Check if this accessor already exists */
1848	97		cv = get_cvn_flags(full_name, strlen(full_name), 0);
1849	97	100	if (cv) {
1850	42	50	if (!force) {
1851	0		return; /* Not forced: skip to preserve user-defined subs */
1852			}
1853			/* Forced (import_accessors/import_accessor): delete existing
1854			* to avoid "Subroutine redefined" warning from newXS. */
1855			{
1856	42		HV *stash = gv_stashpvn(pkg, strlen(pkg), 0);
1857	42	50	if (stash) {
1858	42		(void)hv_delete(stash, prop_name, strlen(prop_name), G_DISCARD);
1859			}
1860			}
1861			}
1862
1863			/* Allocate data for this accessor and register it */
1864	97		Newx(data, 1, FuncAccessorData);
1865	97		data->slot_idx = idx;
1866	97		data->expected_class = expected_class; /* NULL for same-class, set for cross-class */
1867	97		registry_id = register_func_accessor_data(aTHX_ data);
1868
1869	97		cv = newXS(full_name, xs_func_accessor_fallback, __FILE__);
1870	97		CvXSUBANY(cv).any_iv = PTR2IV(data); /* XS fallback still uses pointer directly */
1871
1872	97		ckobj = newSViv(registry_id);
1873	97		cv_set_call_checker(cv, func_accessor_call_checker, ckobj);
1874			}
1875
1876			/* Object::Proto::import_accessors("Class", "targetpkg") - import fast accessors */
1877	27		static XS(xs_import_accessors) {
1878	27		dXSARGS;
1879			STRLEN class_len, pkg_len;
1880			const char class_pv, pkg_pv;
1881			ClassMeta *meta;
1882			IV i;
1883			int is_same_class;
1884
1885	27	50	if (items < 1) croak("Usage: Object::Proto::import_accessors($class [, $package])");
1886
1887	27		class_pv = SvPV(ST(0), class_len);
1888
1889	27	100	if (items > 1) {
1890	11		pkg_pv = SvPV(ST(1), pkg_len);
1891			} else {
1892			/* Default to caller's package */
1893	16	50	pkg_pv = CopSTASHPV(PL_curcop);
		50
		50
		50
		0
		50
		50
1894	16		pkg_len = strlen(pkg_pv);
1895			}
1896
1897	27		meta = get_class_meta(aTHX_ class_pv, class_len);
1898	27	50	if (!meta) {
1899	0		croak("Class '%s' not defined with Object::Proto::define", class_pv);
1900			}
1901
1902			/* Check if importing into same class (skip validation for performance) */
1903	27	100	is_same_class = (class_len == pkg_len && strEQ(class_pv, pkg_pv));
		100
1904
1905			/* Install function-style accessors for each property */
1906	109	100	for (i = 1; i < meta->slot_count; i++) {
1907	82	50	if (meta->idx_to_prop[i]) {
1908			/* Pass NULL for same-class (skip validation), meta for cross-class */
1909	82		install_func_accessor(aTHX_ pkg_pv, meta->idx_to_prop[i], i,
1910			NULL, 1); /* No class check, force override */
1911			}
1912			}
1913
1914	27		XSRETURN_EMPTY;
1915			}
1916
1917			/* Object::Proto::import_accessor("Class", "prop", "alias") - import single accessor with alias */
1918	15		static XS(xs_import_accessor) {
1919	15		dXSARGS;
1920			STRLEN class_len, prop_len, alias_len, pkg_len;
1921			const char class_pv, prop_pv, alias_pv, pkg_pv;
1922			ClassMeta *meta;
1923			SV **idx_svp;
1924			IV idx;
1925			int is_same_class;
1926
1927	15	50	if (items < 2) croak("Usage: Object::Proto::import_accessor($class, $prop [, $alias [, $package]])");
1928
1929	15		class_pv = SvPV(ST(0), class_len);
1930	15		prop_pv = SvPV(ST(1), prop_len);
1931
1932			/* Alias defaults to property name */
1933	15	50	if (items > 2 && SvOK(ST(2))) {
		50
1934	15		alias_pv = SvPV(ST(2), alias_len);
1935			} else {
1936	0		alias_pv = prop_pv;
1937			}
1938
1939			/* Package defaults to caller */
1940	15	100	if (items > 3) {
1941	3		pkg_pv = SvPV(ST(3), pkg_len);
1942			} else {
1943	12	50	pkg_pv = CopSTASHPV(PL_curcop);
		50
		50
		50
		0
		50
		50
1944	12		pkg_len = strlen(pkg_pv);
1945			}
1946
1947	15		meta = get_class_meta(aTHX_ class_pv, class_len);
1948	15	50	if (!meta) {
1949	0		croak("Class '%s' not defined with Object::Proto::define", class_pv);
1950			}
1951
1952			/* Look up property index */
1953	15		idx_svp = hv_fetch(meta->prop_to_idx, prop_pv, prop_len, 0);
1954	15	50	if (!idx_svp) {
1955	0		croak("Property '%s' not defined in class '%s'", prop_pv, class_pv);
1956			}
1957	15		idx = SvIV(*idx_svp);
1958
1959			/* Check if importing into same class (skip validation for performance) */
1960	15	50	is_same_class = (class_len == pkg_len && strEQ(class_pv, pkg_pv));
		0
1961
1962			/* Install with alias name — no class check, work with any compatible object */
1963	15		install_func_accessor(aTHX_ pkg_pv, alias_pv, idx,
1964			NULL, 1); /* force override */
1965
1966	15		XSRETURN_EMPTY;
1967			}
1968
1969			/* Object::Proto::import() - export 'object' to caller's namespace */
1970	57		static XS(xs_import) {
1971	57		dXSARGS;
1972			const char *caller_pkg;
1973			SV *full_name;
1974			CV define_cv, before_cv, after_cv, around_cv;
1975			GV *gv;
1976
1977			PERL_UNUSED_VAR(items);
1978
1979			/* Get caller's package */
1980	57	50	caller_pkg = CopSTASHPV(PL_curcop);
		50
		50
		50
		0
		50
		50
1981
1982			/* Get Object::Proto::define */
1983	57		define_cv = get_cv("Object::Proto::define", 0);
1984	57	50	if (!define_cv) croak("Object::Proto::define not found");
1985
1986			/* Create fully qualified name: caller::object */
1987	57		full_name = newSVpvf("%s::object", caller_pkg);
1988
1989			/* Export: create alias in caller's namespace */
1990	57		gv = gv_fetchsv(full_name, GV_ADD, SVt_PVCV);
1991	57	50	if (GvCV(gv) == NULL) {
1992	57		GvCV_set(gv, (CV)SvREFCNT_inc((SV)define_cv));
1993	57		GvIMPORTED_CV_on(gv);
1994			}
1995	57		GvMULTI_on(gv);
1996	57		SvREFCNT_dec(full_name);
1997
1998			/* Export before/after/around modifiers */
1999	57		before_cv = get_cv("Object::Proto::before", 0);
2000	57		after_cv = get_cv("Object::Proto::after", 0);
2001	57		around_cv = get_cv("Object::Proto::around", 0);
2002
2003	57	50	if (before_cv) {
2004	57		full_name = newSVpvf("%s::before", caller_pkg);
2005	57		gv = gv_fetchsv(full_name, GV_ADD, SVt_PVCV);
2006	57	50	if (GvCV(gv) == NULL) {
2007	57		GvCV_set(gv, (CV)SvREFCNT_inc((SV)before_cv));
2008	57		GvIMPORTED_CV_on(gv);
2009			}
2010	57		GvMULTI_on(gv);
2011	57		SvREFCNT_dec(full_name);
2012			}
2013
2014	57	50	if (after_cv) {
2015	57		full_name = newSVpvf("%s::after", caller_pkg);
2016	57		gv = gv_fetchsv(full_name, GV_ADD, SVt_PVCV);
2017	57	50	if (GvCV(gv) == NULL) {
2018	57		GvCV_set(gv, (CV)SvREFCNT_inc((SV)after_cv));
2019	57		GvIMPORTED_CV_on(gv);
2020			}
2021	57		GvMULTI_on(gv);
2022	57		SvREFCNT_dec(full_name);
2023			}
2024
2025	57	50	if (around_cv) {
2026	57		full_name = newSVpvf("%s::around", caller_pkg);
2027	57		gv = gv_fetchsv(full_name, GV_ADD, SVt_PVCV);
2028	57	50	if (GvCV(gv) == NULL) {
2029	57		GvCV_set(gv, (CV)SvREFCNT_inc((SV)around_cv));
2030	57		GvIMPORTED_CV_on(gv);
2031			}
2032	57		GvMULTI_on(gv);
2033	57		SvREFCNT_dec(full_name);
2034			}
2035
2036			/* Export role/requires/with */
2037			{
2038			static const char *names[] = { "role", "requires", "with" };
2039			int i;
2040	228	100	for (i = 0; i < 3; i++) {
2041	171		CV *cv = get_cvn_flags(
2042			Perl_form(aTHX_ "Object::Proto::%s", names[i]),
2043			strlen("Object::Proto::") + strlen(names[i]), 0);
2044	171	50	if (cv) {
2045	171		full_name = newSVpvf("%s::%s", caller_pkg, names[i]);
2046	171		gv = gv_fetchsv(full_name, GV_ADD, SVt_PVCV);
2047	171	50	if (GvCV(gv) == NULL) {
2048	171		GvCV_set(gv, (CV)SvREFCNT_inc((SV)cv));
2049	171		GvIMPORTED_CV_on(gv);
2050			}
2051	171		GvMULTI_on(gv);
2052	171		SvREFCNT_dec(full_name);
2053			}
2054			}
2055			}
2056
2057	57		XSRETURN_EMPTY;
2058			}
2059
2060			/* ============================================
2061			Install accessor into class
2062			============================================ */
2063
2064	154		static void install_accessor(pTHX_ const char class_name, const char prop_name, IV idx) {
2065			char full_name[256];
2066			CV *cv;
2067			SV *ckobj;
2068
2069	154		snprintf(full_name, sizeof(full_name), "%s::%s", class_name, prop_name);
2070
2071			/* Check if accessor already exists to avoid redefinition warnings */
2072	154		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2073	154	50	if (cv) {
2074	0		return; /* Already defined, skip */
2075			}
2076
2077	154		cv = newXS(full_name, xs_accessor_fallback, __FILE__);
2078	154		CvXSUBANY(cv).any_iv = idx;
2079
2080	154		ckobj = newSViv(idx);
2081	154		cv_set_call_checker(cv, accessor_call_checker, ckobj);
2082			}
2083
2084			/* XS fallback accessor with type checking */
2085	71673		static XS(xs_accessor_typed_fallback) {
2086	71673		dXSARGS;
2087	71673		SlotOpData data = INT2PTR(SlotOpData, CvXSUBANY(cv).any_iv);
2088	71673		IV idx = data->slot_idx;
2089	71673		ClassMeta *meta = data->meta;
2090	71673		SlotSpec *spec = meta->slots[idx];
2091	71673		SV *self = ST(0);
2092			AV *av;
2093
2094	71673	50	if (!SvROK(self) \|\| SvTYPE(SvRV(self)) != SVt_PVAV) {
		50
2095	0		croak("Not an object");
2096			}
2097	71673		av = (AV*)SvRV(self);
2098
2099	71673	100	if (items > 1) {
2100			/* Setter with type check */
2101	26098		SV *val = ST(1);
2102	26098		MAGIC *mg = get_object_magic(aTHX_ self);
2103	26098	100	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		50
2104	1		croak("Cannot modify frozen object");
2105			}
2106
2107	26097	100	if (spec->is_readonly) {
2108	7		croak("Cannot modify readonly slot '%s'", spec->name);
2109			}
2110
2111			/* Required fields cannot be set to undef */
2112	26090	100	if (spec->is_required && !SvOK(val)) {
		100
2113	2		croak("Cannot set required slot '%s' to undef", spec->name);
2114			}
2115
2116			/* Coercion */
2117	26088	50	if (spec->has_coerce \|\| spec->type_id == TYPE_CUSTOM)
		100
2118	6		val = apply_slot_coercion(aTHX_ val, spec);
2119
2120			/* Type check */
2121	26088	50	if (spec->has_type) {
2122	26088	100	if (!check_slot_type(aTHX_ val, spec)) {
2123	2	50	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
2124	2		? spec->registered->name
2125	21	100	: type_id_to_name(spec->type_id);
2126	19		croak("Type constraint failed for '%s': expected %s",
2127			spec->name, type_name);
2128			}
2129			}
2130
2131			/* Trigger callback ($self, $new_value) */
2132	26069	100	if (spec->has_trigger && spec->trigger_cb) {
		50
2133	3		dSP;
2134	3	50	PUSHMARK(SP);
2135	3	50	XPUSHs(self);
2136	3	50	XPUSHs(val);
2137	3		PUTBACK;
2138	3		call_method(SvPV_nolen(spec->trigger_cb), G_DISCARD);
2139			}
2140
2141			{
2142	26069		SV *stored = newSVsv(val);
2143	26069		av_store(av, idx, stored);
2144			/* Weaken reference if is_weak flag is set */
2145	26069	100	if (spec->is_weak && SvROK(stored)) {
		50
2146	1		sv_rvweaken(stored);
2147			}
2148			}
2149	26069		ST(0) = val;
2150	26069		XSRETURN(1);
2151			} else {
2152			/* Getter - use prototype chain resolution, handle lazy */
2153	45575		SV *result = resolve_property_chain(aTHX_ av, idx);
2154
2155			/* Lazy initialization: if undef and is_lazy, build/default on first access */
2156	45575	100	if (spec->is_lazy && !SvOK(result)) {
		100
2157	3822		SV *built_val = NULL;
2158
2159	7644	50	if (spec->has_builder && spec->builder_name) {
		50
2160			/* Call builder method */
2161	3822		dSP;
2162	3822		const char *builder = SvPV_nolen(spec->builder_name);
2163			int count;
2164
2165	3822		ENTER;
2166	3822		SAVETMPS;
2167	3822	50	PUSHMARK(SP);
2168	3822	50	XPUSHs(self);
2169	3822		PUTBACK;
2170
2171	3822		count = call_method(builder, G_SCALAR);
2172
2173	3822		SPAGAIN;
2174	3822	50	if (count > 0) {
2175			/* Copy the value BEFORE FREETMPS to avoid freed scalar issue */
2176	3822		built_val = newSVsv(POPs);
2177			} else {
2178	0		built_val = newSV(0); /* undef */
2179			}
2180	3822		PUTBACK;
2181	3822	50	FREETMPS;
2182	3822		LEAVE;
2183	0	0	} else if (spec->has_default && spec->default_sv) {
		0
2184			/* Use default value for lazy default */
2185	0	0	if (SvROK(spec->default_sv)) {
2186			/* Clone reference types (arrays, hashes) */
2187	0		SV *inner = SvRV(spec->default_sv);
2188	0	0	if (SvTYPE(inner) == SVt_PVAV) {
2189	0		built_val = newRV_noinc((SV*)newAV());
2190	0	0	} else if (SvTYPE(inner) == SVt_PVHV) {
2191	0		built_val = newRV_noinc((SV*)newHV());
2192			} else {
2193	0		built_val = newSVsv(spec->default_sv);
2194			}
2195			} else {
2196	0		built_val = newSVsv(spec->default_sv);
2197			}
2198			}
2199
2200	3822	50	if (built_val) {
2201			/* Type check the built value */
2202	3822	50	if (spec->has_type && SvOK(built_val)) {
		50
2203	3822	50	if (!check_slot_type(aTHX_ built_val, spec)) {
2204	0	0	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
2205	0		? spec->registered->name
2206	0	0	: type_id_to_name(spec->type_id);
2207	0		croak("Type constraint failed for lazy '%s': expected %s",
2208			spec->name, type_name);
2209			}
2210			}
2211
2212			/* Store the built value - built_val already has correct refcount from newSVsv */
2213	3822		av_store(av, idx, built_val);
2214	3822		result = built_val;
2215			}
2216			}
2217
2218	45575		ST(0) = result;
2219	45575		XSRETURN(1);
2220			}
2221			}
2222
2223			/* Call checker for typed accessor */
2224	0		static OP* accessor_typed_call_checker(pTHX_ OP entersubop, GV namegv, SV *ckobj) {
2225	0		SlotOpData data = INT2PTR(SlotOpData, SvIV(ckobj));
2226	0		IV idx = data->slot_idx;
2227			OP pushop, cvop, selfop, argop;
2228			OP *newop;
2229
2230			PERL_UNUSED_ARG(namegv);
2231
2232	0		pushop = cUNOPx(entersubop)->op_first;
2233	0	0	if (!OpHAS_SIBLING(pushop)) {
2234	0		pushop = cUNOPx(pushop)->op_first;
2235			}
2236
2237	0	0	selfop = OpSIBLING(pushop);
2238	0		cvop = selfop;
2239	0		argop = selfop;
2240	0	0	while (OpHAS_SIBLING(cvop)) {
2241	0		argop = cvop;
2242	0	0	cvop = OpSIBLING(cvop);
2243			}
2244
2245			/* Check if there's an argument after self (setter call) */
2246	0	0	if (argop != selfop) {
2247			/* Setter: $obj->name($value) - use typed setter */
2248	0	0	OP *valop = OpSIBLING(selfop);
2249
2250	0		OpMORESIB_set(pushop, cvop);
2251	0		OpLASTSIB_set(valop, NULL);
2252	0		OpLASTSIB_set(selfop, NULL);
2253
2254	0		newop = newBINOP(OP_CUSTOM, 0, selfop, valop);
2255	0		newop->op_ppaddr = pp_object_set_typed;
2256	0		newop->op_targ = PTR2IV(data);
2257
2258	0		op_free(entersubop);
2259	0		return newop;
2260			} else {
2261			/* Getter: $obj->name - plain getter (no type check needed) */
2262	0		OpMORESIB_set(pushop, cvop);
2263	0		OpLASTSIB_set(selfop, NULL);
2264
2265	0		newop = newUNOP(OP_CUSTOM, 0, selfop);
2266	0		newop->op_ppaddr = pp_object_get;
2267	0		newop->op_targ = idx;
2268
2269	0		op_free(entersubop);
2270	0		return newop;
2271			}
2272			}
2273
2274			/* XS fallback for reader-only accessor (get_X style) */
2275	13		static XS(xs_reader_fallback) {
2276	13		dXSARGS;
2277	13		SlotOpData data = INT2PTR(SlotOpData, CvXSUBANY(cv).any_iv);
2278	13		IV idx = data->slot_idx;
2279	13		ClassMeta *meta = data->meta;
2280	13		SlotSpec *spec = meta->slots[idx];
2281	13		SV *self = ST(0);
2282			AV *av;
2283
2284			PERL_UNUSED_ARG(items);
2285
2286	13	50	if (!SvROK(self) \|\| SvTYPE(SvRV(self)) != SVt_PVAV) {
		50
2287	0		croak("Not an object");
2288			}
2289	13		av = (AV*)SvRV(self);
2290
2291			/* Handle lazy builder */
2292	13	50	if (spec && spec->is_lazy && spec->has_builder && spec->builder_name) {
		100
		50
		50
2293	1	50	if (idx <= AvFILLp(av)) {
2294	1		SV *slot = AvARRAY(av)[idx];
2295	1	50	if (!slot \|\| !SvOK(slot)) {
		50
2296			/* Call builder method */
2297	1		dSP;
2298			IV count;
2299	1		ENTER;
2300	1		SAVETMPS;
2301	1	50	PUSHMARK(SP);
2302	1	50	XPUSHs(self);
2303	1		PUTBACK;
2304	1		count = call_method(SvPV_nolen(spec->builder_name), G_SCALAR);
2305	1		SPAGAIN;
2306	1	50	if (count > 0) {
2307	1		SV *built_val = POPs;
2308
2309			/* Type check the built value */
2310	1	50	if (spec->has_type) {
2311	1	50	if (spec->has_coerce \|\| spec->type_id == TYPE_CUSTOM)
		50
2312	0		built_val = apply_slot_coercion(aTHX_ built_val, spec);
2313	1	50	if (!check_slot_type(aTHX_ built_val, spec)) {
2314	0	0	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
2315	0		? spec->registered->name
2316	0	0	: type_id_to_name(spec->type_id);
2317	0		croak("Type constraint failed for '%s' in builder: expected %s",
2318			spec->name, type_name);
2319			}
2320			}
2321
2322	1		sv_setsv(AvARRAY(av)[idx], built_val);
2323			}
2324	1		PUTBACK;
2325	1	50	FREETMPS;
2326	1		LEAVE;
2327			}
2328			}
2329			}
2330
2331			/* Getter - fast path: direct slot access */
2332	13	50	if (idx <= AvFILLp(av)) {
2333	13		SV *sv = AvARRAY(av)[idx];
2334	13	50	if (sv && SvOK(sv)) {
		50
2335	13		ST(0) = sv;
2336	13		XSRETURN(1);
2337			}
2338			}
2339			/* Slow path: check prototype chain */
2340			{
2341	0		SV **proto = av_fetch(av, 0, 0);
2342	0	0	if (proto && SvROK(proto) && SvTYPE(SvRV(proto)) == SVt_PVAV) {
		0
		0
2343	0		SV *result = resolve_property_chain(aTHX_ av, idx);
2344	0		ST(0) = result;
2345	0		XSRETURN(1);
2346			}
2347			}
2348	0		ST(0) = &PL_sv_undef;
2349	0		XSRETURN(1);
2350			}
2351
2352			/* XS fallback for writer-only accessor (set_X style) */
2353	14		static XS(xs_writer_fallback) {
2354	14		dXSARGS;
2355	14		SlotOpData data = INT2PTR(SlotOpData, CvXSUBANY(cv).any_iv);
2356	14		IV idx = data->slot_idx;
2357	14		ClassMeta *meta = data->meta;
2358	14		SlotSpec *spec = meta->slots[idx];
2359	14		SV *self = ST(0);
2360			AV *av;
2361			MAGIC *mg;
2362
2363	14	50	if (!SvROK(self) \|\| SvTYPE(SvRV(self)) != SVt_PVAV) {
		50
2364	0		croak("Not an object");
2365			}
2366	14		av = (AV*)SvRV(self);
2367
2368	14	100	if (items < 2) {
2369	1		croak("Writer method requires a value argument");
2370			}
2371
2372			/* Check frozen */
2373	13		mg = get_object_magic(aTHX_ self);
2374	13	100	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		50
2375	1		croak("Cannot modify frozen object");
2376			}
2377
2378			/* Check readonly */
2379	12	50	if (spec && spec->is_readonly) {
		100
2380	1		croak("Cannot modify readonly slot '%s'", spec->name);
2381			}
2382
2383			{
2384	11		SV *val = ST(1);
2385
2386			/* Required fields cannot be set to undef */
2387	11	50	if (spec && spec->is_required && !SvOK(val)) {
		100
		50
2388	1		croak("Cannot set required slot '%s' to undef", spec->name);
2389			}
2390
2391			/* Coerce + type check */
2392	10	50	if (spec && spec->has_type) {
		50
2393	10	50	if (spec->has_coerce \|\| spec->type_id == TYPE_CUSTOM)
		50
2394	0		val = apply_slot_coercion(aTHX_ val, spec);
2395	10	100	if (!check_slot_type(aTHX_ val, spec)) {
2396	0	0	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
2397	0		? spec->registered->name
2398	1	50	: type_id_to_name(spec->type_id);
2399	1		croak("Type constraint failed for '%s': expected %s",
2400			spec->name, type_name);
2401			}
2402			}
2403
2404			/* Trigger callback ($self, $new_value) */
2405	9	50	if (spec && spec->has_trigger && spec->trigger_cb) {
		100
		50
2406	1		dSP;
2407	1	50	PUSHMARK(SP);
2408	1	50	XPUSHs(self);
2409	1	50	XPUSHs(val);
2410	1		PUTBACK;
2411	1		call_method(SvPV_nolen(spec->trigger_cb), G_DISCARD);
2412			}
2413
2414			/* In-place update */
2415	9	50	if (idx <= AvFILLp(av)) {
2416	9		SV *slot = AvARRAY(av)[idx];
2417	9	50	if (slot) {
2418	9		sv_setsv(slot, val);
2419			/* Weaken reference if is_weak flag is set */
2420	9	50	if (spec && spec->is_weak && SvROK(slot)) {
		100
		50
2421	1		sv_rvweaken(slot);
2422			}
2423	9		ST(0) = val;
2424	9		XSRETURN(1);
2425			}
2426			}
2427			{
2428	0		SV *stored = newSVsv(val);
2429	0		av_store(av, idx, stored);
2430			/* Weaken reference if is_weak flag is set */
2431	0	0	if (spec && spec->is_weak && SvROK(stored)) {
		0
		0
2432	0		sv_rvweaken(stored);
2433			}
2434			}
2435	0		ST(0) = val;
2436	0		XSRETURN(1);
2437			}
2438			}
2439
2440			/* Install reader-only accessor (get_X style) */
2441	11		static void install_reader(pTHX_ const char class_name, const char method_name, IV idx, ClassMeta *meta) {
2442			char full_name[256];
2443			CV *cv;
2444			SlotOpData *data;
2445
2446	11		snprintf(full_name, sizeof(full_name), "%s::%s", class_name, method_name);
2447
2448			/* Check if method already exists */
2449	11		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2450	11	50	if (cv) {
2451	0		return;
2452			}
2453
2454	11		Newx(data, 1, SlotOpData);
2455	11		data->slot_idx = idx;
2456	11		data->meta = meta;
2457
2458	11		cv = newXS(full_name, xs_reader_fallback, __FILE__);
2459	11		CvXSUBANY(cv).any_iv = PTR2IV(data);
2460			}
2461
2462			/* Install writer-only accessor (set_X style) */
2463	12		static void install_writer(pTHX_ const char class_name, const char method_name, IV idx, ClassMeta *meta) {
2464			char full_name[256];
2465			CV *cv;
2466			SlotOpData *data;
2467
2468	12		snprintf(full_name, sizeof(full_name), "%s::%s", class_name, method_name);
2469
2470			/* Check if method already exists */
2471	12		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2472	12	50	if (cv) {
2473	0		return;
2474			}
2475
2476	12		Newx(data, 1, SlotOpData);
2477	12		data->slot_idx = idx;
2478	12		data->meta = meta;
2479
2480	12		cv = newXS(full_name, xs_writer_fallback, __FILE__);
2481	12		CvXSUBANY(cv).any_iv = PTR2IV(data);
2482			}
2483
2484			/* Install typed accessor (with type check, triggers, etc.) */
2485	396		static void install_accessor_typed(pTHX_ const char class_name, const char prop_name, IV idx, ClassMeta *meta) {
2486			char full_name[256];
2487			CV *cv;
2488			SV *ckobj;
2489			SlotOpData *data;
2490
2491	396		snprintf(full_name, sizeof(full_name), "%s::%s", class_name, prop_name);
2492
2493			/* Check if accessor already exists */
2494	396		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2495	396	100	if (cv) {
2496			/* Update existing accessor's data (for +attr overrides) */
2497	13		data = INT2PTR(SlotOpData*, CvXSUBANY(cv).any_iv);
2498	13	50	if (data) {
2499	13		data->slot_idx = idx;
2500	13		data->meta = meta;
2501			}
2502	13		return;
2503			}
2504
2505			/* Allocate persistent data for this slot */
2506	383		Newx(data, 1, SlotOpData);
2507	383		data->slot_idx = idx;
2508	383		data->meta = meta;
2509
2510	383		cv = newXS(full_name, xs_accessor_typed_fallback, __FILE__);
2511	383		CvXSUBANY(cv).any_iv = PTR2IV(data);
2512
2513	383		ckobj = newSViv(PTR2IV(data));
2514	383		cv_set_call_checker(cv, accessor_typed_call_checker, ckobj);
2515			}
2516
2517			/* XS fallback for clearer method (clear_X) */
2518	9820		static XS(xs_clearer_fallback) {
2519	9820		dXSARGS;
2520	9820		SlotOpData data = INT2PTR(SlotOpData, CvXSUBANY(cv).any_iv);
2521	9820		IV idx = data->slot_idx;
2522	9820		SV *self = ST(0);
2523			AV *av;
2524			MAGIC *mg;
2525
2526			PERL_UNUSED_ARG(items);
2527
2528	9820	50	if (!SvROK(self) \|\| SvTYPE(SvRV(self)) != SVt_PVAV) {
		50
2529	0		croak("Not an object");
2530			}
2531	9820		av = (AV*)SvRV(self);
2532
2533			/* Check frozen */
2534	9820		mg = get_object_magic(aTHX_ self);
2535	9820	100	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		50
2536	1		croak("Cannot modify frozen object");
2537			}
2538
2539			/* Clear the slot by setting to undef */
2540	9819		av_store(av, idx, newSV(0));
2541
2542	9819		ST(0) = self; /* Return self for chaining */
2543	9819		XSRETURN(1);
2544			}
2545
2546			/* Install clearer method (clear_X or custom name) */
2547	16		static void install_clearer(pTHX_ const char class_name, const char prop_name, IV idx, ClassMeta meta, SV custom_name) {
2548			char full_name[256];
2549			CV *cv;
2550			SlotOpData *data;
2551
2552	16	100	if (custom_name && SvOK(custom_name)) {
		50
2553	3		snprintf(full_name, sizeof(full_name), "%s::%s", class_name, SvPV_nolen(custom_name));
2554			} else {
2555	13		snprintf(full_name, sizeof(full_name), "%s::clear_%s", class_name, prop_name);
2556			}
2557
2558			/* Check if method already exists */
2559	16		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2560	16	100	if (cv) {
2561	1		return;
2562			}
2563
2564	15		Newx(data, 1, SlotOpData);
2565	15		data->slot_idx = idx;
2566	15		data->meta = meta;
2567
2568	15		cv = newXS(full_name, xs_clearer_fallback, __FILE__);
2569	15		CvXSUBANY(cv).any_iv = PTR2IV(data);
2570			}
2571
2572			/* XS fallback for predicate method (has_X) */
2573	10232		static XS(xs_predicate_fallback) {
2574	10232		dXSARGS;
2575	10232		SlotOpData data = INT2PTR(SlotOpData, CvXSUBANY(cv).any_iv);
2576	10232		IV idx = data->slot_idx;
2577	10232		SV *self = ST(0);
2578			AV *av;
2579			SV **svp;
2580
2581			PERL_UNUSED_ARG(items);
2582
2583	10232	50	if (!SvROK(self) \|\| SvTYPE(SvRV(self)) != SVt_PVAV) {
		50
2584	0		croak("Not an object");
2585			}
2586	10232		av = (AV*)SvRV(self);
2587
2588			/* Check if slot has a defined value */
2589	10232		svp = av_fetch(av, idx, 0);
2590	10232	50	if (svp && SvOK(*svp)) {
		100
2591	6220		ST(0) = &PL_sv_yes;
2592			} else {
2593	4012		ST(0) = &PL_sv_no;
2594			}
2595	10232		XSRETURN(1);
2596			}
2597
2598			/* Install predicate method (has_X or custom name) */
2599	15		static void install_predicate(pTHX_ const char class_name, const char prop_name, IV idx, ClassMeta meta, SV custom_name) {
2600			char full_name[256];
2601			CV *cv;
2602			SlotOpData *data;
2603
2604	15	100	if (custom_name && SvOK(custom_name)) {
		50
2605	3		snprintf(full_name, sizeof(full_name), "%s::%s", class_name, SvPV_nolen(custom_name));
2606			} else {
2607	12		snprintf(full_name, sizeof(full_name), "%s::has_%s", class_name, prop_name);
2608			}
2609
2610			/* Check if method already exists */
2611	15		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2612	15	100	if (cv) {
2613	1		return;
2614			}
2615
2616	14		Newx(data, 1, SlotOpData);
2617	14		data->slot_idx = idx;
2618	14		data->meta = meta;
2619
2620	14		cv = newXS(full_name, xs_predicate_fallback, __FILE__);
2621	14		CvXSUBANY(cv).any_iv = PTR2IV(data);
2622			}
2623
2624			/* ============================================
2625			DEMOLISH Support (zero overhead if not used)
2626			============================================ */
2627
2628			/* XS DESTROY wrapper that calls DEMOLISH */
2629	4		static XS(xs_destroy_wrapper) {
2630	4		dXSARGS;
2631	4		ClassMeta meta = INT2PTR(ClassMeta, CvXSUBANY(cv).any_iv);
2632	4		SV *self = ST(0);
2633
2634			PERL_UNUSED_VAR(items);
2635
2636	4	50	if (meta && meta->demolish_cv) {
		50
2637	4		dSP;
2638	4		ENTER;
2639	4		SAVETMPS;
2640	4	50	PUSHMARK(SP);
2641	4	50	XPUSHs(self);
2642	4		PUTBACK;
2643	4		call_sv((SV*)meta->demolish_cv, G_DISCARD \| G_EVAL);
2644	4		SPAGAIN;
2645			/* Ignore errors in DEMOLISH - don't die during destruction */
2646	4	50	if (SvTRUE(ERRSV)) {
		50
2647	0	0	warn("Error in DEMOLISH: %s", SvPV_nolen(ERRSV));
2648			}
2649	4	50	FREETMPS;
2650	4		LEAVE;
2651			}
2652
2653	4		XSRETURN_EMPTY;
2654			}
2655
2656			/* Install DESTROY wrapper - only called if DEMOLISH exists */
2657	2		static void install_destroy_wrapper(pTHX_ const char class_name, ClassMeta meta) {
2658			char full_name[256];
2659			CV *cv;
2660
2661	2		snprintf(full_name, sizeof(full_name), "%s::DESTROY", class_name);
2662
2663			/* Check if DESTROY already exists - don't override user's DESTROY */
2664	2		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2665	2	50	if (cv) {
2666	0		return; /* User has their own DESTROY, don't interfere */
2667			}
2668
2669	2		cv = newXS(full_name, xs_destroy_wrapper, __FILE__);
2670	2		CvXSUBANY(cv).any_iv = PTR2IV(meta);
2671			}
2672
2673			/* ============================================
2674			Role Support (zero overhead if not used)
2675			============================================ */
2676
2677	20		static RoleMeta* get_role_meta(pTHX_ const char *role_name, STRLEN len) {
2678			SV **svp;
2679	20	100	if (!g_role_registry) return NULL;
2680	18		svp = hv_fetch(g_role_registry, role_name, len, 0);
2681	18	100	if (svp && SvIOK(*svp)) {
		50
2682	13		return INT2PTR(RoleMeta, SvIV(svp));
2683			}
2684	5		return NULL;
2685			}
2686
2687	7		static void register_role_meta(pTHX_ const char role_name, STRLEN len, RoleMeta meta) {
2688	7	100	if (!g_role_registry) {
2689	2		g_role_registry = newHV();
2690			}
2691	7		hv_store(g_role_registry, role_name, len, newSViv(PTR2IV(meta)), 0);
2692	7		}
2693
2694			/* Copy a method from role stash to class stash */
2695	4		static void copy_method(pTHX_ HV from_stash, HV to_stash, const char *method_name) {
2696			GV *from_gv;
2697			CV *cv;
2698			char full_name[512];
2699			GV *to_gv;
2700
2701	4		from_gv = gv_fetchmeth(from_stash, method_name, strlen(method_name), 0);
2702	4	50	if (!from_gv \|\| !(cv = GvCV(from_gv))) {
		50
2703	0		return; /* No such method in role */
2704			}
2705
2706			/* Check if target already has this method */
2707	4		to_gv = gv_fetchmeth(to_stash, method_name, strlen(method_name), 0);
2708	4	50	if (to_gv && GvCV(to_gv)) {
		0
2709	0		return; /* Target already has method, don't override */
2710			}
2711
2712			/* Install the CV in target stash */
2713	4	50	snprintf(full_name, sizeof(full_name), "%s::%s", HvNAME(to_stash), method_name);
		50
		50
		0
		50
		50
2714	4		to_gv = gv_fetchpv(full_name, GV_ADD, SVt_PVCV);
2715	4	50	if (to_gv) {
2716			/* Share the CV between role and class */
2717	4		GvCV_set(to_gv, (CV)SvREFCNT_inc((SV)cv));
2718	4		GvCVGEN(to_gv) = 0; /* Clear cache */
2719			}
2720			}
2721
2722			/* Apply a role to a class */
2723	11		static void apply_role_to_class(pTHX_ ClassMeta class_meta, RoleMeta role_meta) {
2724			IV i;
2725			HE *entry;
2726
2727			/* Check required methods */
2728	14	100	for (i = 0; i < role_meta->required_count; i++) {
2729	5		const char *required = role_meta->required_methods[i];
2730	5		GV *gv = gv_fetchmeth(class_meta->stash, required, strlen(required), 0);
2731	5	100	if (!gv \|\| !GvCV(gv)) {
		50
2732	2		croak("Class '%s' does not implement required method '%s' from role '%s'",
2733			class_meta->class_name, required, role_meta->role_name);
2734			}
2735			}
2736
2737			/* Copy role's slots to class */
2738	18	100	for (i = 0; i < role_meta->slot_count; i++) {
2739	10		SlotSpec *role_slot = role_meta->slots[i];
2740			IV new_idx;
2741			SV **existing;
2742
2743			/* Check for slot name conflict */
2744	10		existing = hv_fetch(class_meta->prop_to_idx, role_slot->name, strlen(role_slot->name), 0);
2745	10	100	if (existing) {
2746	1		croak("Slot conflict: '%s' already exists in class '%s' (from role '%s')",
2747			role_slot->name, class_meta->class_name, role_meta->role_name);
2748			}
2749
2750			/* Add slot to class */
2751	9		new_idx = class_meta->slot_count++;
2752	9	50	Renew(class_meta->slots, class_meta->slot_count, SlotSpec*);
2753	9	50	Renew(class_meta->idx_to_prop, class_meta->slot_count, char*);
2754
2755			/* Copy slot spec */
2756	9		class_meta->slots[new_idx] = role_slot; /* Share the spec */
2757	9		class_meta->idx_to_prop[new_idx] = role_slot->name;
2758	9		hv_store(class_meta->prop_to_idx, role_slot->name, strlen(role_slot->name),
2759			newSViv(new_idx), 0);
2760
2761			/* Add to arg_to_idx using init_arg if specified, otherwise property name */
2762	9	50	if (role_slot->init_arg) {
2763			STRLEN arg_len;
2764	0		const char *arg_name = SvPV(role_slot->init_arg, arg_len);
2765	0		hv_store(class_meta->arg_to_idx, arg_name, arg_len, newSViv(new_idx), 0);
2766			} else {
2767	9		hv_store(class_meta->arg_to_idx, role_slot->name, strlen(role_slot->name),
2768			newSViv(new_idx), 0);
2769			}
2770
2771			/* Track class-level fast-path flags for role slots */
2772	9	50	if (role_slot->has_type) {
2773	9		class_meta->has_any_types = 1;
2774			}
2775	9	100	if (role_slot->has_default) {
2776	4		class_meta->has_any_defaults = 1;
2777			}
2778	9	50	if (role_slot->has_trigger) {
2779	0		class_meta->has_any_triggers = 1;
2780			}
2781	9	50	if (role_slot->is_required) {
2782	0		class_meta->has_any_required = 1;
2783			}
2784	9	50	if (role_slot->is_lazy) {
2785	0		class_meta->has_any_lazy = 1;
2786			}
2787	9	100	if (role_slot->has_builder) {
2788	1		class_meta->has_any_builders = 1;
2789			}
2790	9	50	if (role_slot->is_weak) {
2791	0		class_meta->has_any_weak = 1;
2792			}
2793
2794			/* Install accessor for this slot */
2795	9	50	if (role_slot->has_type \|\| role_slot->has_trigger \|\| role_slot->has_coerce \|\|
		0
		0
2796	0	0	role_slot->is_readonly \|\| role_slot->is_lazy \|\| role_slot->is_required \|\| role_slot->is_weak) {
		0
		0
		0
2797	9		install_accessor_typed(aTHX_ class_meta->class_name, role_slot->name, new_idx, class_meta);
2798			} else {
2799	0		install_accessor(aTHX_ class_meta->class_name, role_slot->name, new_idx);
2800			}
2801
2802	9	50	if (role_slot->has_clearer) {
2803	0		install_clearer(aTHX_ class_meta->class_name, role_slot->name, new_idx, class_meta, role_slot->clearer_name);
2804			}
2805	9	50	if (role_slot->has_predicate) {
2806	0		install_predicate(aTHX_ class_meta->class_name, role_slot->name, new_idx, class_meta, role_slot->predicate_name);
2807			}
2808	9	50	if (role_slot->reader_name) {
2809	0		install_reader(aTHX_ class_meta->class_name, SvPV_nolen(role_slot->reader_name), new_idx, class_meta);
2810			}
2811	9	50	if (role_slot->writer_name) {
2812	0		install_writer(aTHX_ class_meta->class_name, SvPV_nolen(role_slot->writer_name), new_idx, class_meta);
2813			}
2814			}
2815
2816			/* Copy role's methods to class */
2817	8	50	if (role_meta->stash) {
2818	8		hv_iterinit(role_meta->stash);
2819	12	100	while ((entry = hv_iternext(role_meta->stash))) {
2820	4	50	const char *name = HePV(entry, PL_na);
2821			/* Skip special entries and slots (already handled) */
2822	4	50	if (name[0] != '_' \|\| strncmp(name, "_build_", 7) == 0) {
		0
2823	4		copy_method(aTHX_ role_meta->stash, class_meta->stash, name);
2824			}
2825			}
2826			}
2827
2828			/* Track consumed role */
2829	8	50	Renew(class_meta->consumed_roles, class_meta->role_count + 1, RoleMeta*);
2830	8		class_meta->consumed_roles[class_meta->role_count++] = role_meta;
2831	8		}
2832
2833			/* ============================================
2834			Method Modifiers (zero overhead if not used)
2835			============================================ */
2836
2837			/* Get or create modified method entry */
2838	10		static ModifiedMethod* get_or_create_modified_method(pTHX_ ClassMeta meta, const char method_name) {
2839			SV **svp;
2840			ModifiedMethod *mod;
2841	10		STRLEN name_len = strlen(method_name);
2842
2843	10	100	if (!meta->modified_methods) {
2844	4		meta->modified_methods = newHV();
2845			}
2846
2847	10		svp = hv_fetch(meta->modified_methods, method_name, name_len, 0);
2848	10	100	if (svp && SvIOK(*svp)) {
		50
2849	6		return INT2PTR(ModifiedMethod, SvIV(svp));
2850			}
2851
2852			/* Create new modified method entry */
2853	4		Newxz(mod, 1, ModifiedMethod);
2854
2855			/* Get the original CV */
2856			{
2857	4		GV *gv = gv_fetchmeth(meta->stash, method_name, name_len, 0);
2858	4	50	if (gv && GvCV(gv)) {
		50
2859	4		mod->original_cv = GvCV(gv);
2860	4		SvREFCNT_inc((SV*)mod->original_cv);
2861			}
2862			}
2863
2864	4		hv_store(meta->modified_methods, method_name, name_len, newSViv(PTR2IV(mod)), 0);
2865	4		return mod;
2866			}
2867
2868			/* XS wrapper for modified methods */
2869	7		static XS(xs_modified_method_wrapper) {
2870	7		dXSARGS;
2871	7		ModifiedMethod mod = INT2PTR(ModifiedMethod, CvXSUBANY(cv).any_iv);
2872			MethodModifier *m;
2873	7		int count = 0;
2874	7		I32 gimme = GIMME_V;
2875			AV *saved_args;
2876			AV *saved_results;
2877			int i;
2878
2879			/* Save original arguments for before/after chains */
2880	7		saved_args = newAV();
2881	7		sv_2mortal((SV*)saved_args);
2882	17	100	for (i = 0; i < items; i++) {
2883	10		av_push(saved_args, SvREFCNT_inc(ST(i)));
2884			}
2885
2886			/* Call before chain (in stack order - most recent first) */
2887	15	100	for (m = mod->before_chain; m; m = m->next) {
2888	8		dSP;
2889	8		ENTER;
2890	8		SAVETMPS;
2891	8	50	PUSHMARK(SP);
2892	20	100	for (i = 0; i <= av_len(saved_args); i++) {
2893	12		SV **svp = av_fetch(saved_args, i, 0);
2894	12	50	XPUSHs(svp ? *svp : &PL_sv_undef);
		50
2895			}
2896	8		PUTBACK;
2897	8		call_sv(m->callback, G_DISCARD);
2898	8	50	FREETMPS;
2899	8		LEAVE;
2900			}
2901
2902			/* Save results from original/around call */
2903	7		saved_results = newAV();
2904	7		sv_2mortal((SV*)saved_results);
2905
2906			/* Call around chain (or original if no around) */
2907	7	100	if (mod->around_chain) {
2908			/* For around, we pass ($orig, $self, @args) */
2909	2		m = mod->around_chain;
2910			{
2911	2		dSP;
2912	2		ENTER;
2913	2		SAVETMPS;
2914	2	50	PUSHMARK(SP);
2915	2	50	XPUSHs(sv_2mortal(newRV_inc((SV*)mod->original_cv)));
2916	5	100	for (i = 0; i <= av_len(saved_args); i++) {
2917	3		SV **svp = av_fetch(saved_args, i, 0);
2918	3	50	XPUSHs(svp ? *svp : &PL_sv_undef);
		50
2919			}
2920	2		PUTBACK;
2921	2	50	count = call_sv(m->callback, gimme == G_ARRAY ? G_LIST : G_SCALAR);
2922	2		SPAGAIN;
2923			/* Save results before LEAVE destroys them - they're on stack in reverse */
2924	4	100	for (i = 0; i < count; i++) {
2925	2		av_push(saved_results, newSVsv(POPs));
2926			}
2927	2	50	FREETMPS;
2928	2		LEAVE;
2929			}
2930	5	50	} else if (mod->original_cv) {
2931			/* Call original method */
2932	5		dSP;
2933	5		ENTER;
2934	5		SAVETMPS;
2935	5	50	PUSHMARK(SP);
2936	12	100	for (i = 0; i <= av_len(saved_args); i++) {
2937	7		SV **svp = av_fetch(saved_args, i, 0);
2938	7	50	XPUSHs(svp ? *svp : &PL_sv_undef);
		50
2939			}
2940	5		PUTBACK;
2941	5	50	count = call_sv((SV*)mod->original_cv, gimme == G_ARRAY ? G_LIST : G_SCALAR);
2942	5		SPAGAIN;
2943			/* Save results before LEAVE destroys them */
2944	10	100	for (i = 0; i < count; i++) {
2945	5		av_push(saved_results, newSVsv(POPs));
2946			}
2947	5	50	FREETMPS;
2948	5		LEAVE;
2949			}
2950
2951			/* Call after chain (in order of registration) */
2952	12	100	for (m = mod->after_chain; m; m = m->next) {
2953	5		dSP;
2954	5		ENTER;
2955	5		SAVETMPS;
2956	5	50	PUSHMARK(SP);
2957	12	100	for (i = 0; i <= av_len(saved_args); i++) {
2958	7		SV **svp = av_fetch(saved_args, i, 0);
2959	7	50	XPUSHs(svp ? *svp : &PL_sv_undef);
		50
2960			}
2961	5		PUTBACK;
2962	5		call_sv(m->callback, G_DISCARD);
2963	5	50	FREETMPS;
2964	5		LEAVE;
2965			}
2966
2967			/* Put saved results back on stack (they were saved in reverse order) */
2968			{
2969	7		count = av_len(saved_results) + 1;
2970	14	100	for (i = count - 1; i >= 0; i--) {
2971	7		SV **svp = av_fetch(saved_results, i, 0);
2972			/* Use sv_mortalcopy to put a mortal copy on stack */
2973	7	50	ST(count - 1 - i) = sv_mortalcopy(svp ? *svp : &PL_sv_undef);
2974			}
2975			}
2976
2977	7		XSRETURN(count);
2978			}
2979
2980			/* Install the wrapper if not already done */
2981	10		static void install_modifier_wrapper(pTHX_ ClassMeta meta, const char method_name, ModifiedMethod *mod) {
2982			char full_name[256];
2983			CV *existing_cv;
2984
2985	10		snprintf(full_name, sizeof(full_name), "%s::%s", meta->class_name, method_name);
2986
2987	10		existing_cv = get_cvn_flags(full_name, strlen(full_name), 0);
2988
2989			/* Only install wrapper once - check if it's already our wrapper */
2990	10	50	if (existing_cv && CvXSUB(existing_cv) == xs_modified_method_wrapper) {
		100
2991	6		return; /* Already wrapped */
2992			}
2993
2994			/* Install wrapper without "Subroutine redefined" warning */
2995			{
2996	4		GV *gv = gv_fetchpv(full_name, GV_ADD, SVt_PVCV);
2997	4		CV *cv = newXS_flags(NULL, xs_modified_method_wrapper, __FILE__, NULL, 0);
2998	4		CvXSUBANY(cv).any_iv = PTR2IV(mod);
2999			/* Silently replace the CV in the GV */
3000	4	50	if (GvCV(gv)) {
3001	4		SvREFCNT_dec(GvCV(gv));
3002			}
3003	4		GvCV_set(gv, cv);
3004			}
3005			}
3006
3007			/* Add a modifier to a method */
3008	10		static void add_modifier(pTHX_ ClassMeta meta, const char method_name, SV *callback, int type) {
3009			ModifiedMethod *mod;
3010			MethodModifier *new_mod;
3011
3012	10		mod = get_or_create_modified_method(aTHX_ meta, method_name);
3013
3014	10		Newx(new_mod, 1, MethodModifier);
3015	10		new_mod->callback = newSVsv(callback);
3016	10		new_mod->next = NULL;
3017
3018			/* Add to appropriate chain */
3019	10		switch (type) {
3020	4		case 0: /* before */
3021	4		new_mod->next = mod->before_chain;
3022	4		mod->before_chain = new_mod;
3023	4		break;
3024	4		case 1: /* after */
3025			/* Add to end of after chain */
3026	4	100	if (!mod->after_chain) {
3027	3		mod->after_chain = new_mod;
3028			} else {
3029	1		MethodModifier *last = mod->after_chain;
3030	1	50	while (last->next) last = last->next;
3031	1		last->next = new_mod;
3032			}
3033	4		break;
3034	2		case 2: /* around */
3035			/* around wraps previous around/original */
3036	2		new_mod->next = mod->around_chain;
3037	2		mod->around_chain = new_mod;
3038	2		break;
3039			}
3040
3041	10		install_modifier_wrapper(aTHX_ meta, method_name, mod);
3042	10		}
3043
3044			/* ============================================
3045			XS API Functions
3046			============================================ */
3047
3048	251		static XS(xs_define) {
3049	251		dXSARGS;
3050			STRLEN class_len;
3051			const char *class_pv;
3052			ClassMeta *meta;
3053			IV i;
3054	251		IV first_prop = 1; /* index of first property arg (after class name) */
3055
3056			/* Multiple inheritance support */
3057	251		ClassMeta **parent_metas = NULL;
3058	251		IV parent_count = 0;
3059	251		IV parent_alloc = 0;
3060
3061	251	50	if (items < 1) croak("Usage: Object::Proto::define($class, @properties)");
3062
3063	251		class_pv = SvPV(ST(0), class_len);
3064
3065			/* Check for extends => 'ParentClass' or extends => ['P1','P2'] in arguments */
3066	480	100	for (i = 1; i < items - 1; i++) {
3067			STRLEN klen;
3068	252		const char *kpv = SvPV(ST(i), klen);
3069	252	100	if (klen == 7 && memEQ(kpv, "extends", 7)) {
		100
3070	23		SV *val = ST(i + 1);
3071	25	100	if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVAV) {
		50
3072			/* extends => ['Parent1', 'Parent2', ...] */
3073	3		AV parents_av = (AV)SvRV(val);
3074	3		IV plen = av_len(parents_av) + 1;
3075			IV p;
3076	3	50	Newx(parent_metas, plen, ClassMeta*);
3077	3		parent_alloc = plen;
3078	8	100	for (p = 0; p < plen; p++) {
3079	6		SV **elem = av_fetch(parents_av, p, 0);
3080	6	50	if (elem && SvPOK(*elem)) {
		50
3081			STRLEN pname_len;
3082	6		const char pname = SvPV(elem, pname_len);
3083	6		ClassMeta *pmeta = get_class_meta(aTHX_ pname, pname_len);
3084	6	100	if (!pmeta) {
3085	1		Safefree(parent_metas);
3086	1		croak("Object::Proto::define: parent class '%s' has not been defined", pname);
3087			}
3088	5		parent_metas[parent_count++] = pmeta;
3089			}
3090			}
3091			} else {
3092			/* extends => 'SingleParent' */
3093			STRLEN parent_len;
3094	20		const char *parent_pv = SvPV(val, parent_len);
3095	20		ClassMeta *pmeta = get_class_meta(aTHX_ parent_pv, parent_len);
3096	20	100	if (!pmeta) {
3097	1		croak("Object::Proto::define: parent class '%s' has not been defined", parent_pv);
3098			}
3099	19		Newx(parent_metas, 1, ClassMeta*);
3100	19		parent_alloc = 1;
3101	19		parent_metas[parent_count++] = pmeta;
3102			}
3103			/* Shift remaining args down to remove extends => value */
3104			{
3105			IV j;
3106	52	100	for (j = i; j < items - 2; j++) {
3107	31		ST(j) = ST(j + 2);
3108			}
3109	21		items -= 2;
3110			}
3111	21		break;
3112			}
3113			}
3114
3115			/* Get or create class meta */
3116	249		meta = get_class_meta(aTHX_ class_pv, class_len);
3117	249	50	if (!meta) {
3118	249		meta = create_class_meta(aTHX_ class_pv, class_len);
3119	249		register_class_meta(aTHX_ class_pv, class_len, meta);
3120			}
3121
3122			/* Store parent references */
3123	249	100	if (parent_count > 0) {
3124	21	50	Newx(meta->parent_classes, parent_count, char*);
3125	21	50	Newx(meta->parent_metas, parent_count, ClassMeta*);
3126	21		meta->parent_count = parent_count;
3127	44	100	for (i = 0; i < parent_count; i++) {
3128	23		STRLEN plen = strlen(parent_metas[i]->class_name);
3129	23		Newx(meta->parent_classes[i], plen + 1, char);
3130	23		Copy(parent_metas[i]->class_name, meta->parent_classes[i], plen + 1, char);
3131	23		meta->parent_metas[i] = parent_metas[i];
3132			}
3133			}
3134
3135			/* Calculate total slots needed: all parent inherited + child own */
3136			{
3137	249		IV total_parent_slots = 0;
3138	249		IV child_props = items - 1;
3139			IV max_slots;
3140	272	100	for (i = 0; i < parent_count; i++) {
3141	23		total_parent_slots += parent_metas[i]->slot_count - 1; /* -1 for prototype slot */
3142			}
3143	249		max_slots = 1 + total_parent_slots + child_props;
3144	249	50	Renew(meta->idx_to_prop, max_slots + 1, char*);
3145	249	50	Renew(meta->slots, max_slots + 1, SlotSpec*);
3146	1290	100	for (i = 0; i <= max_slots; i++) {
3147	1041		meta->slots[i] = NULL;
3148	1041		meta->idx_to_prop[i] = NULL;
3149			}
3150			}
3151
3152			/* Copy parent slots (if extends) - iterate all parents, first parent wins on conflict */
3153	272	100	for (i = 0; i < parent_count; i++) {
3154	23		ClassMeta *pmeta = parent_metas[i];
3155			IV j;
3156	79	100	for (j = 1; j < pmeta->slot_count; j++) {
3157	56		SlotSpec *parent_spec = pmeta->slots[j];
3158	56	50	if (parent_spec) {
3159			/* Skip if property already defined by earlier parent */
3160	56		SV **existing = hv_fetch(meta->prop_to_idx, parent_spec->name,
3161			strlen(parent_spec->name), 0);
3162	56	100	if (existing && SvIOK(*existing)) continue;
		50
3163
3164	55		SlotSpec *cloned = clone_slot_spec(aTHX_ parent_spec);
3165	55		IV idx = meta->slot_count++;
3166	55		meta->slots[idx] = cloned;
3167
3168	55	100	if (cloned->has_type) meta->has_any_types = 1;
3169	55	100	if (cloned->has_default) meta->has_any_defaults = 1;
3170	55	50	if (cloned->has_trigger) meta->has_any_triggers = 1;
3171	55	100	if (cloned->is_required) meta->has_any_required = 1;
3172	55	50	if (cloned->is_lazy) meta->has_any_lazy = 1;
3173	55	100	if (cloned->has_builder) meta->has_any_builders = 1;
3174	55	50	if (cloned->is_weak) meta->has_any_weak = 1;
3175
3176	55		hv_store(meta->prop_to_idx, cloned->name, strlen(cloned->name), newSViv(idx), 0);
3177
3178			/* Add to arg_to_idx using init_arg if specified, otherwise property name */
3179	55	100	if (cloned->init_arg) {
3180			STRLEN arg_len;
3181	1		const char *arg_name = SvPV(cloned->init_arg, arg_len);
3182	1		hv_store(meta->arg_to_idx, arg_name, arg_len, newSViv(idx), 0);
3183			} else {
3184	54		hv_store(meta->arg_to_idx, cloned->name, strlen(cloned->name), newSViv(idx), 0);
3185			}
3186
3187	55		meta->idx_to_prop[idx] = cloned->name;
3188
3189	55	100	if (cloned->has_type \|\| cloned->has_trigger \|\| cloned->has_coerce \|\| cloned->is_readonly \|\| cloned->is_lazy \|\| cloned->is_required \|\| cloned->is_weak) {
		50
		50
		50
		50
		50
		50
3190	53		install_accessor_typed(aTHX_ class_pv, cloned->name, idx, meta);
3191			} else {
3192	2		install_accessor(aTHX_ class_pv, cloned->name, idx);
3193			}
3194	55	100	if (cloned->has_clearer) {
3195	1		install_clearer(aTHX_ class_pv, cloned->name, idx, meta, cloned->clearer_name);
3196			}
3197	55	100	if (cloned->has_predicate) {
3198	1		install_predicate(aTHX_ class_pv, cloned->name, idx, meta, cloned->predicate_name);
3199			}
3200	55	100	if (cloned->reader_name) {
3201	1		install_reader(aTHX_ class_pv, SvPV_nolen(cloned->reader_name), idx, meta);
3202			}
3203	55	100	if (cloned->writer_name) {
3204	1		install_writer(aTHX_ class_pv, SvPV_nolen(cloned->writer_name), idx, meta);
3205			}
3206			}
3207			}
3208			}
3209
3210			/* Register each child property */
3211	735	100	for (i = first_prop; i < items; i++) {
3212			STRLEN spec_len;
3213	487		const char *spec_pv = SvPV(ST(i), spec_len);
3214			SlotSpec *spec;
3215			IV idx;
3216			SV **existing;
3217	487		U8 is_modification = 0;
3218	487		const char *real_spec_pv = spec_pv;
3219	487		STRLEN real_spec_len = spec_len;
3220
3221			/* Check for +attr modification syntax (Moo/Moose-style) */
3222	487	50	if (spec_len > 0 && spec_pv[0] == '+') {
		100
3223	12		is_modification = 1;
3224	12		real_spec_pv = spec_pv + 1;
3225	12		real_spec_len = spec_len - 1;
3226			}
3227
3228			/* Parse the slot spec (e.g., "name:Str:required" or just "name") */
3229	487		spec = parse_slot_spec(aTHX_ real_spec_pv, real_spec_len);
3230
3231			/* Check if this property already exists (from parent) */
3232	487		existing = hv_fetch(meta->prop_to_idx, spec->name, strlen(spec->name), 0);
3233
3234	487	100	if (is_modification) {
3235			/* +attr syntax: merge child modifiers onto parent spec */
3236			SlotSpec *parent_spec;
3237			SlotSpec *merged;
3238
3239	12	100	if (!existing \|\| !SvIOK(*existing)) {
		50
3240	1		croak("+%s: no inherited attribute '%s' to modify",
3241			spec->name, spec->name);
3242			}
3243	11		idx = SvIV(*existing);
3244	11		parent_spec = meta->slots[idx];
3245
3246			/* Merge override onto clone of parent */
3247	11		merged = merge_slot_spec(aTHX_ parent_spec, spec);
3248
3249			/* Free the override spec (we cloned what we needed) */
3250	11		Safefree(spec->name);
3251	11		Safefree(spec);
3252	11		spec = merged;
3253
3254			/* Free old parent spec */
3255	11	50	if (parent_spec) {
3256	11		Safefree(parent_spec->name);
3257	11		Safefree(parent_spec);
3258			}
3259	475	100	} else if (existing && SvIOK(*existing)) {
		50
3260			/* Full override: reuse same slot index */
3261	2		idx = SvIV(*existing);
3262			/* Free old spec */
3263	2	50	if (meta->slots[idx]) {
3264	2		Safefree(meta->slots[idx]->name);
3265	2		Safefree(meta->slots[idx]);
3266			}
3267			} else {
3268	473		idx = meta->slot_count++;
3269			}
3270
3271	486		meta->slots[idx] = spec;
3272
3273			/* Update class-level flags for fast path checks */
3274	486	100	if (spec->has_type) meta->has_any_types = 1;
3275	486	100	if (spec->has_default) meta->has_any_defaults = 1;
3276	486	100	if (spec->has_trigger) meta->has_any_triggers = 1;
3277	486	100	if (spec->is_required) meta->has_any_required = 1;
3278	486	100	if (spec->has_builder) meta->has_any_builders = 1;
3279	486	100	if (spec->is_weak) meta->has_any_weak = 1;
3280
3281			/* Store name -> idx mapping (use parsed name, not full spec) */
3282	486		hv_store(meta->prop_to_idx, spec->name, strlen(spec->name), newSViv(idx), 0);
3283
3284			/* Store arg -> idx mapping (use init_arg if specified, otherwise property name) */
3285	486	100	if (spec->init_arg) {
3286			STRLEN arg_len;
3287	9		const char *arg_name = SvPV(spec->init_arg, arg_len);
3288	9		hv_store(meta->arg_to_idx, arg_name, arg_len, newSViv(idx), 0);
3289			} else {
3290	477		hv_store(meta->arg_to_idx, spec->name, strlen(spec->name), newSViv(idx), 0);
3291			}
3292
3293			/* Store idx -> name mapping */
3294	486		meta->idx_to_prop[idx] = spec->name;
3295
3296			/* Update lazy flag */
3297	486	100	if (spec->is_lazy) meta->has_any_lazy = 1;
3298
3299			/* Install accessor method - typed or plain depending on spec */
3300	486	100	if (spec->has_type \|\| spec->has_trigger \|\| spec->has_coerce \|\| spec->is_readonly \|\| spec->is_lazy \|\| spec->is_required \|\| spec->is_weak) {
		50
		50
		50
		50
		100
		50
3301	334		install_accessor_typed(aTHX_ class_pv, spec->name, idx, meta);
3302			} else {
3303	152		install_accessor(aTHX_ class_pv, spec->name, idx);
3304			}
3305
3306			/* Install clearer method if requested */
3307	486	100	if (spec->has_clearer) {
3308	15		install_clearer(aTHX_ class_pv, spec->name, idx, meta, spec->clearer_name);
3309			}
3310
3311			/* Install predicate method if requested */
3312	486	100	if (spec->has_predicate) {
3313	14		install_predicate(aTHX_ class_pv, spec->name, idx, meta, spec->predicate_name);
3314			}
3315
3316			/* Install custom reader method if specified */
3317	486	100	if (spec->reader_name) {
3318	10		install_reader(aTHX_ class_pv, SvPV_nolen(spec->reader_name), idx, meta);
3319			}
3320
3321			/* Install custom writer method if specified */
3322	486	100	if (spec->writer_name) {
3323	11		install_writer(aTHX_ class_pv, SvPV_nolen(spec->writer_name), idx, meta);
3324			}
3325			}
3326
3327			/* Set up @ISA for parent classes (C3 MRO for multiple inheritance) */
3328	248	100	if (parent_count > 0) {
3329	20		AV *isa = get_av(Perl_form(aTHX_ "%s::ISA", class_pv), GV_ADD);
3330	42	100	for (i = 0; i < parent_count; i++) {
3331	22		av_push(isa, newSVpv(parent_metas[i]->class_name, 0));
3332			}
3333			/* Notify Perl's method resolution cache that ISA changed.
3334			* Perl_mro_isa_changed_in was made a hidden (non-exported) symbol
3335			* in Perl 5.36.0. mro_method_changed_in is public since 5.10.0
3336			* and is the correct public API for invalidating the method cache
3337			* after an ISA change. */
3338	20		mro_method_changed_in(meta->stash);
3339	20		Safefree(parent_metas);
3340			}
3341
3342			/* Install constructor */
3343	248		install_constructor(aTHX_ class_pv, meta);
3344
3345			/* Install prototype methods as class methods */
3346			{
3347			char method_name[256];
3348	248		snprintf(method_name, sizeof(method_name), "%s::set_prototype", class_pv);
3349	248		newXS(method_name, xs_set_prototype, __FILE__);
3350	248		snprintf(method_name, sizeof(method_name), "%s::prototype", class_pv);
3351	248		newXS(method_name, xs_prototype, __FILE__);
3352			}
3353
3354			/* Check for DEMOLISH method - only set up destruction hook if class has one */
3355			{
3356			char demolish_name[256];
3357			CV *demolish_cv;
3358	248		snprintf(demolish_name, sizeof(demolish_name), "%s::DEMOLISH", class_pv);
3359	248		demolish_cv = get_cvn_flags(demolish_name, strlen(demolish_name), 0);
3360	248	100	if (demolish_cv) {
3361	2		meta->demolish_cv = demolish_cv;
3362			/* Install DESTROY wrapper that calls DEMOLISH */
3363	2		install_destroy_wrapper(aTHX_ class_pv, meta);
3364			}
3365			}
3366
3367			/* Check for BUILD method - called after new() */
3368			{
3369			char build_name[256];
3370			CV *build_cv;
3371	248		snprintf(build_name, sizeof(build_name), "%s::BUILD", class_pv);
3372	248		build_cv = get_cvn_flags(build_name, strlen(build_name), 0);
3373	248	100	if (build_cv) {
3374	1		meta->build_cv = build_cv;
3375	1		meta->has_build = 1;
3376			}
3377			}
3378
3379	248		XSRETURN_EMPTY;
3380			}
3381
3382	3011		static XS(xs_prototype) {
3383	3011		dXSARGS;
3384			AV *av;
3385			SV **svp;
3386
3387	3011	50	if (items < 1) croak("Usage: Object::Proto::prototype($obj)");
3388
3389	3011	100	if (!SvROK(ST(0)) \|\| SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
		50
3390	1		croak("Not an object");
3391			}
3392	3010		av = (AV*)SvRV(ST(0));
3393	3010		svp = av_fetch(av, 0, 0);
3394	3010	50	if (svp && SvOK(*svp)) {
		100
3395	3009		ST(0) = SvREFCNT_inc(*svp);
3396			} else {
3397	1		ST(0) = &PL_sv_undef;
3398			}
3399	3010		XSRETURN(1);
3400			}
3401
3402	39		static XS(xs_set_prototype) {
3403	39		dXSARGS;
3404			AV *av;
3405			MAGIC *mg;
3406
3407	39	50	if (items < 2) croak("Usage: Object::Proto::set_prototype($obj, $proto)");
3408
3409	39	100	if (!SvROK(ST(0)) \|\| SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
		50
3410	1		croak("Not an object");
3411			}
3412	38		av = (AV*)SvRV(ST(0));
3413
3414	38		mg = get_object_magic(aTHX_ ST(0));
3415	38	100	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		100
3416	1		croak("Cannot modify frozen object");
3417			}
3418
3419	37		av_store(av, 0, newSVsv(ST(1)));
3420	37		XSRETURN_EMPTY;
3421			}
3422
3423			/* Get the full prototype chain as an arrayref */
3424	4		static XS(xs_prototype_chain) {
3425	4		dXSARGS;
3426			AV *av;
3427			AV *chain;
3428			AV *visited[MAX_PROTOTYPE_DEPTH];
3429	4		int depth = 0;
3430			int i;
3431
3432	4	50	if (items < 1) croak("Usage: Object::Proto::prototype_chain($obj)");
3433
3434	4	50	if (!SvROK(ST(0)) \|\| SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
		50
3435	0		croak("Not an object");
3436			}
3437
3438	4		chain = newAV();
3439	4		av = (AV*)SvRV(ST(0));
3440
3441	7	50	while (av && depth < MAX_PROTOTYPE_DEPTH) {
		50
3442			SV **proto_svp;
3443
3444			/* Check for circular reference */
3445	11	100	for (i = 0; i < depth; i++) {
3446	4	50	if (visited[i] == av) {
3447	0		goto done; /* Cycle detected, stop */
3448			}
3449			}
3450	7		visited[depth] = av;
3451
3452			/* Add this object to the chain */
3453	7		av_push(chain, newRV_inc((SV*)av));
3454
3455			/* Follow prototype */
3456	7		proto_svp = av_fetch(av, 0, 0);
3457	7	50	if (!proto_svp \|\| !SvROK(proto_svp) \|\| SvTYPE(SvRV(proto_svp)) != SVt_PVAV) {
		100
		50
3458			break;
3459			}
3460	3		av = (AV)SvRV(proto_svp);
3461	3		depth++;
3462			}
3463
3464	4		done:
3465	4		ST(0) = sv_2mortal(newRV_noinc((SV*)chain));
3466	4		XSRETURN(1);
3467			}
3468
3469			/* Check if object has a property in its own slots (not prototype) */
3470	6		static XS(xs_has_own_property) {
3471	6		dXSARGS;
3472			AV *av;
3473			SV **svp;
3474			const char *class_name;
3475			STRLEN class_len;
3476			ClassMeta *meta;
3477			const char *prop_name;
3478			STRLEN prop_len;
3479			SV **idx_sv;
3480
3481	6	50	if (items < 2) croak("Usage: Object::Proto::has_own_property($obj, $property)");
3482
3483	6	50	if (!SvROK(ST(0)) \|\| SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
		50
3484	0		croak("Not an object");
3485			}
3486
3487	6		av = (AV*)SvRV(ST(0));
3488	6		class_name = sv_reftype(SvRV(ST(0)), TRUE);
3489	6		class_len = strlen(class_name);
3490
3491	6		meta = get_class_meta(aTHX_ class_name, class_len);
3492	6	50	if (!meta) {
3493	0		XSRETURN_NO;
3494			}
3495
3496	6		prop_name = SvPV(ST(1), prop_len);
3497	6		idx_sv = hv_fetch(meta->prop_to_idx, prop_name, prop_len, 0);
3498	6	50	if (!idx_sv) {
3499	0		XSRETURN_NO;
3500			}
3501
3502			/* Check if this slot has a defined value */
3503	6		svp = av_fetch(av, SvIV(*idx_sv), 0);
3504	6	50	if (svp && SvOK(*svp)) {
		100
3505	3		XSRETURN_YES;
3506			}
3507	3		XSRETURN_NO;
3508			}
3509
3510			/* Get the prototype depth (number of prototypes in chain) */
3511	4		static XS(xs_prototype_depth) {
3512	4		dXSARGS;
3513			AV *av;
3514			AV *visited[MAX_PROTOTYPE_DEPTH];
3515	4		int depth = 0;
3516			int i;
3517
3518	4	50	if (items < 1) croak("Usage: Object::Proto::prototype_depth($obj)");
3519
3520	4	50	if (!SvROK(ST(0)) \|\| SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
		50
3521	0		croak("Not an object");
3522			}
3523
3524	4		av = (AV*)SvRV(ST(0));
3525
3526	7	50	while (av && depth < MAX_PROTOTYPE_DEPTH) {
		50
3527			SV **proto_svp;
3528
3529			/* Check for circular reference */
3530	11	100	for (i = 0; i < depth; i++) {
3531	4	50	if (visited[i] == av) {
3532	0		goto done;
3533			}
3534			}
3535	7		visited[depth] = av;
3536
3537	7		proto_svp = av_fetch(av, 0, 0);
3538	7	50	if (!proto_svp \|\| !SvROK(proto_svp) \|\| SvTYPE(SvRV(proto_svp)) != SVt_PVAV) {
		100
		50
3539			break;
3540			}
3541	3		av = (AV)SvRV(proto_svp);
3542	3		depth++;
3543			}
3544
3545	4		done:
3546	4		XSRETURN_IV(depth);
3547			}
3548
3549	413		static XS(xs_lock) {
3550	413		dXSARGS;
3551			MAGIC *mg;
3552
3553	413	50	if (items < 1) croak("Usage: Object::Proto::lock($obj)");
3554	413	100	VALIDATE_OBJECT(ST(0), "Object::Proto::lock");
		50
		50
3555
3556	410		mg = get_object_magic(aTHX_ ST(0));
3557	410	100	if (!mg) mg = add_object_magic(aTHX_ ST(0));
3558	410	50	if (mg->mg_private & OBJ_FLAG_FROZEN) {
3559	0		croak("Object is frozen");
3560			}
3561	410		mg->mg_private \|= OBJ_FLAG_LOCKED;
3562	410		XSRETURN_EMPTY;
3563			}
3564
3565	404		static XS(xs_unlock) {
3566	404		dXSARGS;
3567			MAGIC *mg;
3568
3569	404	50	if (items < 1) croak("Usage: Object::Proto::unlock($obj)");
3570	404	100	VALIDATE_OBJECT(ST(0), "Object::Proto::unlock");
		50
		50
3571
3572	403		mg = get_object_magic(aTHX_ ST(0));
3573	403	50	if (mg) {
3574	403	100	if (mg->mg_private & OBJ_FLAG_FROZEN) {
3575	1		croak("Cannot unlock frozen object");
3576			}
3577	402		mg->mg_private &= ~OBJ_FLAG_LOCKED;
3578			}
3579	402		XSRETURN_EMPTY;
3580			}
3581
3582	14		static XS(xs_freeze) {
3583	14		dXSARGS;
3584			MAGIC *mg;
3585
3586	14	50	if (items < 1) croak("Usage: Object::Proto::freeze($obj)");
3587	14	100	VALIDATE_OBJECT(ST(0), "Object::Proto::freeze");
		50
		100
3588
3589	12		mg = get_object_magic(aTHX_ ST(0));
3590	12	100	if (!mg) mg = add_object_magic(aTHX_ ST(0));
3591	12		mg->mg_private \|= (OBJ_FLAG_FROZEN \| OBJ_FLAG_LOCKED);
3592	12		XSRETURN_EMPTY;
3593			}
3594
3595	3009		static XS(xs_is_frozen) {
3596	3009		dXSARGS;
3597			MAGIC *mg;
3598
3599	3009	50	if (items < 1) croak("Usage: Object::Proto::is_frozen($obj)");
3600	3009	100	VALIDATE_OBJECT(ST(0), "Object::Proto::is_frozen");
		50
		50
3601
3602	3008		mg = get_object_magic(aTHX_ ST(0));
3603	3008	100	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		50
3604	3005		XSRETURN_YES;
3605			}
3606	3		XSRETURN_NO;
3607			}
3608
3609	3418		static XS(xs_is_locked) {
3610	3418		dXSARGS;
3611			MAGIC *mg;
3612
3613	3418	50	if (items < 1) croak("Usage: Object::Proto::is_locked($obj)");
3614	3418	100	VALIDATE_OBJECT(ST(0), "Object::Proto::is_locked");
		50
		50
3615
3616	3417		mg = get_object_magic(aTHX_ ST(0));
3617	3417	100	if (mg && (mg->mg_private & OBJ_FLAG_LOCKED)) {
		100
3618	2409		XSRETURN_YES;
3619			}
3620	1008		XSRETURN_NO;
3621			}
3622
3623			/* ============================================
3624			Introspection API
3625			============================================ */
3626
3627			/* Deep clone an SV, recursing into refs.
3628			* seen_hv maps refaddr strings -> cloned SV* (handles circular refs).
3629			* Returns a mortal SV. */
3630	27533		static SV* deep_clone_sv(pTHX_ SV src, HV seen_hv) {
3631			SV *dst;
3632			char addr_buf[32];
3633			STRLEN addr_len;
3634			SV **cached;
3635
3636			/* Non-references: return a plain copy */
3637	27533	100	if (!SvROK(src)) {
3638	15275		return newSVsv(src);
3639			}
3640
3641			/* Check seen table to break circular references */
3642	12258		addr_len = (STRLEN)sprintf(addr_buf, "%p", (void*)SvRV(src));
3643	12258		cached = hv_fetch(seen_hv, addr_buf, (I32)addr_len, 0);
3644	12258	100	if (cached) {
3645	1		return SvREFCNT_inc(*cached);
3646			}
3647
3648	12257	100	if (SvTYPE(SvRV(src)) == SVt_PVAV) {
3649			/* Array ref (possibly blessed) */
3650	12250		AV src_av = (AV)SvRV(src);
3651	12250		AV *dst_av = newAV();
3652	12250		IV i, len = av_len(src_av);
3653
3654	12250		dst = newRV_noinc((SV*)dst_av);
3655	12250	100	if (SvOBJECT(SvRV(src)))
3656	6629		sv_bless(dst, SvSTASH(SvRV(src)));
3657
3658			/* Register before recursing to handle circular refs */
3659	12250		hv_store(seen_hv, addr_buf, (I32)addr_len, SvREFCNT_inc(dst), 0);
3660
3661	12250		av_extend(dst_av, len);
3662	39778	100	for (i = 0; i <= len; i++) {
3663	27528		SV **svp = av_fetch(src_av, i, 0);
3664	48419	50	if (svp && SvOK(*svp)) {
		100
3665	20891		SV child = deep_clone_sv(aTHX_ svp, seen_hv);
3666	20891		av_store(dst_av, i, child);
3667			} else {
3668	6637		av_store(dst_av, i, newSV(0));
3669			}
3670			}
3671
3672	7	100	} else if (SvTYPE(SvRV(src)) == SVt_PVHV) {
3673			/* Hash ref (possibly blessed) */
3674	6		HV src_hv = (HV)SvRV(src);
3675	6		HV *dst_hv = newHV();
3676			HE *he;
3677
3678	6		dst = newRV_noinc((SV*)dst_hv);
3679	6	50	if (SvOBJECT(SvRV(src)))
3680	0		sv_bless(dst, SvSTASH(SvRV(src)));
3681
3682	6		hv_store(seen_hv, addr_buf, (I32)addr_len, SvREFCNT_inc(dst), 0);
3683
3684	6		hv_iterinit(src_hv);
3685	16	100	while ((he = hv_iternext(src_hv))) {
3686			STRLEN klen;
3687	10	50	const char *key = HePV(he, klen);
3688	10		SV *val = HeVAL(he);
3689	10		SV *copy = deep_clone_sv(aTHX_ val, seen_hv);
3690	10		hv_store(dst_hv, key, (I32)klen, copy, 0);
3691			}
3692
3693	1	50	} else if (SvTYPE(SvRV(src)) < SVt_PVAV) {
3694			/* Scalar ref */
3695	1		SV *inner = deep_clone_sv(aTHX_ SvRV(src), seen_hv);
3696	1		dst = newRV_noinc(inner);
3697	1	50	if (SvOBJECT(SvRV(src)))
3698	0		sv_bless(dst, SvSTASH(SvRV(src)));
3699	1		hv_store(seen_hv, addr_buf, (I32)addr_len, SvREFCNT_inc(dst), 0);
3700
3701			} else {
3702			/* Code refs, globs, etc. — share as-is */
3703	0		dst = newSVsv(src);
3704	0		hv_store(seen_hv, addr_buf, (I32)addr_len, SvREFCNT_inc(dst), 0);
3705			}
3706
3707	12257		return dst;
3708			}
3709
3710			/* Object::Proto::clone($obj) - deep clone an object, arrayref, hashref,
3711			* scalarref, or plain scalar */
3712	6637		static XS(xs_clone) {
3713	6637		dXSARGS;
3714			SV *src;
3715
3716	6637	50	if (items < 1) croak("Usage: Object::Proto::clone($val) or $obj->clone()");
3717
3718	6637		src = ST(0);
3719
3720			/* Plain scalar (non-ref): return a copy of the value */
3721	6637	100	if (!SvROK(src)) {
3722	6	100	if (SvOK(src)) {
3723	4		ST(0) = sv_2mortal(newSVsv(src));
3724			} else {
3725	2		ST(0) = &PL_sv_undef;
3726			}
3727	6		XSRETURN(1);
3728			}
3729
3730			{
3731	6631		HV *seen_hv = newHV();
3732			SV *dst;
3733
3734			/* For blessed objects backed by an AV: strip frozen/locked magic
3735			* by cloning the underlying AV fresh (deep_clone_sv handles the
3736			* bless but the new ref carries no Object::Proto magic). */
3737	6631		dst = deep_clone_sv(aTHX_ src, seen_hv);
3738	6631		SvREFCNT_dec((SV*)seen_hv);
3739
3740	6631		ST(0) = sv_2mortal(dst);
3741	6631		XSRETURN(1);
3742			}
3743			}
3744
3745			/* Object::Proto::properties($class) - return property names for a class */
3746	10620		static XS(xs_properties) {
3747	10620		dXSARGS;
3748			STRLEN class_len;
3749			const char *class_pv;
3750			ClassMeta *meta;
3751			IV i;
3752
3753	10620	50	if (items < 1) croak("Usage: Object::Proto::properties($class)");
3754
3755	10620		class_pv = SvPV(ST(0), class_len);
3756
3757	10620		meta = get_class_meta(aTHX_ class_pv, class_len);
3758	10620	100	if (!meta) {
3759			/* Non-existent class: return empty list / 0 */
3760	4002	100	if (GIMME_V == G_ARRAY) {
3761	2001		XSRETURN_EMPTY;
3762			} else {
3763	2001		XSRETURN_IV(0);
3764			}
3765			}
3766
3767	6618	100	if (GIMME_V == G_ARRAY) {
3768			/* List context: return property names */
3769	4617		IV count = meta->slot_count - 1; /* -1 because slot 0 is prototype */
3770	4617		SP -= items;
3771	4617	50	EXTEND(SP, count);
		50
3772
3773	18477	100	for (i = 1; i < meta->slot_count; i++) {
3774	13860	50	if (meta->idx_to_prop[i]) {
3775	13860		PUSHs(sv_2mortal(newSVpv(meta->idx_to_prop[i], 0)));
3776			}
3777			}
3778	4617		XSRETURN(count);
3779			} else {
3780			/* Scalar context: return count */
3781	2001		XSRETURN_IV(meta->slot_count - 1);
3782			}
3783			}
3784
3785			/* Object::Proto::slot_info($class, $property) - return hashref with slot metadata */
3786	16830		static XS(xs_slot_info) {
3787	16830		dXSARGS;
3788			STRLEN class_len, prop_len;
3789			const char class_pv, prop_pv;
3790			ClassMeta *meta;
3791			SV **idx_svp;
3792			IV idx;
3793			SlotSpec *spec;
3794			HV *info;
3795
3796	16830	50	if (items < 2) croak("Usage: Object::Proto::slot_info($class, $property)");
3797
3798	16830		class_pv = SvPV(ST(0), class_len);
3799	16830		prop_pv = SvPV(ST(1), prop_len);
3800
3801			/* Look up class meta */
3802	16830		meta = get_class_meta(aTHX_ class_pv, class_len);
3803	16830	100	if (!meta) {
3804	2002		XSRETURN_UNDEF;
3805			}
3806
3807			/* Look up property index - O(1) hash lookup */
3808	14828		idx_svp = hv_fetch(meta->prop_to_idx, prop_pv, prop_len, 0);
3809	14828	100	if (!idx_svp) {
3810	2002		XSRETURN_UNDEF;
3811			}
3812	12826		idx = SvIV(*idx_svp);
3813
3814			/* Build result hashref */
3815	12826		info = newHV();
3816
3817			/* Basic info always present */
3818	12826		hv_store(info, "name", 4, newSVpv(prop_pv, prop_len), 0);
3819	12826		hv_store(info, "index", 5, newSViv(idx), 0);
3820
3821			/* Get slot spec if available */
3822	12826	50	spec = (meta->slots && idx < meta->slot_count) ? meta->slots[idx] : NULL;
		50
3823
3824	12826	50	if (spec && spec->has_type) {
		100
3825			const char *type_name;
3826	10824	100	if (spec->type_id == TYPE_CUSTOM && spec->registered) {
		50
3827	1		type_name = spec->registered->name;
3828			} else {
3829	10823		type_name = type_id_to_name(spec->type_id);
3830			}
3831	10824		hv_store(info, "type", 4, newSVpv(type_name, 0), 0);
3832			}
3833
3834			/* Boolean flags */
3835	12826	50	hv_store(info, "is_required", 11, newSViv(spec ? spec->is_required : 0), 0);
3836	12826	50	hv_store(info, "is_readonly", 11, newSViv(spec ? spec->is_readonly : 0), 0);
3837	12826	50	hv_store(info, "is_lazy", 7, newSViv(spec ? spec->is_lazy : 0), 0);
3838	12826	50	hv_store(info, "is_weak", 7, newSViv(spec ? spec->is_weak : 0), 0);
3839	12826	50	hv_store(info, "has_default", 11, newSViv(spec ? spec->has_default : 0), 0);
3840	12826	50	hv_store(info, "has_trigger", 11, newSViv(spec ? spec->has_trigger : 0), 0);
3841	12826	50	hv_store(info, "has_coerce", 10, newSViv(spec ? spec->has_coerce : 0), 0);
3842	12826	50	hv_store(info, "has_builder", 11, newSViv(spec ? spec->has_builder : 0), 0);
3843	12826	50	hv_store(info, "has_clearer", 11, newSViv(spec ? spec->has_clearer : 0), 0);
3844	12826	50	hv_store(info, "has_predicate", 13, newSViv(spec ? spec->has_predicate : 0), 0);
3845	12826	50	hv_store(info, "has_type", 8, newSViv(spec ? spec->has_type : 0), 0);
3846
3847			/* Default value (if present) */
3848	12826	50	if (spec && spec->has_default && spec->default_sv) {
		100
		50
3849	5204		hv_store(info, "default", 7, newSVsv(spec->default_sv), 0);
3850			}
3851
3852			/* Builder method name */
3853	12826	50	if (spec && spec->has_builder && spec->builder_name) {
		100
		50
3854	2		hv_store(info, "builder", 7, newSVsv(spec->builder_name), 0);
3855			}
3856
3857			/* init_arg (if specified) */
3858	12826	50	if (spec && spec->init_arg) {
		100
3859	1		hv_store(info, "init_arg", 8, newSVsv(spec->init_arg), 0);
3860			}
3861
3862	12826		ST(0) = sv_2mortal(newRV_noinc((SV*)info));
3863	12826		XSRETURN(1);
3864			}
3865
3866			/* Object::Proto::parent($class) - return parent class name or undef */
3867	7		static XS(xs_parent) {
3868	7		dXSARGS;
3869			STRLEN class_len;
3870			const char *class_pv;
3871			ClassMeta *meta;
3872
3873	7	50	if (items < 1) croak("Usage: Object::Proto::parent($class)");
3874
3875	7		class_pv = SvPV(ST(0), class_len);
3876	7		meta = get_class_meta(aTHX_ class_pv, class_len);
3877
3878	7	50	if (!meta \|\| meta->parent_count == 0) {
		100
3879	2	50	if (GIMME_V == G_ARRAY) {
3880	0		XSRETURN_EMPTY;
3881			}
3882	2		XSRETURN_UNDEF;
3883			}
3884
3885	5	100	if (GIMME_V == G_ARRAY) {
3886			/* List context: return all parents */
3887			IV i;
3888	1		SP -= items;
3889	1	50	EXTEND(SP, meta->parent_count);
		50
3890	3	100	for (i = 0; i < meta->parent_count; i++) {
3891	2		PUSHs(sv_2mortal(newSVpv(meta->parent_classes[i], 0)));
3892			}
3893	1		XSRETURN(meta->parent_count);
3894			} else {
3895			/* Scalar context: return first parent */
3896	4		ST(0) = sv_2mortal(newSVpv(meta->parent_classes[0], 0));
3897	4		XSRETURN(1);
3898			}
3899			}
3900
3901			/* Object::Proto::ancestors($class) - return list of all ancestor class names (breadth-first) */
3902	4		static XS(xs_ancestors) {
3903	4		dXSARGS;
3904			STRLEN class_len;
3905			const char *class_pv;
3906			ClassMeta *meta;
3907			AV *result;
3908			HV *seen;
3909			AV *queue;
3910	4		IV count = 0;
3911
3912	4	50	if (items < 1) croak("Usage: Object::Proto::ancestors($class)");
3913
3914	4		class_pv = SvPV(ST(0), class_len);
3915	4		meta = get_class_meta(aTHX_ class_pv, class_len);
3916
3917	4		SP -= items;
3918
3919	4	50	if (meta && meta->parent_count > 0) {
		100
3920			IV i;
3921	3		result = newAV();
3922	3		seen = newHV();
3923	3		queue = newAV();
3924
3925			/* Seed queue with direct parents */
3926	7	100	for (i = 0; i < meta->parent_count; i++) {
3927	4		av_push(queue, newSVpv(meta->parent_metas[i]->class_name, 0));
3928			}
3929
3930			/* BFS traversal */
3931	8	100	while (av_len(queue) >= 0) {
3932	5		SV *cur_sv = av_shift(queue);
3933			STRLEN cur_len;
3934	5		const char *cur_name = SvPV(cur_sv, cur_len);
3935			ClassMeta *cur_meta;
3936
3937			/* Skip if already seen */
3938	5	50	if (hv_exists(seen, cur_name, cur_len)) {
3939	0		SvREFCNT_dec(cur_sv);
3940	0		continue;
3941			}
3942	5		hv_store(seen, cur_name, cur_len, &PL_sv_yes, 0);
3943	5		av_push(result, cur_sv);
3944
3945			/* Enqueue this class's parents */
3946	5		cur_meta = get_class_meta(aTHX_ cur_name, cur_len);
3947	5	50	if (cur_meta) {
3948	6	100	for (i = 0; i < cur_meta->parent_count; i++) {
3949	1		const char *pname = cur_meta->parent_classes[i];
3950	1	50	if (!hv_exists(seen, pname, strlen(pname))) {
3951	1		av_push(queue, newSVpv(pname, 0));
3952			}
3953			}
3954			}
3955			}
3956
3957	3		count = av_len(result) + 1;
3958	3	50	EXTEND(SP, count);
		50
3959	8	100	for (i = 0; i < count; i++) {
3960	5		SV **elem = av_fetch(result, i, 0);
3961	5	50	if (elem) PUSHs(sv_2mortal(newSVsv(*elem)));
3962			}
3963
3964	3		SvREFCNT_dec((SV*)result);
3965	3		SvREFCNT_dec((SV*)seen);
3966	3		SvREFCNT_dec((SV*)queue);
3967			}
3968
3969	4		XSRETURN(count);
3970			}
3971
3972			/* ============================================
3973			Global cleanup
3974			============================================ */
3975
3976			/* Cleanup during global destruction */
3977	52		static void object_cleanup_globals(pTHX_ void *data) {
3978			PERL_UNUSED_ARG(data);
3979
3980			/* During global destruction, just NULL out pointers.
3981			* Perl handles SV cleanup. Trying to free them ourselves
3982			* can cause crashes due to destruction order. */
3983	52	50	if (PL_dirty) {
3984	52		g_type_registry = NULL;
3985	52		g_class_registry = NULL;
3986	52		g_func_accessor_registry = NULL;
3987	52		return;
3988			}
3989
3990			/* Normal cleanup - not during global destruction */
3991			/* Note: Full cleanup omitted for simplicity; Perl handles SV refcounts */
3992	0		g_type_registry = NULL;
3993	0		g_class_registry = NULL;
3994	0		g_func_accessor_registry = NULL;
3995			}
3996
3997			/* ============================================
3998			Type Registry API
3999			============================================ */
4000
4001			/* C-level registration for external XS modules (called from BOOT)
4002			This is the fast path - no Perl callback overhead */
4003	0		PERL_CALLCONV void object_register_type_xs(pTHX_ const char *name,
4004			ObjectTypeCheckFunc check,
4005			ObjectTypeCoerceFunc coerce) {
4006			RegisteredType *type;
4007	0		STRLEN name_len = strlen(name);
4008
4009	0	0	if (!g_type_registry) {
4010	0		g_type_registry = newHV();
4011			}
4012
4013			/* Check if already registered */
4014	0		SV **existing = hv_fetch(g_type_registry, name, name_len, 0);
4015	0	0	if (existing) {
4016	0		croak("Type '%s' is already registered", name);
4017			}
4018
4019	0		Newxz(type, 1, RegisteredType);
4020	0		Newx(type->name, name_len + 1, char);
4021	0		Copy(name, type->name, name_len, char);
4022	0		type->name[name_len] = '\0';
4023
4024	0		type->check = check; /* Direct C function pointer - no Perl overhead */
4025	0		type->coerce = coerce; /* Direct C function pointer - no Perl overhead */
4026	0		type->perl_check = NULL;
4027	0		type->perl_coerce = NULL;
4028
4029	0		hv_store(g_type_registry, name, name_len, newSViv(PTR2IV(type)), 0);
4030	0		}
4031
4032			/* Getter for external modules to look up a registered type */
4033	0		PERL_CALLCONV RegisteredType* object_get_registered_type(pTHX_ const char *name) {
4034	0		STRLEN name_len = strlen(name);
4035	0	0	if (!g_type_registry) return NULL;
4036
4037	0		SV **svp = hv_fetch(g_type_registry, name, name_len, 0);
4038	0	0	if (svp && SvIOK(*svp)) {
		0
4039	0		return INT2PTR(RegisteredType, SvIV(svp));
4040			}
4041	0		return NULL;
4042			}
4043
4044			/* Object::Proto::register_type($name, $check_cb [, $coerce_cb]) */
4045	8		static XS(xs_register_type) {
4046	8		dXSARGS;
4047			STRLEN name_len;
4048			const char *name;
4049			RegisteredType *type;
4050
4051	8	50	if (items < 2) croak("Usage: Object::Proto::register_type($name, $check_cb [, $coerce_cb])");
4052
4053	8		name = SvPV(ST(0), name_len);
4054
4055			/* Check if already registered */
4056	8	50	if (g_type_registry) {
4057	8		SV **existing = hv_fetch(g_type_registry, name, name_len, 0);
4058	8	100	if (existing) {
4059	1		croak("Type '%s' is already registered", name);
4060			}
4061			} else {
4062	0		g_type_registry = newHV();
4063			}
4064
4065	7		Newxz(type, 1, RegisteredType);
4066	7		Newx(type->name, name_len + 1, char);
4067	7		Copy(name, type->name, name_len, char);
4068	7		type->name[name_len] = '\0';
4069
4070			/* Store Perl check callback */
4071	7		type->perl_check = newSVsv(ST(1));
4072	7		SvREFCNT_inc(type->perl_check);
4073
4074			/* Store Perl coerce callback if provided */
4075	7	100	if (items > 2 && SvOK(ST(2))) {
		50
4076	3		type->perl_coerce = newSVsv(ST(2));
4077	3		SvREFCNT_inc(type->perl_coerce);
4078			}
4079
4080	7		hv_store(g_type_registry, name, name_len, newSViv(PTR2IV(type)), 0);
4081
4082	7		XSRETURN_YES;
4083			}
4084
4085			/* Object::Proto::has_type($name) - check if a type is registered */
4086	4010		static XS(xs_has_type) {
4087	4010		dXSARGS;
4088			STRLEN name_len;
4089			const char *name;
4090
4091	4010	50	if (items < 1) croak("Usage: Object::Proto::has_type($name)");
4092
4093	4010		name = SvPV(ST(0), name_len);
4094
4095			/* Check built-in types */
4096	4010		BuiltinTypeID builtin = parse_builtin_type(name, name_len);
4097	4010	100	if (builtin != TYPE_NONE) {
4098	3003		XSRETURN_YES;
4099			}
4100
4101			/* Check registry */
4102	1007	50	if (g_type_registry) {
4103	1007		SV **existing = hv_fetch(g_type_registry, name, name_len, 0);
4104	1007	100	if (existing) {
4105	6		XSRETURN_YES;
4106			}
4107			}
4108
4109	1001		XSRETURN_NO;
4110			}
4111
4112			/* Object::Proto::list_types() - return list of registered type names */
4113	2402		static XS(xs_list_types) {
4114	2402		dXSARGS;
4115	2402		AV *result = newAV();
4116
4117			PERL_UNUSED_ARG(items);
4118
4119			/* Add built-in types */
4120	2402		av_push(result, newSVpvs("Any"));
4121	2402		av_push(result, newSVpvs("Defined"));
4122	2402		av_push(result, newSVpvs("Str"));
4123	2402		av_push(result, newSVpvs("Int"));
4124	2402		av_push(result, newSVpvs("Num"));
4125	2402		av_push(result, newSVpvs("Bool"));
4126	2402		av_push(result, newSVpvs("ArrayRef"));
4127	2402		av_push(result, newSVpvs("HashRef"));
4128	2402		av_push(result, newSVpvs("CodeRef"));
4129	2402		av_push(result, newSVpvs("Object"));
4130
4131			/* Add registered types */
4132	2402	50	if (g_type_registry) {
4133			HE *he;
4134	2402		hv_iterinit(g_type_registry);
4135	2406	100	while ((he = hv_iternext(g_type_registry))) {
4136	4		av_push(result, newSVsv(hv_iterkeysv(he)));
4137			}
4138			}
4139
4140	2402		ST(0) = newRV_noinc((SV*)result);
4141	2402		sv_2mortal(ST(0));
4142	2402		XSRETURN(1);
4143			}
4144
4145			/* ============================================
4146			Singleton support
4147			============================================ */
4148
4149			/* XS implementation of instance() method for singletons */
4150	8053		static XS(xs_singleton_instance) {
4151	8053		dXSARGS;
4152	8053		ClassMeta meta = INT2PTR(ClassMeta, CvXSUBANY(cv).any_iv);
4153
4154			PERL_UNUSED_ARG(items);
4155
4156	8053	50	if (!meta) {
4157	0		croak("Singleton metadata not found");
4158			}
4159
4160			/* Return cached instance if it exists */
4161	8053	100	if (meta->singleton_instance && SvOK(meta->singleton_instance)) {
		50
4162	8045		ST(0) = meta->singleton_instance;
4163	8045		XSRETURN(1);
4164			}
4165
4166			/* Create new instance */
4167			{
4168	8		dSP;
4169			int count;
4170			SV *obj;
4171			GV *build_gv;
4172			char full_build[256];
4173
4174	8		ENTER;
4175	8		SAVETMPS;
4176
4177			/* Call ClassName->new() */
4178	8	50	PUSHMARK(SP);
4179	8	50	XPUSHs(sv_2mortal(newSVpv(meta->class_name, 0)));
4180	8		PUTBACK;
4181
4182	8		count = call_method("new", G_SCALAR);
4183
4184	8		SPAGAIN;
4185
4186	8	50	if (count != 1) {
4187	0		croak("Singleton new() did not return object");
4188			}
4189
4190	8		obj = POPs;
4191	8		SvREFCNT_inc(obj); /* Keep the object alive */
4192
4193	8		PUTBACK;
4194
4195			/* Check for BUILD method and call it */
4196	8		snprintf(full_build, sizeof(full_build), "%s::BUILD", meta->class_name);
4197	8		build_gv = gv_fetchpv(full_build, 0, SVt_PVCV);
4198	8	50	if (build_gv && GvCV(build_gv)) {
		100
4199	5	50	PUSHMARK(SP);
4200	5	50	XPUSHs(obj);
4201	5		PUTBACK;
4202	5		call_method("BUILD", G_VOID \| G_DISCARD);
4203			}
4204
4205			/* Cache the instance */
4206	8		meta->singleton_instance = obj;
4207
4208	8	50	FREETMPS;
4209	8		LEAVE;
4210
4211	8		ST(0) = obj;
4212	8		XSRETURN(1);
4213			}
4214			}
4215
4216			/* ============================================
4217			Role API
4218			============================================ */
4219
4220			/* Object::Proto::role("RoleName", @slot_specs) - define a role */
4221	7		static XS(xs_role) {
4222	7		dXSARGS;
4223			STRLEN role_len;
4224			const char *role_pv;
4225			RoleMeta *meta;
4226			IV i;
4227
4228	7	50	if (items < 1) croak("Usage: Object::Proto::role($role_name, @slot_specs)");
4229
4230	7		role_pv = SvPV(ST(0), role_len);
4231
4232			/* Check if role already exists */
4233	7		meta = get_role_meta(aTHX_ role_pv, role_len);
4234	7	50	if (meta) {
4235	0		croak("Role '%s' already defined", role_pv);
4236			}
4237
4238			/* Create role meta */
4239	7		Newxz(meta, 1, RoleMeta);
4240	7		Newxz(meta->role_name, role_len + 1, char);
4241	7		Copy(role_pv, meta->role_name, role_len, char);
4242	7		meta->role_name[role_len] = '\0';
4243	7		meta->stash = gv_stashpvn(role_pv, role_len, GV_ADD);
4244
4245			/* Allocate slots array */
4246	7	100	if (items > 1) {
4247	6		Newx(meta->slots, items - 1, SlotSpec*);
4248	6		meta->slot_count = 0;
4249
4250	14	100	for (i = 1; i < items; i++) {
4251			STRLEN spec_len;
4252	8		const char *spec_pv = SvPV(ST(i), spec_len);
4253	8		SlotSpec *spec = parse_slot_spec(aTHX_ spec_pv, spec_len);
4254	8		meta->slots[meta->slot_count++] = spec;
4255			}
4256			}
4257
4258	7		register_role_meta(aTHX_ role_pv, role_len, meta);
4259
4260	7		XSRETURN_EMPTY;
4261			}
4262
4263			/* Object::Proto::requires("RoleName", @method_names) - declare required methods */
4264	2		static XS(xs_requires) {
4265	2		dXSARGS;
4266			STRLEN role_len;
4267			const char *role_pv;
4268			RoleMeta *meta;
4269			IV i;
4270
4271	2	50	if (items < 2) croak("Usage: Object::Proto::requires($role_name, @method_names)");
4272
4273	2		role_pv = SvPV(ST(0), role_len);
4274	2		meta = get_role_meta(aTHX_ role_pv, role_len);
4275	2	50	if (!meta) {
4276	0		croak("Role '%s' not defined", role_pv);
4277			}
4278
4279			/* Add required methods */
4280	2	50	Renew(meta->required_methods, meta->required_count + items - 1, char*);
4281	4	100	for (i = 1; i < items; i++) {
4282			STRLEN name_len;
4283	2		const char *name_pv = SvPV(ST(i), name_len);
4284	2		Newx(meta->required_methods[meta->required_count], name_len + 1, char);
4285	2		Copy(name_pv, meta->required_methods[meta->required_count], name_len, char);
4286	2		meta->required_methods[meta->required_count][name_len] = '\0';
4287	2		meta->required_count++;
4288			}
4289
4290	2		XSRETURN_EMPTY;
4291			}
4292
4293			/* Object::Proto::with("ClassName", @role_names) - apply roles to a class */
4294	9		static XS(xs_with) {
4295	9		dXSARGS;
4296			STRLEN class_len;
4297			const char *class_pv;
4298			ClassMeta *class_meta;
4299			IV i;
4300
4301	9	50	if (items < 2) croak("Usage: Object::Proto::with($class_name, @role_names)");
4302
4303	9		class_pv = SvPV(ST(0), class_len);
4304	9		class_meta = get_class_meta(aTHX_ class_pv, class_len);
4305	9	50	if (!class_meta) {
4306	0		croak("Class '%s' not defined with Object::Proto::define", class_pv);
4307			}
4308
4309	17	100	for (i = 1; i < items; i++) {
4310			STRLEN role_len;
4311	11		const char *role_pv = SvPV(ST(i), role_len);
4312	11		RoleMeta *role_meta = get_role_meta(aTHX_ role_pv, role_len);
4313
4314	11	50	if (!role_meta) {
4315			/* Auto-load the role module */
4316	0		SV *module_sv = newSVpvn(role_pv, role_len);
4317			SV *err;
4318	0		load_module(PERL_LOADMOD_NOIMPORT, module_sv, NULL);
4319	0	0	err = ERRSV;
4320	0	0	if (SvTRUE(err)) {
4321	0		croak("Role '%s' not defined (failed to load: %" SVf ")", role_pv, SVfARG(err));
4322			}
4323	0		role_meta = get_role_meta(aTHX_ role_pv, role_len);
4324			}
4325	11	50	if (!role_meta) {
4326	0		croak("Role '%s' not defined", role_pv);
4327			}
4328
4329	11		apply_role_to_class(aTHX_ class_meta, role_meta);
4330			}
4331
4332	6		XSRETURN_EMPTY;
4333			}
4334
4335			/* Object::Proto::does("ClassName" or $obj, "RoleName") - check if class/object does role */
4336	8		static XS(xs_does) {
4337	8		dXSARGS;
4338			ClassMeta *meta;
4339			STRLEN role_len;
4340			const char *role_pv;
4341			IV i;
4342
4343	8	50	if (items < 2) croak("Usage: Object::Proto::does($class_or_obj, $role_name)");
4344
4345			/* Get class meta from class name or object */
4346	8	100	if (SvROK(ST(0))) {
4347			/* Object - get stash name */
4348	7		HV *stash = SvSTASH(SvRV(ST(0)));
4349	7	50	meta = get_class_meta(aTHX_ HvNAME(stash), HvNAMELEN(stash));
		50
		50
		0
		50
		50
		50
		50
		50
		0
		50
		50
4350			} else {
4351			STRLEN class_len;
4352	1		const char *class_pv = SvPV(ST(0), class_len);
4353	1		meta = get_class_meta(aTHX_ class_pv, class_len);
4354			}
4355
4356	8	50	if (!meta) {
4357	0		XSRETURN_NO;
4358			}
4359
4360	8		role_pv = SvPV(ST(1), role_len);
4361
4362			/* Check if role is in consumed_roles */
4363	11	100	for (i = 0; i < meta->role_count; i++) {
4364	10	100	if (strEQ(meta->consumed_roles[i]->role_name, role_pv)) {
4365	7		XSRETURN_YES;
4366			}
4367			}
4368
4369	1		XSRETURN_NO;
4370			}
4371
4372			/* ============================================
4373			Method Modifier API
4374			============================================ */
4375
4376			/* Object::Proto::before("Class::method", \&callback) */
4377	4		static XS(xs_before) {
4378	4		dXSARGS;
4379			STRLEN full_name_len;
4380			const char *full_name;
4381			char class_name, method_name, *sep;
4382			ClassMeta *meta;
4383
4384	4	50	if (items != 2) croak("Usage: Object::Proto::before('Class::method', \\&callback)");
4385
4386	4		full_name = SvPV(ST(0), full_name_len);
4387	4	50	if (!SvROK(ST(1)) \|\| SvTYPE(SvRV(ST(1))) != SVt_PVCV) {
		50
4388	0		croak("Second argument must be a code reference");
4389			}
4390
4391			/* Parse "Class::method" */
4392	4		sep = strstr(full_name, "::");
4393	4	50	if (!sep) {
4394	0		croak("Method name must be fully qualified (Class::method)");
4395			}
4396
4397			{
4398	4		STRLEN class_len = sep - full_name;
4399	4		Newx(class_name, class_len + 1, char);
4400	4		Copy(full_name, class_name, class_len, char);
4401	4		class_name[class_len] = '\0';
4402	4		method_name = sep + 2;
4403			}
4404
4405	4		meta = get_class_meta(aTHX_ class_name, strlen(class_name));
4406	4	50	if (!meta) {
4407	0		Safefree(class_name);
4408	0		croak("Class '%s' not defined with Object::Proto::define", class_name);
4409			}
4410
4411	4		add_modifier(aTHX_ meta, method_name, ST(1), 0); /* 0 = before */
4412
4413	4		Safefree(class_name);
4414	4		XSRETURN_EMPTY;
4415			}
4416
4417			/* Object::Proto::after("Class::method", \&callback) */
4418	4		static XS(xs_after) {
4419	4		dXSARGS;
4420			STRLEN full_name_len;
4421			const char *full_name;
4422			char class_name, method_name, *sep;
4423			ClassMeta *meta;
4424
4425	4	50	if (items != 2) croak("Usage: Object::Proto::after('Class::method', \\&callback)");
4426
4427	4		full_name = SvPV(ST(0), full_name_len);
4428	4	50	if (!SvROK(ST(1)) \|\| SvTYPE(SvRV(ST(1))) != SVt_PVCV) {
		50
4429	0		croak("Second argument must be a code reference");
4430			}
4431
4432	4		sep = strstr(full_name, "::");
4433	4	50	if (!sep) {
4434	0		croak("Method name must be fully qualified (Class::method)");
4435			}
4436
4437			{
4438	4		STRLEN class_len = sep - full_name;
4439	4		Newx(class_name, class_len + 1, char);
4440	4		Copy(full_name, class_name, class_len, char);
4441	4		class_name[class_len] = '\0';
4442	4		method_name = sep + 2;
4443			}
4444
4445	4		meta = get_class_meta(aTHX_ class_name, strlen(class_name));
4446	4	50	if (!meta) {
4447	0		Safefree(class_name);
4448	0		croak("Class '%s' not defined with Object::Proto::define", class_name);
4449			}
4450
4451	4		add_modifier(aTHX_ meta, method_name, ST(1), 1); /* 1 = after */
4452
4453	4		Safefree(class_name);
4454	4		XSRETURN_EMPTY;
4455			}
4456
4457			/* Object::Proto::around("Class::method", \&callback) */
4458	2		static XS(xs_around) {
4459	2		dXSARGS;
4460			STRLEN full_name_len;
4461			const char *full_name;
4462			char class_name, method_name, *sep;
4463			ClassMeta *meta;
4464
4465	2	50	if (items != 2) croak("Usage: Object::Proto::around('Class::method', \\&callback)");
4466
4467	2		full_name = SvPV(ST(0), full_name_len);
4468	2	50	if (!SvROK(ST(1)) \|\| SvTYPE(SvRV(ST(1))) != SVt_PVCV) {
		50
4469	0		croak("Second argument must be a code reference");
4470			}
4471
4472	2		sep = strstr(full_name, "::");
4473	2	50	if (!sep) {
4474	0		croak("Method name must be fully qualified (Class::method)");
4475			}
4476
4477			{
4478	2		STRLEN class_len = sep - full_name;
4479	2		Newx(class_name, class_len + 1, char);
4480	2		Copy(full_name, class_name, class_len, char);
4481	2		class_name[class_len] = '\0';
4482	2		method_name = sep + 2;
4483			}
4484
4485	2		meta = get_class_meta(aTHX_ class_name, strlen(class_name));
4486	2	50	if (!meta) {
4487	0		Safefree(class_name);
4488	0		croak("Class '%s' not defined with Object::Proto::define", class_name);
4489			}
4490
4491	2		add_modifier(aTHX_ meta, method_name, ST(1), 2); /* 2 = around */
4492
4493	2		Safefree(class_name);
4494	2		XSRETURN_EMPTY;
4495			}
4496
4497			/* Object::Proto::singleton("Class") - marks class as singleton and installs instance() method */
4498	8		static XS(xs_singleton) {
4499	8		dXSARGS;
4500			STRLEN class_len;
4501			const char *class_pv;
4502			ClassMeta *meta;
4503			char full_name[256];
4504			CV *instance_cv;
4505
4506	8	50	if (items < 1) croak("Usage: Object::Proto::singleton($class)");
4507
4508	8		class_pv = SvPV(ST(0), class_len);
4509
4510	8		meta = get_class_meta(aTHX_ class_pv, class_len);
4511	8	50	if (!meta) {
4512	0		croak("Class '%s' not defined with Object::Proto::define", class_pv);
4513			}
4514
4515			/* Mark as singleton */
4516	8		meta->is_singleton = 1;
4517	8		meta->singleton_instance = NULL;
4518
4519			/* Install instance() class method */
4520	8		snprintf(full_name, sizeof(full_name), "%s::instance", class_pv);
4521	8		instance_cv = newXS(full_name, xs_singleton_instance, __FILE__);
4522	8		CvXSUBANY(instance_cv).any_iv = PTR2IV(meta);
4523
4524	8		XSRETURN_EMPTY;
4525			}
4526
4527			/* ============================================
4528			Boot
4529			============================================ */
4530
4531	52		XS_EXTERNAL(boot_Object__Proto) {
4532	52		dXSBOOTARGSXSAPIVERCHK;
4533			PERL_UNUSED_VAR(items);
4534
4535			/* Register custom ops */
4536	52		XopENTRY_set(&object_new_xop, xop_name, "object_new");
4537	52		XopENTRY_set(&object_new_xop, xop_desc, "object constructor");
4538	52		XopENTRY_set(&object_new_xop, xop_class, OA_BASEOP);
4539	52		Perl_custom_op_register(aTHX_ pp_object_new, &object_new_xop);
4540
4541	52		XopENTRY_set(&object_get_xop, xop_name, "object_get");
4542	52		XopENTRY_set(&object_get_xop, xop_desc, "object property get");
4543	52		XopENTRY_set(&object_get_xop, xop_class, OA_UNOP);
4544	52		Perl_custom_op_register(aTHX_ pp_object_get, &object_get_xop);
4545
4546	52		XopENTRY_set(&object_set_xop, xop_name, "object_set");
4547	52		XopENTRY_set(&object_set_xop, xop_desc, "object property set");
4548	52		XopENTRY_set(&object_set_xop, xop_class, OA_BINOP);
4549	52		Perl_custom_op_register(aTHX_ pp_object_set, &object_set_xop);
4550
4551	52		XopENTRY_set(&object_set_typed_xop, xop_name, "object_set_typed");
4552	52		XopENTRY_set(&object_set_typed_xop, xop_desc, "object property set with type check");
4553	52		XopENTRY_set(&object_set_typed_xop, xop_class, OA_BINOP);
4554	52		Perl_custom_op_register(aTHX_ pp_object_set_typed, &object_set_typed_xop);
4555
4556	52		XopENTRY_set(&object_func_get_xop, xop_name, "object_func_get");
4557	52		XopENTRY_set(&object_func_get_xop, xop_desc, "object function-style get");
4558	52		XopENTRY_set(&object_func_get_xop, xop_class, OA_UNOP);
4559	52		Perl_custom_op_register(aTHX_ pp_object_func_get, &object_func_get_xop);
4560
4561	52		XopENTRY_set(&object_func_set_xop, xop_name, "object_func_set");
4562	52		XopENTRY_set(&object_func_set_xop, xop_desc, "object function-style set");
4563	52		XopENTRY_set(&object_func_set_xop, xop_class, OA_BINOP);
4564	52		Perl_custom_op_register(aTHX_ pp_object_func_set, &object_func_set_xop);
4565
4566			/* Initialize registries */
4567	52		g_class_registry = newHV();
4568	52		g_type_registry = newHV();
4569
4570			/* Install XS functions */
4571	52		newXS("Object::Proto::import", xs_import, __FILE__);
4572	52		newXS("Object::Proto::define", xs_define, __FILE__);
4573	52		newXS("Object::Proto::import_accessors", xs_import_accessors, __FILE__);
4574	52		newXS("Object::Proto::import_accessor", xs_import_accessor, __FILE__);
4575	52		newXS("Object::Proto::prototype", xs_prototype, __FILE__);
4576	52		newXS("Object::Proto::set_prototype", xs_set_prototype, __FILE__);
4577	52		newXS("Object::Proto::prototype_chain", xs_prototype_chain, __FILE__);
4578	52		newXS("Object::Proto::has_own_property", xs_has_own_property, __FILE__);
4579	52		newXS("Object::Proto::prototype_depth", xs_prototype_depth, __FILE__);
4580	52		newXS("Object::Proto::lock", xs_lock, __FILE__);
4581	52		newXS("Object::Proto::unlock", xs_unlock, __FILE__);
4582	52		newXS("Object::Proto::freeze", xs_freeze, __FILE__);
4583	52		newXS("Object::Proto::is_frozen", xs_is_frozen, __FILE__);
4584	52		newXS("Object::Proto::is_locked", xs_is_locked, __FILE__);
4585
4586			/* Introspection API */
4587	52		newXS("Object::Proto::clone", xs_clone, __FILE__);
4588	52		newXS("Object::Proto::properties", xs_properties, __FILE__);
4589	52		newXS("Object::Proto::slot_info", xs_slot_info, __FILE__);
4590
4591			/* Inheritance API */
4592	52		newXS("Object::Proto::parent", xs_parent, __FILE__);
4593	52		newXS("Object::Proto::ancestors", xs_ancestors, __FILE__);
4594
4595			/* Type registry API */
4596	52		newXS("Object::Proto::register_type", xs_register_type, __FILE__);
4597	52		newXS("Object::Proto::has_type", xs_has_type, __FILE__);
4598	52		newXS("Object::Proto::list_types", xs_list_types, __FILE__);
4599
4600			/* Singleton support */
4601	52		newXS("Object::Proto::singleton", xs_singleton, __FILE__);
4602
4603			/* Role API */
4604	52		newXS("Object::Proto::role", xs_role, __FILE__);
4605	52		newXS("Object::Proto::requires", xs_requires, __FILE__);
4606	52		newXS("Object::Proto::with", xs_with, __FILE__);
4607	52		newXS("Object::Proto::does", xs_does, __FILE__);
4608
4609			/* Method modifier API */
4610	52		newXS("Object::Proto::before", xs_before, __FILE__);
4611	52		newXS("Object::Proto::after", xs_after, __FILE__);
4612	52		newXS("Object::Proto::around", xs_around, __FILE__);
4613
4614			/* Register cleanup for global destruction */
4615	52		Perl_call_atexit(aTHX_ object_cleanup_globals, NULL);
4616
4617	52		Perl_xs_boot_epilog(aTHX_ ax);
4618	52		}