File Coverage

object.c

Criterion	Covered	Total	%
statement	1952	2354	82.9
branch	1174	2092	56.1
condition			n/a
subroutine			n/a
pod			n/a
total	3126	4446	70.3

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	42979		OBJECT_INLINE bool check_builtin_type(pTHX_ SV *val, BuiltinTypeID type_id) {
185	42979		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	11091		case TYPE_ARRAYREF:
227	11091	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	42996		static bool check_slot_type(pTHX_ SV val, SlotSpec spec) {
290	42996	50	if (!spec \|\| !spec->has_type) return true;
		50
291
292	42996	100	if (spec->type_id != TYPE_CUSTOM) {
293	42979		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	49613		static SV* resolve_property_chain(pTHX_ AV *av, IV idx) {
1038	49613		int depth = 0;
1039			AV visited[MAX_PROTOTYPE_DEPTH]; / Simple stack-based cycle detection */
1040			int i;
1041
1042	49639	50	while (av && depth < MAX_PROTOTYPE_DEPTH) {
		50
1043			/* Check for circular reference */
1044	49673	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	49638		visited[depth] = av;
1051
1052			/* Try to fetch the property at this level */
1053	49638	50	if (idx <= AvFILLp(av)) {
1054	49638		SV *slot = AvARRAY(av)[idx];
1055	49638	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	80144		static OP* pp_object_get(pTHX) {
1080	80144		dSP;
1081	80144		SV *obj = TOPs;
1082	80144		IV idx = PL_op->op_targ;
1083			AV *av;
1084			SV *sv;
1085
1086	80144	50	if (!SvROK(obj) \|\| SvTYPE(SvRV(obj)) != SVt_PVAV) {
		50
1087	0		croak("Not an object");
1088			}
1089
1090	80144		av = (AV*)SvRV(obj);
1091
1092			/* Fast path: direct slot access (common case - no prototype chain) */
1093	80144	50	if (idx <= AvFILLp(av)) {
1094	80144		sv = AvARRAY(av)[idx];
1095	80144	50	if (sv && SvOK(sv)) {
		50
1096	80144		SETs(sv);
1097	80144		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	35		static OP* pp_object_set(pTHX) {
1121	35		dSP;
1122	35		SV *val = POPs;
1123	35		SV *obj = TOPs;
1124	35		IV idx = PL_op->op_targ;
1125			SV *rv;
1126			AV *av;
1127
1128	35		rv = SvRV(obj);
1129	35	50	if (!SvROK(obj) \|\| SvTYPE(rv) != SVt_PVAV) {
		50
1130	0		croak("Not an object");
1131			}
1132
1133	35		av = (AV*)rv;
1134
1135			/* Only check magic if object has any (lazy magic - most objects don't) */
1136	35	50	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	35	50	if (idx <= AvFILLp(av)) {
1145	35		SV *slot = AvARRAY(av)[idx];
1146	35	50	if (slot) {
1147	35		sv_setsv(slot, val);
1148	35		SETs(val);
1149	35		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	55		static IV register_func_accessor_data(pTHX_ FuncAccessorData *data) {
1178	55	100	if (g_func_accessor_count >= g_func_accessor_capacity) {
1179	6	50	IV new_capacity = g_func_accessor_capacity ? g_func_accessor_capacity * 2 : 64;
1180	6	50	Renew(g_func_accessor_registry, new_capacity, FuncAccessorData*);
1181	6		g_func_accessor_capacity = new_capacity;
1182			}
1183	55		data->registry_id = g_func_accessor_count;
1184	55		g_func_accessor_registry[g_func_accessor_count] = data;
1185	55		return g_func_accessor_count++;
1186			}
1187
1188			/* Look up FuncAccessorData by ID — inlined for hot path performance */
1189	408		OBJECT_INLINE FuncAccessorData* get_func_accessor_data(IV id) {
1190	408		return g_func_accessor_registry[id];
1191			}
1192
1193	8086		static OP* pp_object_set_typed(pTHX) {
1194	8086		dSP;
1195	8086		SV *val = POPs;
1196	8086		SV *obj = TOPs;
1197	8086		SlotOpData data = INT2PTR(SlotOpData, PL_op->op_targ);
1198	8086		IV idx = data->slot_idx;
1199	8086		ClassMeta *meta = data->meta;
1200	8086		SlotSpec *spec = meta->slots[idx];
1201			AV *av;
1202
1203	8086	50	if (!SvROK(obj) \|\| SvTYPE(SvRV(obj)) != SVt_PVAV) {
		50
1204	0		croak("Not an object");
1205			}
1206
1207	8086		av = (AV*)SvRV(obj);
1208
1209			/* Check frozen/locked — only walk magic list if object has magic */
1210	8086	50	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	8086	50	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	8086	50	if (spec->has_type) {
1232	8086	50	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	8086	50	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	8086	50	if (!spec->is_weak) {
1252			/* In-place update avoids newSVsv allocation (common case) */
1253	8086	50	if (idx <= AvFILLp(av)) {
1254	8086		SV *slot = AvARRAY(av)[idx];
1255	8086	50	if (slot) {
1256	8086		sv_setsv(slot, val);
1257	8086		SETs(val);
1258	8086		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	21		static OP* accessor_call_checker(pTHX_ OP entersubop, GV namegv, SV *ckobj) {
1276	21		IV idx = SvIV(ckobj);
1277			OP pushop, cvop, selfop, argop;
1278			OP *newop;
1279
1280			PERL_UNUSED_ARG(namegv);
1281
1282	21		pushop = cUNOPx(entersubop)->op_first;
1283	21	50	if (!OpHAS_SIBLING(pushop)) {
1284	21		pushop = cUNOPx(pushop)->op_first;
1285			}
1286
1287	21	50	selfop = OpSIBLING(pushop);
1288	21		cvop = selfop;
1289	21		argop = selfop;
1290	58	100	while (OpHAS_SIBLING(cvop)) {
1291	37		argop = cvop;
1292	37	50	cvop = OpSIBLING(cvop);
1293			}
1294
1295			/* Check if there's an argument after self (setter call) */
1296	21	100	if (argop != selfop) {
1297			/* Setter: $obj->name($value) */
1298	16	50	OP *valop = OpSIBLING(selfop);
1299
1300			/* Detach self and val */
1301	16		OpMORESIB_set(pushop, cvop);
1302	16		OpLASTSIB_set(valop, NULL);
1303	16		OpLASTSIB_set(selfop, NULL);
1304
1305			/* Create binop with self and val */
1306	16		newop = newBINOP(OP_CUSTOM, 0, selfop, valop);
1307	16		newop->op_ppaddr = pp_object_set;
1308	16		newop->op_targ = idx;
1309
1310	16		op_free(entersubop);
1311	16		return newop;
1312			} else {
1313			/* Getter: $obj->name */
1314	5		OpMORESIB_set(pushop, cvop);
1315	5		OpLASTSIB_set(selfop, NULL);
1316
1317	5		newop = newUNOP(OP_CUSTOM, 0, selfop);
1318	5		newop->op_ppaddr = pp_object_get;
1319	5		newop->op_targ = idx;
1320
1321	5		op_free(entersubop);
1322	5		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	12257		static XS(xs_accessor_fallback) {
1559	12257		dXSARGS;
1560	12257		IV idx = CvXSUBANY(cv).any_iv;
1561	12257		SV *self = ST(0);
1562			AV *av;
1563			SV *rv;
1564
1565	12257		rv = SvRV(self);
1566	12257	50	if (!SvROK(self) \|\| SvTYPE(rv) != SVt_PVAV) {
		50
1567	0		croak("Not an object");
1568			}
1569	12257		av = (AV*)rv;
1570
1571	12257	100	if (items > 1) {
1572			/* Setter */
1573	33	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	32	50	if (idx <= AvFILLp(av)) {
1581	32		SV *slot = AvARRAY(av)[idx];
1582	32	50	if (slot) {
1583	32		sv_setsv(slot, ST(1));
1584	32		ST(0) = ST(1);
1585	32		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	12224	50	if (idx <= AvFILLp(av)) {
1594	12224		SV *sv = AvARRAY(av)[idx];
1595	12224	50	if (sv && SvOK(sv)) {
		100
1596	12201		ST(0) = sv;
1597	12201		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	154		static OP* pp_object_func_get(pTHX) {
1637	154		dSP;
1638	154		SV obj = TOPs; / peek, don't pop */
1639	154		FuncAccessorData *data = get_func_accessor_data(PL_op->op_targ);
1640	154		IV idx = data->slot_idx;
1641			SV *rv;
1642			AV *av;
1643			SV *sv;
1644
1645	154	50	if (!SvROK(obj)) croak("Not an object");
1646	154		rv = SvRV(obj);
1647	154	50	if (SvTYPE(rv) != SVt_PVAV) croak("Not an object");
1648	154		av = (AV*)rv;
1649
1650			/* Validate object is of expected class (stash pointer comparison) */
1651	154	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	154	50	if (idx <= AvFILLp(av)) {
1659	154		sv = AvARRAY(av)[idx];
1660	154	50	if (sv) {
1661	154		SETs(sv);
1662	154		RETURN;
1663			}
1664			}
1665
1666	0		SETs(&PL_sv_undef);
1667	0		RETURN;
1668			}
1669
1670	26		static OP* pp_object_func_set(pTHX) {
1671	26		dSP;
1672	26		SV val = POPs; / Pop value first */
1673	26		SV obj = TOPs; / Object left on stack */
1674	26		FuncAccessorData *data = get_func_accessor_data(PL_op->op_targ);
1675	26		IV idx = data->slot_idx;
1676			SV *rv;
1677			AV *av;
1678
1679	26	50	if (!SvROK(obj)) croak("Not an object");
1680	26		rv = SvRV(obj);
1681	26	50	if (SvTYPE(rv) != SVt_PVAV) croak("Not an object");
1682	26		av = (AV*)rv;
1683
1684			/* Validate object is of expected class (stash pointer comparison) */
1685	26	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	26	50	if (idx <= AvFILLp(av)) {
1693	26		SV *slot = AvARRAY(av)[idx];
1694	26	50	if (slot) {
1695	26		sv_setsv(slot, val);
1696	26		SETs(val);
1697	26		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	267		OBJECT_INLINE bool is_simple_op(OP *op) {
1708	267	50	if (!op) return false;
1709			/* Simple ops: pad variables, constants, global variables */
1710	267	100	switch (op->op_type) {
1711	178		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	178		return true;
1721	89		default:
1722	89		return false;
1723			}
1724			}
1725
1726			/* Call checker for function-style accessor: name($obj) or name($obj, $val) */
1727	228		static OP* func_accessor_call_checker(pTHX_ OP entersubop, GV namegv, SV *ckobj) {
1728	228		IV registry_id = SvIV(ckobj);
1729	228		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	228	50	if (!data) {
1736	0		return entersubop; /* Fallback if data not found */
1737			}
1738
1739	228		pushop = cUNOPx(entersubop)->op_first;
1740	228	50	if (!OpHAS_SIBLING(pushop)) {
1741	228		pushop = cUNOPx(pushop)->op_first;
1742			}
1743
1744			/* Walk the op tree like the method-style accessor checker */
1745	228	50	objop = OpSIBLING(pushop);
1746	228		cvop = objop;
1747	228		argop = objop;
1748	504	100	while (OpHAS_SIBLING(cvop)) {
1749	276		argop = cvop;
1750	276	50	cvop = OpSIBLING(cvop);
1751			}
1752
1753			/* Check if there's an argument after obj (setter call) */
1754	228	100	if (argop != objop) {
1755			/* Setter: name($obj, $val) - optimize to custom binop */
1756	48	50	OP *valop = OpSIBLING(objop);
1757
1758			/* Only optimize if exactly 2 args and both are simple ops */
1759	96	50	if (valop && OpSIBLING(valop) == cvop &&
		50
1760	87	100	is_simple_op(objop) && is_simple_op(valop)) {
1761	26		OpMORESIB_set(pushop, cvop);
1762	26		OpLASTSIB_set(valop, NULL);
1763	26		OpLASTSIB_set(objop, NULL);
1764
1765	26		newop = newBINOP(OP_CUSTOM, 0, objop, valop);
1766	26		newop->op_ppaddr = pp_object_func_set;
1767	26		newop->op_targ = data->registry_id;
1768
1769	26		op_free(entersubop);
1770	26		return newop;
1771			}
1772
1773			/* Complex args - fall back to XS */
1774	22		return op_contextualize(entersubop, G_SCALAR);
1775			}
1776
1777			/* Getter: name($obj) - optimize only if objop is simple */
1778	180	100	if (!is_simple_op(objop)) {
1779	67		return entersubop;
1780			}
1781
1782	113		OpMORESIB_set(pushop, cvop);
1783	113		OpLASTSIB_set(objop, NULL);
1784
1785	113		newop = newUNOP(OP_CUSTOM, 0, objop);
1786	113		newop->op_ppaddr = pp_object_func_get;
1787	113		newop->op_targ = data->registry_id;
1788
1789	113		op_free(entersubop);
1790	113		return newop;
1791			}
1792
1793			/* XS fallback for function-style accessor */
1794	174		static XS(xs_func_accessor_fallback) {
1795	174		dXSARGS;
1796	174		FuncAccessorData data = INT2PTR(FuncAccessorData, CvXSUBANY(cv).any_iv);
1797	174		IV idx = data->slot_idx;
1798	174		SV *obj = ST(0);
1799			AV *av;
1800
1801	174	50	if (!SvROK(obj) \|\| SvTYPE(SvRV(obj)) != SVt_PVAV) {
		50
1802	0		croak("Not an object");
1803			}
1804	174		av = (AV*)SvRV(obj);
1805
1806			/* Validate object is of expected class */
1807	174	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	174	100	if (items > 1) {
1814			/* In-place update if slot already has an SV */
1815	41	50	if (idx <= AvFILLp(av)) {
1816	41		SV *slot = AvARRAY(av)[idx];
1817	41	50	if (slot) {
1818	41		sv_setsv(slot, ST(1));
1819	41		ST(0) = ST(1);
1820	41		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	133	50	if (idx <= AvFILLp(av)) {
1828	133		SV *sv = AvARRAY(av)[idx];
1829	133	50	ST(0) = (sv && SvOK(sv)) ? sv : &PL_sv_undef;
		50
1830			} else {
1831	0		ST(0) = &PL_sv_undef;
1832			}
1833			}
1834	133		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) {
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 - skip to avoid redefinition warning.
1848			* This also preserves any user-defined subs that were defined before import. */
1849	97		cv = get_cvn_flags(full_name, strlen(full_name), 0);
1850	97	100	if (cv) {
1851	42		return; /* Already exists, skip to avoid redefinition warning */
1852			}
1853
1854			/* Allocate data for this accessor and register it */
1855	55		Newx(data, 1, FuncAccessorData);
1856	55		data->slot_idx = idx;
1857	55		data->expected_class = expected_class; /* NULL for same-class, set for cross-class */
1858	55		registry_id = register_func_accessor_data(aTHX_ data);
1859
1860	55		cv = newXS(full_name, xs_func_accessor_fallback, __FILE__);
1861	55		CvXSUBANY(cv).any_iv = PTR2IV(data); /* XS fallback still uses pointer directly */
1862
1863	55		ckobj = newSViv(registry_id);
1864	55		cv_set_call_checker(cv, func_accessor_call_checker, ckobj);
1865			}
1866
1867			/* Object::Proto::import_accessors("Class", "targetpkg") - import fast accessors */
1868	27		static XS(xs_import_accessors) {
1869	27		dXSARGS;
1870			STRLEN class_len, pkg_len;
1871			const char class_pv, pkg_pv;
1872			ClassMeta *meta;
1873			IV i;
1874			int is_same_class;
1875
1876	27	50	if (items < 1) croak("Usage: Object::Proto::import_accessors($class [, $package])");
1877
1878	27		class_pv = SvPV(ST(0), class_len);
1879
1880	27	100	if (items > 1) {
1881	11		pkg_pv = SvPV(ST(1), pkg_len);
1882			} else {
1883			/* Default to caller's package */
1884	16	50	pkg_pv = CopSTASHPV(PL_curcop);
		50
		50
		50
		0
		50
		50
1885	16		pkg_len = strlen(pkg_pv);
1886			}
1887
1888	27		meta = get_class_meta(aTHX_ class_pv, class_len);
1889	27	50	if (!meta) {
1890	0		croak("Class '%s' not defined with Object::Proto::define", class_pv);
1891			}
1892
1893			/* Check if importing into same class (skip validation for performance) */
1894	27	100	is_same_class = (class_len == pkg_len && strEQ(class_pv, pkg_pv));
		100
1895
1896			/* Install function-style accessors for each property */
1897	109	100	for (i = 1; i < meta->slot_count; i++) {
1898	82	50	if (meta->idx_to_prop[i]) {
1899			/* Pass NULL for same-class (skip validation), meta for cross-class */
1900	82		install_func_accessor(aTHX_ pkg_pv, meta->idx_to_prop[i], i,
1901			NULL); /* No class check — work with any compatible object */
1902			}
1903			}
1904
1905	27		XSRETURN_EMPTY;
1906			}
1907
1908			/* Object::Proto::import_accessor("Class", "prop", "alias") - import single accessor with alias */
1909	15		static XS(xs_import_accessor) {
1910	15		dXSARGS;
1911			STRLEN class_len, prop_len, alias_len, pkg_len;
1912			const char class_pv, prop_pv, alias_pv, pkg_pv;
1913			ClassMeta *meta;
1914			SV **idx_svp;
1915			IV idx;
1916			int is_same_class;
1917
1918	15	50	if (items < 2) croak("Usage: Object::Proto::import_accessor($class, $prop [, $alias [, $package]])");
1919
1920	15		class_pv = SvPV(ST(0), class_len);
1921	15		prop_pv = SvPV(ST(1), prop_len);
1922
1923			/* Alias defaults to property name */
1924	15	50	if (items > 2 && SvOK(ST(2))) {
		50
1925	15		alias_pv = SvPV(ST(2), alias_len);
1926			} else {
1927	0		alias_pv = prop_pv;
1928			}
1929
1930			/* Package defaults to caller */
1931	15	100	if (items > 3) {
1932	3		pkg_pv = SvPV(ST(3), pkg_len);
1933			} else {
1934	12	50	pkg_pv = CopSTASHPV(PL_curcop);
		50
		50
		50
		0
		50
		50
1935	12		pkg_len = strlen(pkg_pv);
1936			}
1937
1938	15		meta = get_class_meta(aTHX_ class_pv, class_len);
1939	15	50	if (!meta) {
1940	0		croak("Class '%s' not defined with Object::Proto::define", class_pv);
1941			}
1942
1943			/* Look up property index */
1944	15		idx_svp = hv_fetch(meta->prop_to_idx, prop_pv, prop_len, 0);
1945	15	50	if (!idx_svp) {
1946	0		croak("Property '%s' not defined in class '%s'", prop_pv, class_pv);
1947			}
1948	15		idx = SvIV(*idx_svp);
1949
1950			/* Check if importing into same class (skip validation for performance) */
1951	15	50	is_same_class = (class_len == pkg_len && strEQ(class_pv, pkg_pv));
		0
1952
1953			/* Install with alias name — no class check, work with any compatible object */
1954	15		install_func_accessor(aTHX_ pkg_pv, alias_pv, idx,
1955			NULL);
1956
1957	15		XSRETURN_EMPTY;
1958			}
1959
1960			/* Object::Proto::import() - export 'object' to caller's namespace */
1961	57		static XS(xs_import) {
1962	57		dXSARGS;
1963			const char *caller_pkg;
1964			SV *full_name;
1965			CV define_cv, before_cv, after_cv, around_cv;
1966			GV *gv;
1967
1968			PERL_UNUSED_VAR(items);
1969
1970			/* Get caller's package */
1971	57	50	caller_pkg = CopSTASHPV(PL_curcop);
		50
		50
		50
		0
		50
		50
1972
1973			/* Get Object::Proto::define */
1974	57		define_cv = get_cv("Object::Proto::define", 0);
1975	57	50	if (!define_cv) croak("Object::Proto::define not found");
1976
1977			/* Create fully qualified name: caller::object */
1978	57		full_name = newSVpvf("%s::object", caller_pkg);
1979
1980			/* Export: create alias in caller's namespace */
1981	57		gv = gv_fetchsv(full_name, GV_ADD, SVt_PVCV);
1982	57	50	if (GvCV(gv) == NULL) {
1983	57		GvCV_set(gv, (CV)SvREFCNT_inc((SV)define_cv));
1984	57		GvIMPORTED_CV_on(gv);
1985			}
1986	57		GvMULTI_on(gv);
1987	57		SvREFCNT_dec(full_name);
1988
1989			/* Export before/after/around modifiers */
1990	57		before_cv = get_cv("Object::Proto::before", 0);
1991	57		after_cv = get_cv("Object::Proto::after", 0);
1992	57		around_cv = get_cv("Object::Proto::around", 0);
1993
1994	57	50	if (before_cv) {
1995	57		full_name = newSVpvf("%s::before", caller_pkg);
1996	57		gv = gv_fetchsv(full_name, GV_ADD, SVt_PVCV);
1997	57	50	if (GvCV(gv) == NULL) {
1998	57		GvCV_set(gv, (CV)SvREFCNT_inc((SV)before_cv));
1999	57		GvIMPORTED_CV_on(gv);
2000			}
2001	57		GvMULTI_on(gv);
2002	57		SvREFCNT_dec(full_name);
2003			}
2004
2005	57	50	if (after_cv) {
2006	57		full_name = newSVpvf("%s::after", caller_pkg);
2007	57		gv = gv_fetchsv(full_name, GV_ADD, SVt_PVCV);
2008	57	50	if (GvCV(gv) == NULL) {
2009	57		GvCV_set(gv, (CV)SvREFCNT_inc((SV)after_cv));
2010	57		GvIMPORTED_CV_on(gv);
2011			}
2012	57		GvMULTI_on(gv);
2013	57		SvREFCNT_dec(full_name);
2014			}
2015
2016	57	50	if (around_cv) {
2017	57		full_name = newSVpvf("%s::around", caller_pkg);
2018	57		gv = gv_fetchsv(full_name, GV_ADD, SVt_PVCV);
2019	57	50	if (GvCV(gv) == NULL) {
2020	57		GvCV_set(gv, (CV)SvREFCNT_inc((SV)around_cv));
2021	57		GvIMPORTED_CV_on(gv);
2022			}
2023	57		GvMULTI_on(gv);
2024	57		SvREFCNT_dec(full_name);
2025			}
2026
2027			/* Export role/requires/with */
2028			{
2029			static const char *names[] = { "role", "requires", "with" };
2030			int i;
2031	228	100	for (i = 0; i < 3; i++) {
2032	171		CV *cv = get_cvn_flags(
2033			Perl_form(aTHX_ "Object::Proto::%s", names[i]),
2034			strlen("Object::Proto::") + strlen(names[i]), 0);
2035	171	50	if (cv) {
2036	171		full_name = newSVpvf("%s::%s", caller_pkg, names[i]);
2037	171		gv = gv_fetchsv(full_name, GV_ADD, SVt_PVCV);
2038	171	50	if (GvCV(gv) == NULL) {
2039	171		GvCV_set(gv, (CV)SvREFCNT_inc((SV)cv));
2040	171		GvIMPORTED_CV_on(gv);
2041			}
2042	171		GvMULTI_on(gv);
2043	171		SvREFCNT_dec(full_name);
2044			}
2045			}
2046			}
2047
2048	57		XSRETURN_EMPTY;
2049			}
2050
2051			/* ============================================
2052			Install accessor into class
2053			============================================ */
2054
2055	154		static void install_accessor(pTHX_ const char class_name, const char prop_name, IV idx) {
2056			char full_name[256];
2057			CV *cv;
2058			SV *ckobj;
2059
2060	154		snprintf(full_name, sizeof(full_name), "%s::%s", class_name, prop_name);
2061
2062			/* Check if accessor already exists to avoid redefinition warnings */
2063	154		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2064	154	50	if (cv) {
2065	0		return; /* Already defined, skip */
2066			}
2067
2068	154		cv = newXS(full_name, xs_accessor_fallback, __FILE__);
2069	154		CvXSUBANY(cv).any_iv = idx;
2070
2071	154		ckobj = newSViv(idx);
2072	154		cv_set_call_checker(cv, accessor_call_checker, ckobj);
2073			}
2074
2075			/* XS fallback accessor with type checking */
2076	75691		static XS(xs_accessor_typed_fallback) {
2077	75691		dXSARGS;
2078	75691		SlotOpData data = INT2PTR(SlotOpData, CvXSUBANY(cv).any_iv);
2079	75691		IV idx = data->slot_idx;
2080	75691		ClassMeta *meta = data->meta;
2081	75691		SlotSpec *spec = meta->slots[idx];
2082	75691		SV *self = ST(0);
2083			AV *av;
2084
2085	75691	50	if (!SvROK(self) \|\| SvTYPE(SvRV(self)) != SVt_PVAV) {
		50
2086	0		croak("Not an object");
2087			}
2088	75691		av = (AV*)SvRV(self);
2089
2090	75691	100	if (items > 1) {
2091			/* Setter with type check */
2092	26098		SV *val = ST(1);
2093	26098		MAGIC *mg = get_object_magic(aTHX_ self);
2094	26098	100	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		50
2095	1		croak("Cannot modify frozen object");
2096			}
2097
2098	26097	100	if (spec->is_readonly) {
2099	7		croak("Cannot modify readonly slot '%s'", spec->name);
2100			}
2101
2102			/* Required fields cannot be set to undef */
2103	26090	100	if (spec->is_required && !SvOK(val)) {
		100
2104	2		croak("Cannot set required slot '%s' to undef", spec->name);
2105			}
2106
2107			/* Coercion */
2108	26088	50	if (spec->has_coerce \|\| spec->type_id == TYPE_CUSTOM)
		100
2109	6		val = apply_slot_coercion(aTHX_ val, spec);
2110
2111			/* Type check */
2112	26088	50	if (spec->has_type) {
2113	26088	100	if (!check_slot_type(aTHX_ val, spec)) {
2114	2	50	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
2115	2		? spec->registered->name
2116	21	100	: type_id_to_name(spec->type_id);
2117	19		croak("Type constraint failed for '%s': expected %s",
2118			spec->name, type_name);
2119			}
2120			}
2121
2122			/* Trigger callback ($self, $new_value) */
2123	26069	100	if (spec->has_trigger && spec->trigger_cb) {
		50
2124	3		dSP;
2125	3	50	PUSHMARK(SP);
2126	3	50	XPUSHs(self);
2127	3	50	XPUSHs(val);
2128	3		PUTBACK;
2129	3		call_method(SvPV_nolen(spec->trigger_cb), G_DISCARD);
2130			}
2131
2132			{
2133	26069		SV *stored = newSVsv(val);
2134	26069		av_store(av, idx, stored);
2135			/* Weaken reference if is_weak flag is set */
2136	26069	100	if (spec->is_weak && SvROK(stored)) {
		50
2137	1		sv_rvweaken(stored);
2138			}
2139			}
2140	26069		ST(0) = val;
2141	26069		XSRETURN(1);
2142			} else {
2143			/* Getter - use prototype chain resolution, handle lazy */
2144	49593		SV *result = resolve_property_chain(aTHX_ av, idx);
2145
2146			/* Lazy initialization: if undef and is_lazy, build/default on first access */
2147	49593	100	if (spec->is_lazy && !SvOK(result)) {
		100
2148	3822		SV *built_val = NULL;
2149
2150	7644	50	if (spec->has_builder && spec->builder_name) {
		50
2151			/* Call builder method */
2152	3822		dSP;
2153	3822		const char *builder = SvPV_nolen(spec->builder_name);
2154			int count;
2155
2156	3822		ENTER;
2157	3822		SAVETMPS;
2158	3822	50	PUSHMARK(SP);
2159	3822	50	XPUSHs(self);
2160	3822		PUTBACK;
2161
2162	3822		count = call_method(builder, G_SCALAR);
2163
2164	3822		SPAGAIN;
2165	3822	50	if (count > 0) {
2166			/* Copy the value BEFORE FREETMPS to avoid freed scalar issue */
2167	3822		built_val = newSVsv(POPs);
2168			} else {
2169	0		built_val = newSV(0); /* undef */
2170			}
2171	3822		PUTBACK;
2172	3822	50	FREETMPS;
2173	3822		LEAVE;
2174	0	0	} else if (spec->has_default && spec->default_sv) {
		0
2175			/* Use default value for lazy default */
2176	0	0	if (SvROK(spec->default_sv)) {
2177			/* Clone reference types (arrays, hashes) */
2178	0		SV *inner = SvRV(spec->default_sv);
2179	0	0	if (SvTYPE(inner) == SVt_PVAV) {
2180	0		built_val = newRV_noinc((SV*)newAV());
2181	0	0	} else if (SvTYPE(inner) == SVt_PVHV) {
2182	0		built_val = newRV_noinc((SV*)newHV());
2183			} else {
2184	0		built_val = newSVsv(spec->default_sv);
2185			}
2186			} else {
2187	0		built_val = newSVsv(spec->default_sv);
2188			}
2189			}
2190
2191	3822	50	if (built_val) {
2192			/* Type check the built value */
2193	3822	50	if (spec->has_type && SvOK(built_val)) {
		50
2194	3822	50	if (!check_slot_type(aTHX_ built_val, spec)) {
2195	0	0	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
2196	0		? spec->registered->name
2197	0	0	: type_id_to_name(spec->type_id);
2198	0		croak("Type constraint failed for lazy '%s': expected %s",
2199			spec->name, type_name);
2200			}
2201			}
2202
2203			/* Store the built value - built_val already has correct refcount from newSVsv */
2204	3822		av_store(av, idx, built_val);
2205	3822		result = built_val;
2206			}
2207			}
2208
2209	49593		ST(0) = result;
2210	49593		XSRETURN(1);
2211			}
2212			}
2213
2214			/* Call checker for typed accessor */
2215	37		static OP* accessor_typed_call_checker(pTHX_ OP entersubop, GV namegv, SV *ckobj) {
2216	37		SlotOpData data = INT2PTR(SlotOpData, SvIV(ckobj));
2217	37		IV idx = data->slot_idx;
2218			OP pushop, cvop, selfop, argop;
2219			OP *newop;
2220
2221			PERL_UNUSED_ARG(namegv);
2222
2223	37		pushop = cUNOPx(entersubop)->op_first;
2224	37	50	if (!OpHAS_SIBLING(pushop)) {
2225	37		pushop = cUNOPx(pushop)->op_first;
2226			}
2227
2228	37	50	selfop = OpSIBLING(pushop);
2229	37		cvop = selfop;
2230	37		argop = selfop;
2231	80	100	while (OpHAS_SIBLING(cvop)) {
2232	43		argop = cvop;
2233	43	50	cvop = OpSIBLING(cvop);
2234			}
2235
2236			/* Check if there's an argument after self (setter call) */
2237	37	100	if (argop != selfop) {
2238			/* Setter: $obj->name($value) - use typed setter */
2239	6	50	OP *valop = OpSIBLING(selfop);
2240
2241	6		OpMORESIB_set(pushop, cvop);
2242	6		OpLASTSIB_set(valop, NULL);
2243	6		OpLASTSIB_set(selfop, NULL);
2244
2245	6		newop = newBINOP(OP_CUSTOM, 0, selfop, valop);
2246	6		newop->op_ppaddr = pp_object_set_typed;
2247	6		newop->op_targ = PTR2IV(data);
2248
2249	6		op_free(entersubop);
2250	6		return newop;
2251			} else {
2252			/* Getter: $obj->name - plain getter (no type check needed) */
2253	31		OpMORESIB_set(pushop, cvop);
2254	31		OpLASTSIB_set(selfop, NULL);
2255
2256	31		newop = newUNOP(OP_CUSTOM, 0, selfop);
2257	31		newop->op_ppaddr = pp_object_get;
2258	31		newop->op_targ = idx;
2259
2260	31		op_free(entersubop);
2261	31		return newop;
2262			}
2263			}
2264
2265			/* XS fallback for reader-only accessor (get_X style) */
2266	13		static XS(xs_reader_fallback) {
2267	13		dXSARGS;
2268	13		SlotOpData data = INT2PTR(SlotOpData, CvXSUBANY(cv).any_iv);
2269	13		IV idx = data->slot_idx;
2270	13		ClassMeta *meta = data->meta;
2271	13		SlotSpec *spec = meta->slots[idx];
2272	13		SV *self = ST(0);
2273			AV *av;
2274
2275			PERL_UNUSED_ARG(items);
2276
2277	13	50	if (!SvROK(self) \|\| SvTYPE(SvRV(self)) != SVt_PVAV) {
		50
2278	0		croak("Not an object");
2279			}
2280	13		av = (AV*)SvRV(self);
2281
2282			/* Handle lazy builder */
2283	13	50	if (spec && spec->is_lazy && spec->has_builder && spec->builder_name) {
		100
		50
		50
2284	1	50	if (idx <= AvFILLp(av)) {
2285	1		SV *slot = AvARRAY(av)[idx];
2286	1	50	if (!slot \|\| !SvOK(slot)) {
		50
2287			/* Call builder method */
2288	1		dSP;
2289			IV count;
2290	1		ENTER;
2291	1		SAVETMPS;
2292	1	50	PUSHMARK(SP);
2293	1	50	XPUSHs(self);
2294	1		PUTBACK;
2295	1		count = call_method(SvPV_nolen(spec->builder_name), G_SCALAR);
2296	1		SPAGAIN;
2297	1	50	if (count > 0) {
2298	1		SV *built_val = POPs;
2299
2300			/* Type check the built value */
2301	1	50	if (spec->has_type) {
2302	1	50	if (spec->has_coerce \|\| spec->type_id == TYPE_CUSTOM)
		50
2303	0		built_val = apply_slot_coercion(aTHX_ built_val, spec);
2304	1	50	if (!check_slot_type(aTHX_ built_val, spec)) {
2305	0	0	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
2306	0		? spec->registered->name
2307	0	0	: type_id_to_name(spec->type_id);
2308	0		croak("Type constraint failed for '%s' in builder: expected %s",
2309			spec->name, type_name);
2310			}
2311			}
2312
2313	1		sv_setsv(AvARRAY(av)[idx], built_val);
2314			}
2315	1		PUTBACK;
2316	1	50	FREETMPS;
2317	1		LEAVE;
2318			}
2319			}
2320			}
2321
2322			/* Getter - fast path: direct slot access */
2323	13	50	if (idx <= AvFILLp(av)) {
2324	13		SV *sv = AvARRAY(av)[idx];
2325	13	50	if (sv && SvOK(sv)) {
		50
2326	13		ST(0) = sv;
2327	13		XSRETURN(1);
2328			}
2329			}
2330			/* Slow path: check prototype chain */
2331			{
2332	0		SV **proto = av_fetch(av, 0, 0);
2333	0	0	if (proto && SvROK(proto) && SvTYPE(SvRV(proto)) == SVt_PVAV) {
		0
		0
2334	0		SV *result = resolve_property_chain(aTHX_ av, idx);
2335	0		ST(0) = result;
2336	0		XSRETURN(1);
2337			}
2338			}
2339	0		ST(0) = &PL_sv_undef;
2340	0		XSRETURN(1);
2341			}
2342
2343			/* XS fallback for writer-only accessor (set_X style) */
2344	14		static XS(xs_writer_fallback) {
2345	14		dXSARGS;
2346	14		SlotOpData data = INT2PTR(SlotOpData, CvXSUBANY(cv).any_iv);
2347	14		IV idx = data->slot_idx;
2348	14		ClassMeta *meta = data->meta;
2349	14		SlotSpec *spec = meta->slots[idx];
2350	14		SV *self = ST(0);
2351			AV *av;
2352			MAGIC *mg;
2353
2354	14	50	if (!SvROK(self) \|\| SvTYPE(SvRV(self)) != SVt_PVAV) {
		50
2355	0		croak("Not an object");
2356			}
2357	14		av = (AV*)SvRV(self);
2358
2359	14	100	if (items < 2) {
2360	1		croak("Writer method requires a value argument");
2361			}
2362
2363			/* Check frozen */
2364	13		mg = get_object_magic(aTHX_ self);
2365	13	100	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		50
2366	1		croak("Cannot modify frozen object");
2367			}
2368
2369			/* Check readonly */
2370	12	50	if (spec && spec->is_readonly) {
		100
2371	1		croak("Cannot modify readonly slot '%s'", spec->name);
2372			}
2373
2374			{
2375	11		SV *val = ST(1);
2376
2377			/* Required fields cannot be set to undef */
2378	11	50	if (spec && spec->is_required && !SvOK(val)) {
		100
		50
2379	1		croak("Cannot set required slot '%s' to undef", spec->name);
2380			}
2381
2382			/* Coerce + type check */
2383	10	50	if (spec && spec->has_type) {
		50
2384	10	50	if (spec->has_coerce \|\| spec->type_id == TYPE_CUSTOM)
		50
2385	0		val = apply_slot_coercion(aTHX_ val, spec);
2386	10	100	if (!check_slot_type(aTHX_ val, spec)) {
2387	0	0	const char *type_name = (spec->type_id == TYPE_CUSTOM && spec->registered)
2388	0		? spec->registered->name
2389	1	50	: type_id_to_name(spec->type_id);
2390	1		croak("Type constraint failed for '%s': expected %s",
2391			spec->name, type_name);
2392			}
2393			}
2394
2395			/* Trigger callback ($self, $new_value) */
2396	9	50	if (spec && spec->has_trigger && spec->trigger_cb) {
		100
		50
2397	1		dSP;
2398	1	50	PUSHMARK(SP);
2399	1	50	XPUSHs(self);
2400	1	50	XPUSHs(val);
2401	1		PUTBACK;
2402	1		call_method(SvPV_nolen(spec->trigger_cb), G_DISCARD);
2403			}
2404
2405			/* In-place update */
2406	9	50	if (idx <= AvFILLp(av)) {
2407	9		SV *slot = AvARRAY(av)[idx];
2408	9	50	if (slot) {
2409	9		sv_setsv(slot, val);
2410			/* Weaken reference if is_weak flag is set */
2411	9	50	if (spec && spec->is_weak && SvROK(slot)) {
		100
		50
2412	1		sv_rvweaken(slot);
2413			}
2414	9		ST(0) = val;
2415	9		XSRETURN(1);
2416			}
2417			}
2418			{
2419	0		SV *stored = newSVsv(val);
2420	0		av_store(av, idx, stored);
2421			/* Weaken reference if is_weak flag is set */
2422	0	0	if (spec && spec->is_weak && SvROK(stored)) {
		0
		0
2423	0		sv_rvweaken(stored);
2424			}
2425			}
2426	0		ST(0) = val;
2427	0		XSRETURN(1);
2428			}
2429			}
2430
2431			/* Install reader-only accessor (get_X style) */
2432	11		static void install_reader(pTHX_ const char class_name, const char method_name, IV idx, ClassMeta *meta) {
2433			char full_name[256];
2434			CV *cv;
2435			SlotOpData *data;
2436
2437	11		snprintf(full_name, sizeof(full_name), "%s::%s", class_name, method_name);
2438
2439			/* Check if method already exists */
2440	11		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2441	11	50	if (cv) {
2442	0		return;
2443			}
2444
2445	11		Newx(data, 1, SlotOpData);
2446	11		data->slot_idx = idx;
2447	11		data->meta = meta;
2448
2449	11		cv = newXS(full_name, xs_reader_fallback, __FILE__);
2450	11		CvXSUBANY(cv).any_iv = PTR2IV(data);
2451			}
2452
2453			/* Install writer-only accessor (set_X style) */
2454	12		static void install_writer(pTHX_ const char class_name, const char method_name, IV idx, ClassMeta *meta) {
2455			char full_name[256];
2456			CV *cv;
2457			SlotOpData *data;
2458
2459	12		snprintf(full_name, sizeof(full_name), "%s::%s", class_name, method_name);
2460
2461			/* Check if method already exists */
2462	12		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2463	12	50	if (cv) {
2464	0		return;
2465			}
2466
2467	12		Newx(data, 1, SlotOpData);
2468	12		data->slot_idx = idx;
2469	12		data->meta = meta;
2470
2471	12		cv = newXS(full_name, xs_writer_fallback, __FILE__);
2472	12		CvXSUBANY(cv).any_iv = PTR2IV(data);
2473			}
2474
2475			/* Install typed accessor (with type check, triggers, etc.) */
2476	396		static void install_accessor_typed(pTHX_ const char class_name, const char prop_name, IV idx, ClassMeta *meta) {
2477			char full_name[256];
2478			CV *cv;
2479			SV *ckobj;
2480			SlotOpData *data;
2481
2482	396		snprintf(full_name, sizeof(full_name), "%s::%s", class_name, prop_name);
2483
2484			/* Check if accessor already exists */
2485	396		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2486	396	100	if (cv) {
2487			/* Update existing accessor's data (for +attr overrides) */
2488	13		data = INT2PTR(SlotOpData*, CvXSUBANY(cv).any_iv);
2489	13	50	if (data) {
2490	13		data->slot_idx = idx;
2491	13		data->meta = meta;
2492			}
2493	13		return;
2494			}
2495
2496			/* Allocate persistent data for this slot */
2497	383		Newx(data, 1, SlotOpData);
2498	383		data->slot_idx = idx;
2499	383		data->meta = meta;
2500
2501	383		cv = newXS(full_name, xs_accessor_typed_fallback, __FILE__);
2502	383		CvXSUBANY(cv).any_iv = PTR2IV(data);
2503
2504	383		ckobj = newSViv(PTR2IV(data));
2505	383		cv_set_call_checker(cv, accessor_typed_call_checker, ckobj);
2506			}
2507
2508			/* XS fallback for clearer method (clear_X) */
2509	9820		static XS(xs_clearer_fallback) {
2510	9820		dXSARGS;
2511	9820		SlotOpData data = INT2PTR(SlotOpData, CvXSUBANY(cv).any_iv);
2512	9820		IV idx = data->slot_idx;
2513	9820		SV *self = ST(0);
2514			AV *av;
2515			MAGIC *mg;
2516
2517			PERL_UNUSED_ARG(items);
2518
2519	9820	50	if (!SvROK(self) \|\| SvTYPE(SvRV(self)) != SVt_PVAV) {
		50
2520	0		croak("Not an object");
2521			}
2522	9820		av = (AV*)SvRV(self);
2523
2524			/* Check frozen */
2525	9820		mg = get_object_magic(aTHX_ self);
2526	9820	100	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		50
2527	1		croak("Cannot modify frozen object");
2528			}
2529
2530			/* Clear the slot by setting to undef */
2531	9819		av_store(av, idx, newSV(0));
2532
2533	9819		ST(0) = self; /* Return self for chaining */
2534	9819		XSRETURN(1);
2535			}
2536
2537			/* Install clearer method (clear_X or custom name) */
2538	16		static void install_clearer(pTHX_ const char class_name, const char prop_name, IV idx, ClassMeta meta, SV custom_name) {
2539			char full_name[256];
2540			CV *cv;
2541			SlotOpData *data;
2542
2543	16	100	if (custom_name && SvOK(custom_name)) {
		50
2544	3		snprintf(full_name, sizeof(full_name), "%s::%s", class_name, SvPV_nolen(custom_name));
2545			} else {
2546	13		snprintf(full_name, sizeof(full_name), "%s::clear_%s", class_name, prop_name);
2547			}
2548
2549			/* Check if method already exists */
2550	16		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2551	16	100	if (cv) {
2552	1		return;
2553			}
2554
2555	15		Newx(data, 1, SlotOpData);
2556	15		data->slot_idx = idx;
2557	15		data->meta = meta;
2558
2559	15		cv = newXS(full_name, xs_clearer_fallback, __FILE__);
2560	15		CvXSUBANY(cv).any_iv = PTR2IV(data);
2561			}
2562
2563			/* XS fallback for predicate method (has_X) */
2564	10232		static XS(xs_predicate_fallback) {
2565	10232		dXSARGS;
2566	10232		SlotOpData data = INT2PTR(SlotOpData, CvXSUBANY(cv).any_iv);
2567	10232		IV idx = data->slot_idx;
2568	10232		SV *self = ST(0);
2569			AV *av;
2570			SV **svp;
2571
2572			PERL_UNUSED_ARG(items);
2573
2574	10232	50	if (!SvROK(self) \|\| SvTYPE(SvRV(self)) != SVt_PVAV) {
		50
2575	0		croak("Not an object");
2576			}
2577	10232		av = (AV*)SvRV(self);
2578
2579			/* Check if slot has a defined value */
2580	10232		svp = av_fetch(av, idx, 0);
2581	10232	50	if (svp && SvOK(*svp)) {
		100
2582	6220		ST(0) = &PL_sv_yes;
2583			} else {
2584	4012		ST(0) = &PL_sv_no;
2585			}
2586	10232		XSRETURN(1);
2587			}
2588
2589			/* Install predicate method (has_X or custom name) */
2590	15		static void install_predicate(pTHX_ const char class_name, const char prop_name, IV idx, ClassMeta meta, SV custom_name) {
2591			char full_name[256];
2592			CV *cv;
2593			SlotOpData *data;
2594
2595	15	100	if (custom_name && SvOK(custom_name)) {
		50
2596	3		snprintf(full_name, sizeof(full_name), "%s::%s", class_name, SvPV_nolen(custom_name));
2597			} else {
2598	12		snprintf(full_name, sizeof(full_name), "%s::has_%s", class_name, prop_name);
2599			}
2600
2601			/* Check if method already exists */
2602	15		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2603	15	100	if (cv) {
2604	1		return;
2605			}
2606
2607	14		Newx(data, 1, SlotOpData);
2608	14		data->slot_idx = idx;
2609	14		data->meta = meta;
2610
2611	14		cv = newXS(full_name, xs_predicate_fallback, __FILE__);
2612	14		CvXSUBANY(cv).any_iv = PTR2IV(data);
2613			}
2614
2615			/* ============================================
2616			DEMOLISH Support (zero overhead if not used)
2617			============================================ */
2618
2619			/* XS DESTROY wrapper that calls DEMOLISH */
2620	4		static XS(xs_destroy_wrapper) {
2621	4		dXSARGS;
2622	4		ClassMeta meta = INT2PTR(ClassMeta, CvXSUBANY(cv).any_iv);
2623	4		SV *self = ST(0);
2624
2625			PERL_UNUSED_VAR(items);
2626
2627	4	50	if (meta && meta->demolish_cv) {
		50
2628	4		dSP;
2629	4		ENTER;
2630	4		SAVETMPS;
2631	4	50	PUSHMARK(SP);
2632	4	50	XPUSHs(self);
2633	4		PUTBACK;
2634	4		call_sv((SV*)meta->demolish_cv, G_DISCARD \| G_EVAL);
2635	4		SPAGAIN;
2636			/* Ignore errors in DEMOLISH - don't die during destruction */
2637	4	50	if (SvTRUE(ERRSV)) {
		50
2638	0	0	warn("Error in DEMOLISH: %s", SvPV_nolen(ERRSV));
2639			}
2640	4	50	FREETMPS;
2641	4		LEAVE;
2642			}
2643
2644	4		XSRETURN_EMPTY;
2645			}
2646
2647			/* Install DESTROY wrapper - only called if DEMOLISH exists */
2648	2		static void install_destroy_wrapper(pTHX_ const char class_name, ClassMeta meta) {
2649			char full_name[256];
2650			CV *cv;
2651
2652	2		snprintf(full_name, sizeof(full_name), "%s::DESTROY", class_name);
2653
2654			/* Check if DESTROY already exists - don't override user's DESTROY */
2655	2		cv = get_cvn_flags(full_name, strlen(full_name), 0);
2656	2	50	if (cv) {
2657	0		return; /* User has their own DESTROY, don't interfere */
2658			}
2659
2660	2		cv = newXS(full_name, xs_destroy_wrapper, __FILE__);
2661	2		CvXSUBANY(cv).any_iv = PTR2IV(meta);
2662			}
2663
2664			/* ============================================
2665			Role Support (zero overhead if not used)
2666			============================================ */
2667
2668	20		static RoleMeta* get_role_meta(pTHX_ const char *role_name, STRLEN len) {
2669			SV **svp;
2670	20	100	if (!g_role_registry) return NULL;
2671	18		svp = hv_fetch(g_role_registry, role_name, len, 0);
2672	18	100	if (svp && SvIOK(*svp)) {
		50
2673	13		return INT2PTR(RoleMeta, SvIV(svp));
2674			}
2675	5		return NULL;
2676			}
2677
2678	7		static void register_role_meta(pTHX_ const char role_name, STRLEN len, RoleMeta meta) {
2679	7	100	if (!g_role_registry) {
2680	2		g_role_registry = newHV();
2681			}
2682	7		hv_store(g_role_registry, role_name, len, newSViv(PTR2IV(meta)), 0);
2683	7		}
2684
2685			/* Copy a method from role stash to class stash */
2686	4		static void copy_method(pTHX_ HV from_stash, HV to_stash, const char *method_name) {
2687			GV *from_gv;
2688			CV *cv;
2689			char full_name[512];
2690			GV *to_gv;
2691
2692	4		from_gv = gv_fetchmeth(from_stash, method_name, strlen(method_name), 0);
2693	4	50	if (!from_gv \|\| !(cv = GvCV(from_gv))) {
		50
2694	0		return; /* No such method in role */
2695			}
2696
2697			/* Check if target already has this method */
2698	4		to_gv = gv_fetchmeth(to_stash, method_name, strlen(method_name), 0);
2699	4	50	if (to_gv && GvCV(to_gv)) {
		0
2700	0		return; /* Target already has method, don't override */
2701			}
2702
2703			/* Install the CV in target stash */
2704	4	50	snprintf(full_name, sizeof(full_name), "%s::%s", HvNAME(to_stash), method_name);
		50
		50
		0
		50
		50
2705	4		to_gv = gv_fetchpv(full_name, GV_ADD, SVt_PVCV);
2706	4	50	if (to_gv) {
2707			/* Share the CV between role and class */
2708	4		GvCV_set(to_gv, (CV)SvREFCNT_inc((SV)cv));
2709	4		GvCVGEN(to_gv) = 0; /* Clear cache */
2710			}
2711			}
2712
2713			/* Apply a role to a class */
2714	11		static void apply_role_to_class(pTHX_ ClassMeta class_meta, RoleMeta role_meta) {
2715			IV i;
2716			HE *entry;
2717
2718			/* Check required methods */
2719	14	100	for (i = 0; i < role_meta->required_count; i++) {
2720	5		const char *required = role_meta->required_methods[i];
2721	5		GV *gv = gv_fetchmeth(class_meta->stash, required, strlen(required), 0);
2722	5	100	if (!gv \|\| !GvCV(gv)) {
		50
2723	2		croak("Class '%s' does not implement required method '%s' from role '%s'",
2724			class_meta->class_name, required, role_meta->role_name);
2725			}
2726			}
2727
2728			/* Copy role's slots to class */
2729	18	100	for (i = 0; i < role_meta->slot_count; i++) {
2730	10		SlotSpec *role_slot = role_meta->slots[i];
2731			IV new_idx;
2732			SV **existing;
2733
2734			/* Check for slot name conflict */
2735	10		existing = hv_fetch(class_meta->prop_to_idx, role_slot->name, strlen(role_slot->name), 0);
2736	10	100	if (existing) {
2737	1		croak("Slot conflict: '%s' already exists in class '%s' (from role '%s')",
2738			role_slot->name, class_meta->class_name, role_meta->role_name);
2739			}
2740
2741			/* Add slot to class */
2742	9		new_idx = class_meta->slot_count++;
2743	9	50	Renew(class_meta->slots, class_meta->slot_count, SlotSpec*);
2744	9	50	Renew(class_meta->idx_to_prop, class_meta->slot_count, char*);
2745
2746			/* Copy slot spec */
2747	9		class_meta->slots[new_idx] = role_slot; /* Share the spec */
2748	9		class_meta->idx_to_prop[new_idx] = role_slot->name;
2749	9		hv_store(class_meta->prop_to_idx, role_slot->name, strlen(role_slot->name),
2750			newSViv(new_idx), 0);
2751
2752			/* Add to arg_to_idx using init_arg if specified, otherwise property name */
2753	9	50	if (role_slot->init_arg) {
2754			STRLEN arg_len;
2755	0		const char *arg_name = SvPV(role_slot->init_arg, arg_len);
2756	0		hv_store(class_meta->arg_to_idx, arg_name, arg_len, newSViv(new_idx), 0);
2757			} else {
2758	9		hv_store(class_meta->arg_to_idx, role_slot->name, strlen(role_slot->name),
2759			newSViv(new_idx), 0);
2760			}
2761
2762			/* Track class-level fast-path flags for role slots */
2763	9	50	if (role_slot->has_type) {
2764	9		class_meta->has_any_types = 1;
2765			}
2766	9	100	if (role_slot->has_default) {
2767	4		class_meta->has_any_defaults = 1;
2768			}
2769	9	50	if (role_slot->has_trigger) {
2770	0		class_meta->has_any_triggers = 1;
2771			}
2772	9	50	if (role_slot->is_required) {
2773	0		class_meta->has_any_required = 1;
2774			}
2775	9	50	if (role_slot->is_lazy) {
2776	0		class_meta->has_any_lazy = 1;
2777			}
2778	9	100	if (role_slot->has_builder) {
2779	1		class_meta->has_any_builders = 1;
2780			}
2781	9	50	if (role_slot->is_weak) {
2782	0		class_meta->has_any_weak = 1;
2783			}
2784
2785			/* Install accessor for this slot */
2786	9	50	if (role_slot->has_type \|\| role_slot->has_trigger \|\| role_slot->has_coerce \|\|
		0
		0
2787	0	0	role_slot->is_readonly \|\| role_slot->is_lazy \|\| role_slot->is_required \|\| role_slot->is_weak) {
		0
		0
		0
2788	9		install_accessor_typed(aTHX_ class_meta->class_name, role_slot->name, new_idx, class_meta);
2789			} else {
2790	0		install_accessor(aTHX_ class_meta->class_name, role_slot->name, new_idx);
2791			}
2792
2793	9	50	if (role_slot->has_clearer) {
2794	0		install_clearer(aTHX_ class_meta->class_name, role_slot->name, new_idx, class_meta, role_slot->clearer_name);
2795			}
2796	9	50	if (role_slot->has_predicate) {
2797	0		install_predicate(aTHX_ class_meta->class_name, role_slot->name, new_idx, class_meta, role_slot->predicate_name);
2798			}
2799	9	50	if (role_slot->reader_name) {
2800	0		install_reader(aTHX_ class_meta->class_name, SvPV_nolen(role_slot->reader_name), new_idx, class_meta);
2801			}
2802	9	50	if (role_slot->writer_name) {
2803	0		install_writer(aTHX_ class_meta->class_name, SvPV_nolen(role_slot->writer_name), new_idx, class_meta);
2804			}
2805			}
2806
2807			/* Copy role's methods to class */
2808	8	50	if (role_meta->stash) {
2809	8		hv_iterinit(role_meta->stash);
2810	12	100	while ((entry = hv_iternext(role_meta->stash))) {
2811	4	50	const char *name = HePV(entry, PL_na);
2812			/* Skip special entries and slots (already handled) */
2813	4	50	if (name[0] != '_' \|\| strncmp(name, "_build_", 7) == 0) {
		0
2814	4		copy_method(aTHX_ role_meta->stash, class_meta->stash, name);
2815			}
2816			}
2817			}
2818
2819			/* Track consumed role */
2820	8	50	Renew(class_meta->consumed_roles, class_meta->role_count + 1, RoleMeta*);
2821	8		class_meta->consumed_roles[class_meta->role_count++] = role_meta;
2822	8		}
2823
2824			/* ============================================
2825			Method Modifiers (zero overhead if not used)
2826			============================================ */
2827
2828			/* Get or create modified method entry */
2829	10		static ModifiedMethod* get_or_create_modified_method(pTHX_ ClassMeta meta, const char method_name) {
2830			SV **svp;
2831			ModifiedMethod *mod;
2832	10		STRLEN name_len = strlen(method_name);
2833
2834	10	100	if (!meta->modified_methods) {
2835	4		meta->modified_methods = newHV();
2836			}
2837
2838	10		svp = hv_fetch(meta->modified_methods, method_name, name_len, 0);
2839	10	100	if (svp && SvIOK(*svp)) {
		50
2840	6		return INT2PTR(ModifiedMethod, SvIV(svp));
2841			}
2842
2843			/* Create new modified method entry */
2844	4		Newxz(mod, 1, ModifiedMethod);
2845
2846			/* Get the original CV */
2847			{
2848	4		GV *gv = gv_fetchmeth(meta->stash, method_name, name_len, 0);
2849	4	50	if (gv && GvCV(gv)) {
		50
2850	4		mod->original_cv = GvCV(gv);
2851	4		SvREFCNT_inc((SV*)mod->original_cv);
2852			}
2853			}
2854
2855	4		hv_store(meta->modified_methods, method_name, name_len, newSViv(PTR2IV(mod)), 0);
2856	4		return mod;
2857			}
2858
2859			/* XS wrapper for modified methods */
2860	7		static XS(xs_modified_method_wrapper) {
2861	7		dXSARGS;
2862	7		ModifiedMethod mod = INT2PTR(ModifiedMethod, CvXSUBANY(cv).any_iv);
2863			MethodModifier *m;
2864	7		int count = 0;
2865	7		I32 gimme = GIMME_V;
2866			AV *saved_args;
2867			AV *saved_results;
2868			int i;
2869
2870			/* Save original arguments for before/after chains */
2871	7		saved_args = newAV();
2872	7		sv_2mortal((SV*)saved_args);
2873	17	100	for (i = 0; i < items; i++) {
2874	10		av_push(saved_args, SvREFCNT_inc(ST(i)));
2875			}
2876
2877			/* Call before chain (in stack order - most recent first) */
2878	15	100	for (m = mod->before_chain; m; m = m->next) {
2879	8		dSP;
2880	8		ENTER;
2881	8		SAVETMPS;
2882	8	50	PUSHMARK(SP);
2883	20	100	for (i = 0; i <= av_len(saved_args); i++) {
2884	12		SV **svp = av_fetch(saved_args, i, 0);
2885	12	50	XPUSHs(svp ? *svp : &PL_sv_undef);
		50
2886			}
2887	8		PUTBACK;
2888	8		call_sv(m->callback, G_DISCARD);
2889	8	50	FREETMPS;
2890	8		LEAVE;
2891			}
2892
2893			/* Save results from original/around call */
2894	7		saved_results = newAV();
2895	7		sv_2mortal((SV*)saved_results);
2896
2897			/* Call around chain (or original if no around) */
2898	7	100	if (mod->around_chain) {
2899			/* For around, we pass ($orig, $self, @args) */
2900	2		m = mod->around_chain;
2901			{
2902	2		dSP;
2903	2		ENTER;
2904	2		SAVETMPS;
2905	2	50	PUSHMARK(SP);
2906	2	50	XPUSHs(sv_2mortal(newRV_inc((SV*)mod->original_cv)));
2907	5	100	for (i = 0; i <= av_len(saved_args); i++) {
2908	3		SV **svp = av_fetch(saved_args, i, 0);
2909	3	50	XPUSHs(svp ? *svp : &PL_sv_undef);
		50
2910			}
2911	2		PUTBACK;
2912	2	50	count = call_sv(m->callback, gimme == G_ARRAY ? G_LIST : G_SCALAR);
2913	2		SPAGAIN;
2914			/* Save results before LEAVE destroys them - they're on stack in reverse */
2915	4	100	for (i = 0; i < count; i++) {
2916	2		av_push(saved_results, newSVsv(POPs));
2917			}
2918	2	50	FREETMPS;
2919	2		LEAVE;
2920			}
2921	5	50	} else if (mod->original_cv) {
2922			/* Call original method */
2923	5		dSP;
2924	5		ENTER;
2925	5		SAVETMPS;
2926	5	50	PUSHMARK(SP);
2927	12	100	for (i = 0; i <= av_len(saved_args); i++) {
2928	7		SV **svp = av_fetch(saved_args, i, 0);
2929	7	50	XPUSHs(svp ? *svp : &PL_sv_undef);
		50
2930			}
2931	5		PUTBACK;
2932	5	50	count = call_sv((SV*)mod->original_cv, gimme == G_ARRAY ? G_LIST : G_SCALAR);
2933	5		SPAGAIN;
2934			/* Save results before LEAVE destroys them */
2935	10	100	for (i = 0; i < count; i++) {
2936	5		av_push(saved_results, newSVsv(POPs));
2937			}
2938	5	50	FREETMPS;
2939	5		LEAVE;
2940			}
2941
2942			/* Call after chain (in order of registration) */
2943	12	100	for (m = mod->after_chain; m; m = m->next) {
2944	5		dSP;
2945	5		ENTER;
2946	5		SAVETMPS;
2947	5	50	PUSHMARK(SP);
2948	12	100	for (i = 0; i <= av_len(saved_args); i++) {
2949	7		SV **svp = av_fetch(saved_args, i, 0);
2950	7	50	XPUSHs(svp ? *svp : &PL_sv_undef);
		50
2951			}
2952	5		PUTBACK;
2953	5		call_sv(m->callback, G_DISCARD);
2954	5	50	FREETMPS;
2955	5		LEAVE;
2956			}
2957
2958			/* Put saved results back on stack (they were saved in reverse order) */
2959			{
2960	7		count = av_len(saved_results) + 1;
2961	14	100	for (i = count - 1; i >= 0; i--) {
2962	7		SV **svp = av_fetch(saved_results, i, 0);
2963			/* Use sv_mortalcopy to put a mortal copy on stack */
2964	7	50	ST(count - 1 - i) = sv_mortalcopy(svp ? *svp : &PL_sv_undef);
2965			}
2966			}
2967
2968	7		XSRETURN(count);
2969			}
2970
2971			/* Install the wrapper if not already done */
2972	10		static void install_modifier_wrapper(pTHX_ ClassMeta meta, const char method_name, ModifiedMethod *mod) {
2973			char full_name[256];
2974			CV *existing_cv;
2975
2976	10		snprintf(full_name, sizeof(full_name), "%s::%s", meta->class_name, method_name);
2977
2978	10		existing_cv = get_cvn_flags(full_name, strlen(full_name), 0);
2979
2980			/* Only install wrapper once - check if it's already our wrapper */
2981	10	50	if (existing_cv && CvXSUB(existing_cv) == xs_modified_method_wrapper) {
		100
2982	6		return; /* Already wrapped */
2983			}
2984
2985			/* Install wrapper without "Subroutine redefined" warning */
2986			{
2987	4		GV *gv = gv_fetchpv(full_name, GV_ADD, SVt_PVCV);
2988	4		CV *cv = newXS_flags(NULL, xs_modified_method_wrapper, __FILE__, NULL, 0);
2989	4		CvXSUBANY(cv).any_iv = PTR2IV(mod);
2990			/* Silently replace the CV in the GV */
2991	4	50	if (GvCV(gv)) {
2992	4		SvREFCNT_dec(GvCV(gv));
2993			}
2994	4		GvCV_set(gv, cv);
2995			}
2996			}
2997
2998			/* Add a modifier to a method */
2999	10		static void add_modifier(pTHX_ ClassMeta meta, const char method_name, SV *callback, int type) {
3000			ModifiedMethod *mod;
3001			MethodModifier *new_mod;
3002
3003	10		mod = get_or_create_modified_method(aTHX_ meta, method_name);
3004
3005	10		Newx(new_mod, 1, MethodModifier);
3006	10		new_mod->callback = newSVsv(callback);
3007	10		new_mod->next = NULL;
3008
3009			/* Add to appropriate chain */
3010	10		switch (type) {
3011	4		case 0: /* before */
3012	4		new_mod->next = mod->before_chain;
3013	4		mod->before_chain = new_mod;
3014	4		break;
3015	4		case 1: /* after */
3016			/* Add to end of after chain */
3017	4	100	if (!mod->after_chain) {
3018	3		mod->after_chain = new_mod;
3019			} else {
3020	1		MethodModifier *last = mod->after_chain;
3021	1	50	while (last->next) last = last->next;
3022	1		last->next = new_mod;
3023			}
3024	4		break;
3025	2		case 2: /* around */
3026			/* around wraps previous around/original */
3027	2		new_mod->next = mod->around_chain;
3028	2		mod->around_chain = new_mod;
3029	2		break;
3030			}
3031
3032	10		install_modifier_wrapper(aTHX_ meta, method_name, mod);
3033	10		}
3034
3035			/* ============================================
3036			XS API Functions
3037			============================================ */
3038
3039	251		static XS(xs_define) {
3040	251		dXSARGS;
3041			STRLEN class_len;
3042			const char *class_pv;
3043			ClassMeta *meta;
3044			IV i;
3045	251		IV first_prop = 1; /* index of first property arg (after class name) */
3046
3047			/* Multiple inheritance support */
3048	251		ClassMeta **parent_metas = NULL;
3049	251		IV parent_count = 0;
3050	251		IV parent_alloc = 0;
3051
3052	251	50	if (items < 1) croak("Usage: Object::Proto::define($class, @properties)");
3053
3054	251		class_pv = SvPV(ST(0), class_len);
3055
3056			/* Check for extends => 'ParentClass' or extends => ['P1','P2'] in arguments */
3057	480	100	for (i = 1; i < items - 1; i++) {
3058			STRLEN klen;
3059	252		const char *kpv = SvPV(ST(i), klen);
3060	252	100	if (klen == 7 && memEQ(kpv, "extends", 7)) {
		100
3061	23		SV *val = ST(i + 1);
3062	25	100	if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVAV) {
		50
3063			/* extends => ['Parent1', 'Parent2', ...] */
3064	3		AV parents_av = (AV)SvRV(val);
3065	3		IV plen = av_len(parents_av) + 1;
3066			IV p;
3067	3	50	Newx(parent_metas, plen, ClassMeta*);
3068	3		parent_alloc = plen;
3069	8	100	for (p = 0; p < plen; p++) {
3070	6		SV **elem = av_fetch(parents_av, p, 0);
3071	6	50	if (elem && SvPOK(*elem)) {
		50
3072			STRLEN pname_len;
3073	6		const char pname = SvPV(elem, pname_len);
3074	6		ClassMeta *pmeta = get_class_meta(aTHX_ pname, pname_len);
3075	6	100	if (!pmeta) {
3076	1		Safefree(parent_metas);
3077	1		croak("Object::Proto::define: parent class '%s' has not been defined", pname);
3078			}
3079	5		parent_metas[parent_count++] = pmeta;
3080			}
3081			}
3082			} else {
3083			/* extends => 'SingleParent' */
3084			STRLEN parent_len;
3085	20		const char *parent_pv = SvPV(val, parent_len);
3086	20		ClassMeta *pmeta = get_class_meta(aTHX_ parent_pv, parent_len);
3087	20	100	if (!pmeta) {
3088	1		croak("Object::Proto::define: parent class '%s' has not been defined", parent_pv);
3089			}
3090	19		Newx(parent_metas, 1, ClassMeta*);
3091	19		parent_alloc = 1;
3092	19		parent_metas[parent_count++] = pmeta;
3093			}
3094			/* Shift remaining args down to remove extends => value */
3095			{
3096			IV j;
3097	52	100	for (j = i; j < items - 2; j++) {
3098	31		ST(j) = ST(j + 2);
3099			}
3100	21		items -= 2;
3101			}
3102	21		break;
3103			}
3104			}
3105
3106			/* Get or create class meta */
3107	249		meta = get_class_meta(aTHX_ class_pv, class_len);
3108	249	50	if (!meta) {
3109	249		meta = create_class_meta(aTHX_ class_pv, class_len);
3110	249		register_class_meta(aTHX_ class_pv, class_len, meta);
3111			}
3112
3113			/* Store parent references */
3114	249	100	if (parent_count > 0) {
3115	21	50	Newx(meta->parent_classes, parent_count, char*);
3116	21	50	Newx(meta->parent_metas, parent_count, ClassMeta*);
3117	21		meta->parent_count = parent_count;
3118	44	100	for (i = 0; i < parent_count; i++) {
3119	23		STRLEN plen = strlen(parent_metas[i]->class_name);
3120	23		Newx(meta->parent_classes[i], plen + 1, char);
3121	23		Copy(parent_metas[i]->class_name, meta->parent_classes[i], plen + 1, char);
3122	23		meta->parent_metas[i] = parent_metas[i];
3123			}
3124			}
3125
3126			/* Calculate total slots needed: all parent inherited + child own */
3127			{
3128	249		IV total_parent_slots = 0;
3129	249		IV child_props = items - 1;
3130			IV max_slots;
3131	272	100	for (i = 0; i < parent_count; i++) {
3132	23		total_parent_slots += parent_metas[i]->slot_count - 1; /* -1 for prototype slot */
3133			}
3134	249		max_slots = 1 + total_parent_slots + child_props;
3135	249	50	Renew(meta->idx_to_prop, max_slots + 1, char*);
3136	249	50	Renew(meta->slots, max_slots + 1, SlotSpec*);
3137	1290	100	for (i = 0; i <= max_slots; i++) {
3138	1041		meta->slots[i] = NULL;
3139	1041		meta->idx_to_prop[i] = NULL;
3140			}
3141			}
3142
3143			/* Copy parent slots (if extends) - iterate all parents, first parent wins on conflict */
3144	272	100	for (i = 0; i < parent_count; i++) {
3145	23		ClassMeta *pmeta = parent_metas[i];
3146			IV j;
3147	79	100	for (j = 1; j < pmeta->slot_count; j++) {
3148	56		SlotSpec *parent_spec = pmeta->slots[j];
3149	56	50	if (parent_spec) {
3150			/* Skip if property already defined by earlier parent */
3151	56		SV **existing = hv_fetch(meta->prop_to_idx, parent_spec->name,
3152			strlen(parent_spec->name), 0);
3153	56	100	if (existing && SvIOK(*existing)) continue;
		50
3154
3155	55		SlotSpec *cloned = clone_slot_spec(aTHX_ parent_spec);
3156	55		IV idx = meta->slot_count++;
3157	55		meta->slots[idx] = cloned;
3158
3159	55	100	if (cloned->has_type) meta->has_any_types = 1;
3160	55	100	if (cloned->has_default) meta->has_any_defaults = 1;
3161	55	50	if (cloned->has_trigger) meta->has_any_triggers = 1;
3162	55	100	if (cloned->is_required) meta->has_any_required = 1;
3163	55	50	if (cloned->is_lazy) meta->has_any_lazy = 1;
3164	55	100	if (cloned->has_builder) meta->has_any_builders = 1;
3165	55	50	if (cloned->is_weak) meta->has_any_weak = 1;
3166
3167	55		hv_store(meta->prop_to_idx, cloned->name, strlen(cloned->name), newSViv(idx), 0);
3168
3169			/* Add to arg_to_idx using init_arg if specified, otherwise property name */
3170	55	100	if (cloned->init_arg) {
3171			STRLEN arg_len;
3172	1		const char *arg_name = SvPV(cloned->init_arg, arg_len);
3173	1		hv_store(meta->arg_to_idx, arg_name, arg_len, newSViv(idx), 0);
3174			} else {
3175	54		hv_store(meta->arg_to_idx, cloned->name, strlen(cloned->name), newSViv(idx), 0);
3176			}
3177
3178	55		meta->idx_to_prop[idx] = cloned->name;
3179
3180	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
3181	53		install_accessor_typed(aTHX_ class_pv, cloned->name, idx, meta);
3182			} else {
3183	2		install_accessor(aTHX_ class_pv, cloned->name, idx);
3184			}
3185	55	100	if (cloned->has_clearer) {
3186	1		install_clearer(aTHX_ class_pv, cloned->name, idx, meta, cloned->clearer_name);
3187			}
3188	55	100	if (cloned->has_predicate) {
3189	1		install_predicate(aTHX_ class_pv, cloned->name, idx, meta, cloned->predicate_name);
3190			}
3191	55	100	if (cloned->reader_name) {
3192	1		install_reader(aTHX_ class_pv, SvPV_nolen(cloned->reader_name), idx, meta);
3193			}
3194	55	100	if (cloned->writer_name) {
3195	1		install_writer(aTHX_ class_pv, SvPV_nolen(cloned->writer_name), idx, meta);
3196			}
3197			}
3198			}
3199			}
3200
3201			/* Register each child property */
3202	735	100	for (i = first_prop; i < items; i++) {
3203			STRLEN spec_len;
3204	487		const char *spec_pv = SvPV(ST(i), spec_len);
3205			SlotSpec *spec;
3206			IV idx;
3207			SV **existing;
3208	487		U8 is_modification = 0;
3209	487		const char *real_spec_pv = spec_pv;
3210	487		STRLEN real_spec_len = spec_len;
3211
3212			/* Check for +attr modification syntax (Moo/Moose-style) */
3213	487	50	if (spec_len > 0 && spec_pv[0] == '+') {
		100
3214	12		is_modification = 1;
3215	12		real_spec_pv = spec_pv + 1;
3216	12		real_spec_len = spec_len - 1;
3217			}
3218
3219			/* Parse the slot spec (e.g., "name:Str:required" or just "name") */
3220	487		spec = parse_slot_spec(aTHX_ real_spec_pv, real_spec_len);
3221
3222			/* Check if this property already exists (from parent) */
3223	487		existing = hv_fetch(meta->prop_to_idx, spec->name, strlen(spec->name), 0);
3224
3225	487	100	if (is_modification) {
3226			/* +attr syntax: merge child modifiers onto parent spec */
3227			SlotSpec *parent_spec;
3228			SlotSpec *merged;
3229
3230	12	100	if (!existing \|\| !SvIOK(*existing)) {
		50
3231	1		croak("+%s: no inherited attribute '%s' to modify",
3232			spec->name, spec->name);
3233			}
3234	11		idx = SvIV(*existing);
3235	11		parent_spec = meta->slots[idx];
3236
3237			/* Merge override onto clone of parent */
3238	11		merged = merge_slot_spec(aTHX_ parent_spec, spec);
3239
3240			/* Free the override spec (we cloned what we needed) */
3241	11		Safefree(spec->name);
3242	11		Safefree(spec);
3243	11		spec = merged;
3244
3245			/* Free old parent spec */
3246	11	50	if (parent_spec) {
3247	11		Safefree(parent_spec->name);
3248	11		Safefree(parent_spec);
3249			}
3250	475	100	} else if (existing && SvIOK(*existing)) {
		50
3251			/* Full override: reuse same slot index */
3252	2		idx = SvIV(*existing);
3253			/* Free old spec */
3254	2	50	if (meta->slots[idx]) {
3255	2		Safefree(meta->slots[idx]->name);
3256	2		Safefree(meta->slots[idx]);
3257			}
3258			} else {
3259	473		idx = meta->slot_count++;
3260			}
3261
3262	486		meta->slots[idx] = spec;
3263
3264			/* Update class-level flags for fast path checks */
3265	486	100	if (spec->has_type) meta->has_any_types = 1;
3266	486	100	if (spec->has_default) meta->has_any_defaults = 1;
3267	486	100	if (spec->has_trigger) meta->has_any_triggers = 1;
3268	486	100	if (spec->is_required) meta->has_any_required = 1;
3269	486	100	if (spec->has_builder) meta->has_any_builders = 1;
3270	486	100	if (spec->is_weak) meta->has_any_weak = 1;
3271
3272			/* Store name -> idx mapping (use parsed name, not full spec) */
3273	486		hv_store(meta->prop_to_idx, spec->name, strlen(spec->name), newSViv(idx), 0);
3274
3275			/* Store arg -> idx mapping (use init_arg if specified, otherwise property name) */
3276	486	100	if (spec->init_arg) {
3277			STRLEN arg_len;
3278	9		const char *arg_name = SvPV(spec->init_arg, arg_len);
3279	9		hv_store(meta->arg_to_idx, arg_name, arg_len, newSViv(idx), 0);
3280			} else {
3281	477		hv_store(meta->arg_to_idx, spec->name, strlen(spec->name), newSViv(idx), 0);
3282			}
3283
3284			/* Store idx -> name mapping */
3285	486		meta->idx_to_prop[idx] = spec->name;
3286
3287			/* Update lazy flag */
3288	486	100	if (spec->is_lazy) meta->has_any_lazy = 1;
3289
3290			/* Install accessor method - typed or plain depending on spec */
3291	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
3292	334		install_accessor_typed(aTHX_ class_pv, spec->name, idx, meta);
3293			} else {
3294	152		install_accessor(aTHX_ class_pv, spec->name, idx);
3295			}
3296
3297			/* Install clearer method if requested */
3298	486	100	if (spec->has_clearer) {
3299	15		install_clearer(aTHX_ class_pv, spec->name, idx, meta, spec->clearer_name);
3300			}
3301
3302			/* Install predicate method if requested */
3303	486	100	if (spec->has_predicate) {
3304	14		install_predicate(aTHX_ class_pv, spec->name, idx, meta, spec->predicate_name);
3305			}
3306
3307			/* Install custom reader method if specified */
3308	486	100	if (spec->reader_name) {
3309	10		install_reader(aTHX_ class_pv, SvPV_nolen(spec->reader_name), idx, meta);
3310			}
3311
3312			/* Install custom writer method if specified */
3313	486	100	if (spec->writer_name) {
3314	11		install_writer(aTHX_ class_pv, SvPV_nolen(spec->writer_name), idx, meta);
3315			}
3316			}
3317
3318			/* Set up @ISA for parent classes (C3 MRO for multiple inheritance) */
3319	248	100	if (parent_count > 0) {
3320	20		AV *isa = get_av(Perl_form(aTHX_ "%s::ISA", class_pv), GV_ADD);
3321	42	100	for (i = 0; i < parent_count; i++) {
3322	22		av_push(isa, newSVpv(parent_metas[i]->class_name, 0));
3323			}
3324			/* Notify Perl's method resolution cache that ISA changed */
3325			#if PERL_VERSION_LT(5, 40, 0)
3326			Perl_mro_isa_changed_in(aTHX_ meta->stash);
3327			#else
3328			/* In 5.40+, mro_isa_changed_in is not exported; modifying @ISA triggers cache invalidation */
3329	20		mro_method_changed_in(meta->stash);
3330			#endif
3331	20		Safefree(parent_metas);
3332			}
3333
3334			/* Install constructor */
3335	248		install_constructor(aTHX_ class_pv, meta);
3336
3337			/* Install prototype methods as class methods */
3338			{
3339			char method_name[256];
3340	248		snprintf(method_name, sizeof(method_name), "%s::set_prototype", class_pv);
3341	248		newXS(method_name, xs_set_prototype, __FILE__);
3342	248		snprintf(method_name, sizeof(method_name), "%s::prototype", class_pv);
3343	248		newXS(method_name, xs_prototype, __FILE__);
3344			}
3345
3346			/* Check for DEMOLISH method - only set up destruction hook if class has one */
3347			{
3348			char demolish_name[256];
3349			CV *demolish_cv;
3350	248		snprintf(demolish_name, sizeof(demolish_name), "%s::DEMOLISH", class_pv);
3351	248		demolish_cv = get_cvn_flags(demolish_name, strlen(demolish_name), 0);
3352	248	100	if (demolish_cv) {
3353	2		meta->demolish_cv = demolish_cv;
3354			/* Install DESTROY wrapper that calls DEMOLISH */
3355	2		install_destroy_wrapper(aTHX_ class_pv, meta);
3356			}
3357			}
3358
3359			/* Check for BUILD method - called after new() */
3360			{
3361			char build_name[256];
3362			CV *build_cv;
3363	248		snprintf(build_name, sizeof(build_name), "%s::BUILD", class_pv);
3364	248		build_cv = get_cvn_flags(build_name, strlen(build_name), 0);
3365	248	100	if (build_cv) {
3366	1		meta->build_cv = build_cv;
3367	1		meta->has_build = 1;
3368			}
3369			}
3370
3371	248		XSRETURN_EMPTY;
3372			}
3373
3374	3011		static XS(xs_prototype) {
3375	3011		dXSARGS;
3376			AV *av;
3377			SV **svp;
3378
3379	3011	50	if (items < 1) croak("Usage: Object::Proto::prototype($obj)");
3380
3381	3011	100	if (!SvROK(ST(0)) \|\| SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
		50
3382	1		croak("Not an object");
3383			}
3384	3010		av = (AV*)SvRV(ST(0));
3385	3010		svp = av_fetch(av, 0, 0);
3386	3010	50	if (svp && SvOK(*svp)) {
		100
3387	3009		ST(0) = SvREFCNT_inc(*svp);
3388			} else {
3389	1		ST(0) = &PL_sv_undef;
3390			}
3391	3010		XSRETURN(1);
3392			}
3393
3394	39		static XS(xs_set_prototype) {
3395	39		dXSARGS;
3396			AV *av;
3397			MAGIC *mg;
3398
3399	39	50	if (items < 2) croak("Usage: Object::Proto::set_prototype($obj, $proto)");
3400
3401	39	100	if (!SvROK(ST(0)) \|\| SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
		50
3402	1		croak("Not an object");
3403			}
3404	38		av = (AV*)SvRV(ST(0));
3405
3406	38		mg = get_object_magic(aTHX_ ST(0));
3407	38	100	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		100
3408	1		croak("Cannot modify frozen object");
3409			}
3410
3411	37		av_store(av, 0, newSVsv(ST(1)));
3412	37		XSRETURN_EMPTY;
3413			}
3414
3415			/* Get the full prototype chain as an arrayref */
3416	4		static XS(xs_prototype_chain) {
3417	4		dXSARGS;
3418			AV *av;
3419			AV *chain;
3420			AV *visited[MAX_PROTOTYPE_DEPTH];
3421	4		int depth = 0;
3422			int i;
3423
3424	4	50	if (items < 1) croak("Usage: Object::Proto::prototype_chain($obj)");
3425
3426	4	50	if (!SvROK(ST(0)) \|\| SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
		50
3427	0		croak("Not an object");
3428			}
3429
3430	4		chain = newAV();
3431	4		av = (AV*)SvRV(ST(0));
3432
3433	7	50	while (av && depth < MAX_PROTOTYPE_DEPTH) {
		50
3434			SV **proto_svp;
3435
3436			/* Check for circular reference */
3437	11	100	for (i = 0; i < depth; i++) {
3438	4	50	if (visited[i] == av) {
3439	0		goto done; /* Cycle detected, stop */
3440			}
3441			}
3442	7		visited[depth] = av;
3443
3444			/* Add this object to the chain */
3445	7		av_push(chain, newRV_inc((SV*)av));
3446
3447			/* Follow prototype */
3448	7		proto_svp = av_fetch(av, 0, 0);
3449	7	50	if (!proto_svp \|\| !SvROK(proto_svp) \|\| SvTYPE(SvRV(proto_svp)) != SVt_PVAV) {
		100
		50
3450			break;
3451			}
3452	3		av = (AV)SvRV(proto_svp);
3453	3		depth++;
3454			}
3455
3456	4		done:
3457	4		ST(0) = sv_2mortal(newRV_noinc((SV*)chain));
3458	4		XSRETURN(1);
3459			}
3460
3461			/* Check if object has a property in its own slots (not prototype) */
3462	6		static XS(xs_has_own_property) {
3463	6		dXSARGS;
3464			AV *av;
3465			SV **svp;
3466			const char *class_name;
3467			STRLEN class_len;
3468			ClassMeta *meta;
3469			const char *prop_name;
3470			STRLEN prop_len;
3471			SV **idx_sv;
3472
3473	6	50	if (items < 2) croak("Usage: Object::Proto::has_own_property($obj, $property)");
3474
3475	6	50	if (!SvROK(ST(0)) \|\| SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
		50
3476	0		croak("Not an object");
3477			}
3478
3479	6		av = (AV*)SvRV(ST(0));
3480	6		class_name = sv_reftype(SvRV(ST(0)), TRUE);
3481	6		class_len = strlen(class_name);
3482
3483	6		meta = get_class_meta(aTHX_ class_name, class_len);
3484	6	50	if (!meta) {
3485	0		XSRETURN_NO;
3486			}
3487
3488	6		prop_name = SvPV(ST(1), prop_len);
3489	6		idx_sv = hv_fetch(meta->prop_to_idx, prop_name, prop_len, 0);
3490	6	50	if (!idx_sv) {
3491	0		XSRETURN_NO;
3492			}
3493
3494			/* Check if this slot has a defined value */
3495	6		svp = av_fetch(av, SvIV(*idx_sv), 0);
3496	6	50	if (svp && SvOK(*svp)) {
		100
3497	3		XSRETURN_YES;
3498			}
3499	3		XSRETURN_NO;
3500			}
3501
3502			/* Get the prototype depth (number of prototypes in chain) */
3503	4		static XS(xs_prototype_depth) {
3504	4		dXSARGS;
3505			AV *av;
3506			AV *visited[MAX_PROTOTYPE_DEPTH];
3507	4		int depth = 0;
3508			int i;
3509
3510	4	50	if (items < 1) croak("Usage: Object::Proto::prototype_depth($obj)");
3511
3512	4	50	if (!SvROK(ST(0)) \|\| SvTYPE(SvRV(ST(0))) != SVt_PVAV) {
		50
3513	0		croak("Not an object");
3514			}
3515
3516	4		av = (AV*)SvRV(ST(0));
3517
3518	7	50	while (av && depth < MAX_PROTOTYPE_DEPTH) {
		50
3519			SV **proto_svp;
3520
3521			/* Check for circular reference */
3522	11	100	for (i = 0; i < depth; i++) {
3523	4	50	if (visited[i] == av) {
3524	0		goto done;
3525			}
3526			}
3527	7		visited[depth] = av;
3528
3529	7		proto_svp = av_fetch(av, 0, 0);
3530	7	50	if (!proto_svp \|\| !SvROK(proto_svp) \|\| SvTYPE(SvRV(proto_svp)) != SVt_PVAV) {
		100
		50
3531			break;
3532			}
3533	3		av = (AV)SvRV(proto_svp);
3534	3		depth++;
3535			}
3536
3537	4		done:
3538	4		XSRETURN_IV(depth);
3539			}
3540
3541	413		static XS(xs_lock) {
3542	413		dXSARGS;
3543			MAGIC *mg;
3544
3545	413	50	if (items < 1) croak("Usage: Object::Proto::lock($obj)");
3546	413	100	VALIDATE_OBJECT(ST(0), "Object::Proto::lock");
		50
		50
3547
3548	410		mg = get_object_magic(aTHX_ ST(0));
3549	410	100	if (!mg) mg = add_object_magic(aTHX_ ST(0));
3550	410	50	if (mg->mg_private & OBJ_FLAG_FROZEN) {
3551	0		croak("Object is frozen");
3552			}
3553	410		mg->mg_private \|= OBJ_FLAG_LOCKED;
3554	410		XSRETURN_EMPTY;
3555			}
3556
3557	404		static XS(xs_unlock) {
3558	404		dXSARGS;
3559			MAGIC *mg;
3560
3561	404	50	if (items < 1) croak("Usage: Object::Proto::unlock($obj)");
3562	404	100	VALIDATE_OBJECT(ST(0), "Object::Proto::unlock");
		50
		50
3563
3564	403		mg = get_object_magic(aTHX_ ST(0));
3565	403	50	if (mg) {
3566	403	100	if (mg->mg_private & OBJ_FLAG_FROZEN) {
3567	1		croak("Cannot unlock frozen object");
3568			}
3569	402		mg->mg_private &= ~OBJ_FLAG_LOCKED;
3570			}
3571	402		XSRETURN_EMPTY;
3572			}
3573
3574	14		static XS(xs_freeze) {
3575	14		dXSARGS;
3576			MAGIC *mg;
3577
3578	14	50	if (items < 1) croak("Usage: Object::Proto::freeze($obj)");
3579	14	100	VALIDATE_OBJECT(ST(0), "Object::Proto::freeze");
		50
		100
3580
3581	12		mg = get_object_magic(aTHX_ ST(0));
3582	12	100	if (!mg) mg = add_object_magic(aTHX_ ST(0));
3583	12		mg->mg_private \|= (OBJ_FLAG_FROZEN \| OBJ_FLAG_LOCKED);
3584	12		XSRETURN_EMPTY;
3585			}
3586
3587	3009		static XS(xs_is_frozen) {
3588	3009		dXSARGS;
3589			MAGIC *mg;
3590
3591	3009	50	if (items < 1) croak("Usage: Object::Proto::is_frozen($obj)");
3592	3009	100	VALIDATE_OBJECT(ST(0), "Object::Proto::is_frozen");
		50
		50
3593
3594	3008		mg = get_object_magic(aTHX_ ST(0));
3595	3008	100	if (mg && (mg->mg_private & OBJ_FLAG_FROZEN)) {
		50
3596	3005		XSRETURN_YES;
3597			}
3598	3		XSRETURN_NO;
3599			}
3600
3601	3418		static XS(xs_is_locked) {
3602	3418		dXSARGS;
3603			MAGIC *mg;
3604
3605	3418	50	if (items < 1) croak("Usage: Object::Proto::is_locked($obj)");
3606	3418	100	VALIDATE_OBJECT(ST(0), "Object::Proto::is_locked");
		50
		50
3607
3608	3417		mg = get_object_magic(aTHX_ ST(0));
3609	3417	100	if (mg && (mg->mg_private & OBJ_FLAG_LOCKED)) {
		100
3610	2409		XSRETURN_YES;
3611			}
3612	1008		XSRETURN_NO;
3613			}
3614
3615			/* ============================================
3616			Introspection API
3617			============================================ */
3618
3619			/* Deep clone an SV, recursing into refs.
3620			* seen_hv maps refaddr strings -> cloned SV* (handles circular refs).
3621			* Returns a mortal SV. */
3622	27533		static SV* deep_clone_sv(pTHX_ SV src, HV seen_hv) {
3623			SV *dst;
3624			char addr_buf[32];
3625			STRLEN addr_len;
3626			SV **cached;
3627
3628			/* Non-references: return a plain copy */
3629	27533	100	if (!SvROK(src)) {
3630	15275		return newSVsv(src);
3631			}
3632
3633			/* Check seen table to break circular references */
3634	12258		addr_len = (STRLEN)sprintf(addr_buf, "%p", (void*)SvRV(src));
3635	12258		cached = hv_fetch(seen_hv, addr_buf, (I32)addr_len, 0);
3636	12258	100	if (cached) {
3637	1		return SvREFCNT_inc(*cached);
3638			}
3639
3640	12257	100	if (SvTYPE(SvRV(src)) == SVt_PVAV) {
3641			/* Array ref (possibly blessed) */
3642	12250		AV src_av = (AV)SvRV(src);
3643	12250		AV *dst_av = newAV();
3644	12250		IV i, len = av_len(src_av);
3645
3646	12250		dst = newRV_noinc((SV*)dst_av);
3647	12250	100	if (SvOBJECT(SvRV(src)))
3648	6629		sv_bless(dst, SvSTASH(SvRV(src)));
3649
3650			/* Register before recursing to handle circular refs */
3651	12250		hv_store(seen_hv, addr_buf, (I32)addr_len, SvREFCNT_inc(dst), 0);
3652
3653	12250		av_extend(dst_av, len);
3654	39778	100	for (i = 0; i <= len; i++) {
3655	27528		SV **svp = av_fetch(src_av, i, 0);
3656	48419	50	if (svp && SvOK(*svp)) {
		100
3657	20891		SV child = deep_clone_sv(aTHX_ svp, seen_hv);
3658	20891		av_store(dst_av, i, child);
3659			} else {
3660	6637		av_store(dst_av, i, newSV(0));
3661			}
3662			}
3663
3664	7	100	} else if (SvTYPE(SvRV(src)) == SVt_PVHV) {
3665			/* Hash ref (possibly blessed) */
3666	6		HV src_hv = (HV)SvRV(src);
3667	6		HV *dst_hv = newHV();
3668			HE *he;
3669
3670	6		dst = newRV_noinc((SV*)dst_hv);
3671	6	50	if (SvOBJECT(SvRV(src)))
3672	0		sv_bless(dst, SvSTASH(SvRV(src)));
3673
3674	6		hv_store(seen_hv, addr_buf, (I32)addr_len, SvREFCNT_inc(dst), 0);
3675
3676	6		hv_iterinit(src_hv);
3677	16	100	while ((he = hv_iternext(src_hv))) {
3678			STRLEN klen;
3679	10	50	const char *key = HePV(he, klen);
3680	10		SV *val = HeVAL(he);
3681	10		SV *copy = deep_clone_sv(aTHX_ val, seen_hv);
3682	10		hv_store(dst_hv, key, (I32)klen, copy, 0);
3683			}
3684
3685	1	50	} else if (SvTYPE(SvRV(src)) < SVt_PVAV) {
3686			/* Scalar ref */
3687	1		SV *inner = deep_clone_sv(aTHX_ SvRV(src), seen_hv);
3688	1		dst = newRV_noinc(inner);
3689	1	50	if (SvOBJECT(SvRV(src)))
3690	0		sv_bless(dst, SvSTASH(SvRV(src)));
3691	1		hv_store(seen_hv, addr_buf, (I32)addr_len, SvREFCNT_inc(dst), 0);
3692
3693			} else {
3694			/* Code refs, globs, etc. — share as-is */
3695	0		dst = newSVsv(src);
3696	0		hv_store(seen_hv, addr_buf, (I32)addr_len, SvREFCNT_inc(dst), 0);
3697			}
3698
3699	12257		return dst;
3700			}
3701
3702			/* Object::Proto::clone($obj) - deep clone an object, arrayref, hashref,
3703			* scalarref, or plain scalar */
3704	6637		static XS(xs_clone) {
3705	6637		dXSARGS;
3706			SV *src;
3707
3708	6637	50	if (items < 1) croak("Usage: Object::Proto::clone($val) or $obj->clone()");
3709
3710	6637		src = ST(0);
3711
3712			/* Plain scalar (non-ref): return a copy of the value */
3713	6637	100	if (!SvROK(src)) {
3714	6	100	if (SvOK(src)) {
3715	4		ST(0) = sv_2mortal(newSVsv(src));
3716			} else {
3717	2		ST(0) = &PL_sv_undef;
3718			}
3719	6		XSRETURN(1);
3720			}
3721
3722			{
3723	6631		HV *seen_hv = newHV();
3724			SV *dst;
3725
3726			/* For blessed objects backed by an AV: strip frozen/locked magic
3727			* by cloning the underlying AV fresh (deep_clone_sv handles the
3728			* bless but the new ref carries no Object::Proto magic). */
3729	6631		dst = deep_clone_sv(aTHX_ src, seen_hv);
3730	6631		SvREFCNT_dec((SV*)seen_hv);
3731
3732	6631		ST(0) = sv_2mortal(dst);
3733	6631		XSRETURN(1);
3734			}
3735			}
3736
3737			/* Object::Proto::properties($class) - return property names for a class */
3738	10620		static XS(xs_properties) {
3739	10620		dXSARGS;
3740			STRLEN class_len;
3741			const char *class_pv;
3742			ClassMeta *meta;
3743			IV i;
3744
3745	10620	50	if (items < 1) croak("Usage: Object::Proto::properties($class)");
3746
3747	10620		class_pv = SvPV(ST(0), class_len);
3748
3749	10620		meta = get_class_meta(aTHX_ class_pv, class_len);
3750	10620	100	if (!meta) {
3751			/* Non-existent class: return empty list / 0 */
3752	4002	100	if (GIMME_V == G_ARRAY) {
3753	2001		XSRETURN_EMPTY;
3754			} else {
3755	2001		XSRETURN_IV(0);
3756			}
3757			}
3758
3759	6618	100	if (GIMME_V == G_ARRAY) {
3760			/* List context: return property names */
3761	4617		IV count = meta->slot_count - 1; /* -1 because slot 0 is prototype */
3762	4617		SP -= items;
3763	4617	50	EXTEND(SP, count);
		50
3764
3765	18477	100	for (i = 1; i < meta->slot_count; i++) {
3766	13860	50	if (meta->idx_to_prop[i]) {
3767	13860		PUSHs(sv_2mortal(newSVpv(meta->idx_to_prop[i], 0)));
3768			}
3769			}
3770	4617		XSRETURN(count);
3771			} else {
3772			/* Scalar context: return count */
3773	2001		XSRETURN_IV(meta->slot_count - 1);
3774			}
3775			}
3776
3777			/* Object::Proto::slot_info($class, $property) - return hashref with slot metadata */
3778	16830		static XS(xs_slot_info) {
3779	16830		dXSARGS;
3780			STRLEN class_len, prop_len;
3781			const char class_pv, prop_pv;
3782			ClassMeta *meta;
3783			SV **idx_svp;
3784			IV idx;
3785			SlotSpec *spec;
3786			HV *info;
3787
3788	16830	50	if (items < 2) croak("Usage: Object::Proto::slot_info($class, $property)");
3789
3790	16830		class_pv = SvPV(ST(0), class_len);
3791	16830		prop_pv = SvPV(ST(1), prop_len);
3792
3793			/* Look up class meta */
3794	16830		meta = get_class_meta(aTHX_ class_pv, class_len);
3795	16830	100	if (!meta) {
3796	2002		XSRETURN_UNDEF;
3797			}
3798
3799			/* Look up property index - O(1) hash lookup */
3800	14828		idx_svp = hv_fetch(meta->prop_to_idx, prop_pv, prop_len, 0);
3801	14828	100	if (!idx_svp) {
3802	2002		XSRETURN_UNDEF;
3803			}
3804	12826		idx = SvIV(*idx_svp);
3805
3806			/* Build result hashref */
3807	12826		info = newHV();
3808
3809			/* Basic info always present */
3810	12826		hv_store(info, "name", 4, newSVpv(prop_pv, prop_len), 0);
3811	12826		hv_store(info, "index", 5, newSViv(idx), 0);
3812
3813			/* Get slot spec if available */
3814	12826	50	spec = (meta->slots && idx < meta->slot_count) ? meta->slots[idx] : NULL;
		50
3815
3816	12826	50	if (spec && spec->has_type) {
		100
3817			const char *type_name;
3818	10824	100	if (spec->type_id == TYPE_CUSTOM && spec->registered) {
		50
3819	1		type_name = spec->registered->name;
3820			} else {
3821	10823		type_name = type_id_to_name(spec->type_id);
3822			}
3823	10824		hv_store(info, "type", 4, newSVpv(type_name, 0), 0);
3824			}
3825
3826			/* Boolean flags */
3827	12826	50	hv_store(info, "is_required", 11, newSViv(spec ? spec->is_required : 0), 0);
3828	12826	50	hv_store(info, "is_readonly", 11, newSViv(spec ? spec->is_readonly : 0), 0);
3829	12826	50	hv_store(info, "is_lazy", 7, newSViv(spec ? spec->is_lazy : 0), 0);
3830	12826	50	hv_store(info, "is_weak", 7, newSViv(spec ? spec->is_weak : 0), 0);
3831	12826	50	hv_store(info, "has_default", 11, newSViv(spec ? spec->has_default : 0), 0);
3832	12826	50	hv_store(info, "has_trigger", 11, newSViv(spec ? spec->has_trigger : 0), 0);
3833	12826	50	hv_store(info, "has_coerce", 10, newSViv(spec ? spec->has_coerce : 0), 0);
3834	12826	50	hv_store(info, "has_builder", 11, newSViv(spec ? spec->has_builder : 0), 0);
3835	12826	50	hv_store(info, "has_clearer", 11, newSViv(spec ? spec->has_clearer : 0), 0);
3836	12826	50	hv_store(info, "has_predicate", 13, newSViv(spec ? spec->has_predicate : 0), 0);
3837	12826	50	hv_store(info, "has_type", 8, newSViv(spec ? spec->has_type : 0), 0);
3838
3839			/* Default value (if present) */
3840	12826	50	if (spec && spec->has_default && spec->default_sv) {
		100
		50
3841	5204		hv_store(info, "default", 7, newSVsv(spec->default_sv), 0);
3842			}
3843
3844			/* Builder method name */
3845	12826	50	if (spec && spec->has_builder && spec->builder_name) {
		100
		50
3846	2		hv_store(info, "builder", 7, newSVsv(spec->builder_name), 0);
3847			}
3848
3849			/* init_arg (if specified) */
3850	12826	50	if (spec && spec->init_arg) {
		100
3851	1		hv_store(info, "init_arg", 8, newSVsv(spec->init_arg), 0);
3852			}
3853
3854	12826		ST(0) = sv_2mortal(newRV_noinc((SV*)info));
3855	12826		XSRETURN(1);
3856			}
3857
3858			/* Object::Proto::parent($class) - return parent class name or undef */
3859	7		static XS(xs_parent) {
3860	7		dXSARGS;
3861			STRLEN class_len;
3862			const char *class_pv;
3863			ClassMeta *meta;
3864
3865	7	50	if (items < 1) croak("Usage: Object::Proto::parent($class)");
3866
3867	7		class_pv = SvPV(ST(0), class_len);
3868	7		meta = get_class_meta(aTHX_ class_pv, class_len);
3869
3870	7	50	if (!meta \|\| meta->parent_count == 0) {
		100
3871	2	50	if (GIMME_V == G_ARRAY) {
3872	0		XSRETURN_EMPTY;
3873			}
3874	2		XSRETURN_UNDEF;
3875			}
3876
3877	5	100	if (GIMME_V == G_ARRAY) {
3878			/* List context: return all parents */
3879			IV i;
3880	1		SP -= items;
3881	1	50	EXTEND(SP, meta->parent_count);
		50
3882	3	100	for (i = 0; i < meta->parent_count; i++) {
3883	2		PUSHs(sv_2mortal(newSVpv(meta->parent_classes[i], 0)));
3884			}
3885	1		XSRETURN(meta->parent_count);
3886			} else {
3887			/* Scalar context: return first parent */
3888	4		ST(0) = sv_2mortal(newSVpv(meta->parent_classes[0], 0));
3889	4		XSRETURN(1);
3890			}
3891			}
3892
3893			/* Object::Proto::ancestors($class) - return list of all ancestor class names (breadth-first) */
3894	4		static XS(xs_ancestors) {
3895	4		dXSARGS;
3896			STRLEN class_len;
3897			const char *class_pv;
3898			ClassMeta *meta;
3899			AV *result;
3900			HV *seen;
3901			AV *queue;
3902	4		IV count = 0;
3903
3904	4	50	if (items < 1) croak("Usage: Object::Proto::ancestors($class)");
3905
3906	4		class_pv = SvPV(ST(0), class_len);
3907	4		meta = get_class_meta(aTHX_ class_pv, class_len);
3908
3909	4		SP -= items;
3910
3911	4	50	if (meta && meta->parent_count > 0) {
		100
3912			IV i;
3913	3		result = newAV();
3914	3		seen = newHV();
3915	3		queue = newAV();
3916
3917			/* Seed queue with direct parents */
3918	7	100	for (i = 0; i < meta->parent_count; i++) {
3919	4		av_push(queue, newSVpv(meta->parent_metas[i]->class_name, 0));
3920			}
3921
3922			/* BFS traversal */
3923	8	100	while (av_len(queue) >= 0) {
3924	5		SV *cur_sv = av_shift(queue);
3925			STRLEN cur_len;
3926	5		const char *cur_name = SvPV(cur_sv, cur_len);
3927			ClassMeta *cur_meta;
3928
3929			/* Skip if already seen */
3930	5	50	if (hv_exists(seen, cur_name, cur_len)) {
3931	0		SvREFCNT_dec(cur_sv);
3932	0		continue;
3933			}
3934	5		hv_store(seen, cur_name, cur_len, &PL_sv_yes, 0);
3935	5		av_push(result, cur_sv);
3936
3937			/* Enqueue this class's parents */
3938	5		cur_meta = get_class_meta(aTHX_ cur_name, cur_len);
3939	5	50	if (cur_meta) {
3940	6	100	for (i = 0; i < cur_meta->parent_count; i++) {
3941	1		const char *pname = cur_meta->parent_classes[i];
3942	1	50	if (!hv_exists(seen, pname, strlen(pname))) {
3943	1		av_push(queue, newSVpv(pname, 0));
3944			}
3945			}
3946			}
3947			}
3948
3949	3		count = av_len(result) + 1;
3950	3	50	EXTEND(SP, count);
		50
3951	8	100	for (i = 0; i < count; i++) {
3952	5		SV **elem = av_fetch(result, i, 0);
3953	5	50	if (elem) PUSHs(sv_2mortal(newSVsv(*elem)));
3954			}
3955
3956	3		SvREFCNT_dec((SV*)result);
3957	3		SvREFCNT_dec((SV*)seen);
3958	3		SvREFCNT_dec((SV*)queue);
3959			}
3960
3961	4		XSRETURN(count);
3962			}
3963
3964			/* ============================================
3965			Global cleanup
3966			============================================ */
3967
3968			/* Cleanup during global destruction */
3969	52		static void object_cleanup_globals(pTHX_ void *data) {
3970			PERL_UNUSED_ARG(data);
3971
3972			/* During global destruction, just NULL out pointers.
3973			* Perl handles SV cleanup. Trying to free them ourselves
3974			* can cause crashes due to destruction order. */
3975	52	50	if (PL_dirty) {
3976	52		g_type_registry = NULL;
3977	52		g_class_registry = NULL;
3978	52		g_func_accessor_registry = NULL;
3979	52		return;
3980			}
3981
3982			/* Normal cleanup - not during global destruction */
3983			/* Note: Full cleanup omitted for simplicity; Perl handles SV refcounts */
3984	0		g_type_registry = NULL;
3985	0		g_class_registry = NULL;
3986	0		g_func_accessor_registry = NULL;
3987			}
3988
3989			/* ============================================
3990			Type Registry API
3991			============================================ */
3992
3993			/* C-level registration for external XS modules (called from BOOT)
3994			This is the fast path - no Perl callback overhead */
3995	0		PERL_CALLCONV void object_register_type_xs(pTHX_ const char *name,
3996			ObjectTypeCheckFunc check,
3997			ObjectTypeCoerceFunc coerce) {
3998			RegisteredType *type;
3999	0		STRLEN name_len = strlen(name);
4000
4001	0	0	if (!g_type_registry) {
4002	0		g_type_registry = newHV();
4003			}
4004
4005			/* Check if already registered */
4006	0		SV **existing = hv_fetch(g_type_registry, name, name_len, 0);
4007	0	0	if (existing) {
4008	0		croak("Type '%s' is already registered", name);
4009			}
4010
4011	0		Newxz(type, 1, RegisteredType);
4012	0		Newx(type->name, name_len + 1, char);
4013	0		Copy(name, type->name, name_len, char);
4014	0		type->name[name_len] = '\0';
4015
4016	0		type->check = check; /* Direct C function pointer - no Perl overhead */
4017	0		type->coerce = coerce; /* Direct C function pointer - no Perl overhead */
4018	0		type->perl_check = NULL;
4019	0		type->perl_coerce = NULL;
4020
4021	0		hv_store(g_type_registry, name, name_len, newSViv(PTR2IV(type)), 0);
4022	0		}
4023
4024			/* Getter for external modules to look up a registered type */
4025	0		PERL_CALLCONV RegisteredType* object_get_registered_type(pTHX_ const char *name) {
4026	0		STRLEN name_len = strlen(name);
4027	0	0	if (!g_type_registry) return NULL;
4028
4029	0		SV **svp = hv_fetch(g_type_registry, name, name_len, 0);
4030	0	0	if (svp && SvIOK(*svp)) {
		0
4031	0		return INT2PTR(RegisteredType, SvIV(svp));
4032			}
4033	0		return NULL;
4034			}
4035
4036			/* Object::Proto::register_type($name, $check_cb [, $coerce_cb]) */
4037	8		static XS(xs_register_type) {
4038	8		dXSARGS;
4039			STRLEN name_len;
4040			const char *name;
4041			RegisteredType *type;
4042
4043	8	50	if (items < 2) croak("Usage: Object::Proto::register_type($name, $check_cb [, $coerce_cb])");
4044
4045	8		name = SvPV(ST(0), name_len);
4046
4047			/* Check if already registered */
4048	8	50	if (g_type_registry) {
4049	8		SV **existing = hv_fetch(g_type_registry, name, name_len, 0);
4050	8	100	if (existing) {
4051	1		croak("Type '%s' is already registered", name);
4052			}
4053			} else {
4054	0		g_type_registry = newHV();
4055			}
4056
4057	7		Newxz(type, 1, RegisteredType);
4058	7		Newx(type->name, name_len + 1, char);
4059	7		Copy(name, type->name, name_len, char);
4060	7		type->name[name_len] = '\0';
4061
4062			/* Store Perl check callback */
4063	7		type->perl_check = newSVsv(ST(1));
4064	7		SvREFCNT_inc(type->perl_check);
4065
4066			/* Store Perl coerce callback if provided */
4067	7	100	if (items > 2 && SvOK(ST(2))) {
		50
4068	3		type->perl_coerce = newSVsv(ST(2));
4069	3		SvREFCNT_inc(type->perl_coerce);
4070			}
4071
4072	7		hv_store(g_type_registry, name, name_len, newSViv(PTR2IV(type)), 0);
4073
4074	7		XSRETURN_YES;
4075			}
4076
4077			/* Object::Proto::has_type($name) - check if a type is registered */
4078	4010		static XS(xs_has_type) {
4079	4010		dXSARGS;
4080			STRLEN name_len;
4081			const char *name;
4082
4083	4010	50	if (items < 1) croak("Usage: Object::Proto::has_type($name)");
4084
4085	4010		name = SvPV(ST(0), name_len);
4086
4087			/* Check built-in types */
4088	4010		BuiltinTypeID builtin = parse_builtin_type(name, name_len);
4089	4010	100	if (builtin != TYPE_NONE) {
4090	3003		XSRETURN_YES;
4091			}
4092
4093			/* Check registry */
4094	1007	50	if (g_type_registry) {
4095	1007		SV **existing = hv_fetch(g_type_registry, name, name_len, 0);
4096	1007	100	if (existing) {
4097	6		XSRETURN_YES;
4098			}
4099			}
4100
4101	1001		XSRETURN_NO;
4102			}
4103
4104			/* Object::Proto::list_types() - return list of registered type names */
4105	2402		static XS(xs_list_types) {
4106	2402		dXSARGS;
4107	2402		AV *result = newAV();
4108
4109			PERL_UNUSED_ARG(items);
4110
4111			/* Add built-in types */
4112	2402		av_push(result, newSVpvs("Any"));
4113	2402		av_push(result, newSVpvs("Defined"));
4114	2402		av_push(result, newSVpvs("Str"));
4115	2402		av_push(result, newSVpvs("Int"));
4116	2402		av_push(result, newSVpvs("Num"));
4117	2402		av_push(result, newSVpvs("Bool"));
4118	2402		av_push(result, newSVpvs("ArrayRef"));
4119	2402		av_push(result, newSVpvs("HashRef"));
4120	2402		av_push(result, newSVpvs("CodeRef"));
4121	2402		av_push(result, newSVpvs("Object"));
4122
4123			/* Add registered types */
4124	2402	50	if (g_type_registry) {
4125			HE *he;
4126	2402		hv_iterinit(g_type_registry);
4127	2406	100	while ((he = hv_iternext(g_type_registry))) {
4128	4		av_push(result, newSVsv(hv_iterkeysv(he)));
4129			}
4130			}
4131
4132	2402		ST(0) = newRV_noinc((SV*)result);
4133	2402		sv_2mortal(ST(0));
4134	2402		XSRETURN(1);
4135			}
4136
4137			/* ============================================
4138			Singleton support
4139			============================================ */
4140
4141			/* XS implementation of instance() method for singletons */
4142	8053		static XS(xs_singleton_instance) {
4143	8053		dXSARGS;
4144	8053		ClassMeta meta = INT2PTR(ClassMeta, CvXSUBANY(cv).any_iv);
4145
4146			PERL_UNUSED_ARG(items);
4147
4148	8053	50	if (!meta) {
4149	0		croak("Singleton metadata not found");
4150			}
4151
4152			/* Return cached instance if it exists */
4153	8053	100	if (meta->singleton_instance && SvOK(meta->singleton_instance)) {
		50
4154	8045		ST(0) = meta->singleton_instance;
4155	8045		XSRETURN(1);
4156			}
4157
4158			/* Create new instance */
4159			{
4160	8		dSP;
4161			int count;
4162			SV *obj;
4163			GV *build_gv;
4164			char full_build[256];
4165
4166	8		ENTER;
4167	8		SAVETMPS;
4168
4169			/* Call ClassName->new() */
4170	8	50	PUSHMARK(SP);
4171	8	50	XPUSHs(sv_2mortal(newSVpv(meta->class_name, 0)));
4172	8		PUTBACK;
4173
4174	8		count = call_method("new", G_SCALAR);
4175
4176	8		SPAGAIN;
4177
4178	8	50	if (count != 1) {
4179	0		croak("Singleton new() did not return object");
4180			}
4181
4182	8		obj = POPs;
4183	8		SvREFCNT_inc(obj); /* Keep the object alive */
4184
4185	8		PUTBACK;
4186
4187			/* Check for BUILD method and call it */
4188	8		snprintf(full_build, sizeof(full_build), "%s::BUILD", meta->class_name);
4189	8		build_gv = gv_fetchpv(full_build, 0, SVt_PVCV);
4190	8	50	if (build_gv && GvCV(build_gv)) {
		100
4191	5	50	PUSHMARK(SP);
4192	5	50	XPUSHs(obj);
4193	5		PUTBACK;
4194	5		call_method("BUILD", G_VOID \| G_DISCARD);
4195			}
4196
4197			/* Cache the instance */
4198	8		meta->singleton_instance = obj;
4199
4200	8	50	FREETMPS;
4201	8		LEAVE;
4202
4203	8		ST(0) = obj;
4204	8		XSRETURN(1);
4205			}
4206			}
4207
4208			/* ============================================
4209			Role API
4210			============================================ */
4211
4212			/* Object::Proto::role("RoleName", @slot_specs) - define a role */
4213	7		static XS(xs_role) {
4214	7		dXSARGS;
4215			STRLEN role_len;
4216			const char *role_pv;
4217			RoleMeta *meta;
4218			IV i;
4219
4220	7	50	if (items < 1) croak("Usage: Object::Proto::role($role_name, @slot_specs)");
4221
4222	7		role_pv = SvPV(ST(0), role_len);
4223
4224			/* Check if role already exists */
4225	7		meta = get_role_meta(aTHX_ role_pv, role_len);
4226	7	50	if (meta) {
4227	0		croak("Role '%s' already defined", role_pv);
4228			}
4229
4230			/* Create role meta */
4231	7		Newxz(meta, 1, RoleMeta);
4232	7		Newxz(meta->role_name, role_len + 1, char);
4233	7		Copy(role_pv, meta->role_name, role_len, char);
4234	7		meta->role_name[role_len] = '\0';
4235	7		meta->stash = gv_stashpvn(role_pv, role_len, GV_ADD);
4236
4237			/* Allocate slots array */
4238	7	100	if (items > 1) {
4239	6		Newx(meta->slots, items - 1, SlotSpec*);
4240	6		meta->slot_count = 0;
4241
4242	14	100	for (i = 1; i < items; i++) {
4243			STRLEN spec_len;
4244	8		const char *spec_pv = SvPV(ST(i), spec_len);
4245	8		SlotSpec *spec = parse_slot_spec(aTHX_ spec_pv, spec_len);
4246	8		meta->slots[meta->slot_count++] = spec;
4247			}
4248			}
4249
4250	7		register_role_meta(aTHX_ role_pv, role_len, meta);
4251
4252	7		XSRETURN_EMPTY;
4253			}
4254
4255			/* Object::Proto::requires("RoleName", @method_names) - declare required methods */
4256	2		static XS(xs_requires) {
4257	2		dXSARGS;
4258			STRLEN role_len;
4259			const char *role_pv;
4260			RoleMeta *meta;
4261			IV i;
4262
4263	2	50	if (items < 2) croak("Usage: Object::Proto::requires($role_name, @method_names)");
4264
4265	2		role_pv = SvPV(ST(0), role_len);
4266	2		meta = get_role_meta(aTHX_ role_pv, role_len);
4267	2	50	if (!meta) {
4268	0		croak("Role '%s' not defined", role_pv);
4269			}
4270
4271			/* Add required methods */
4272	2	50	Renew(meta->required_methods, meta->required_count + items - 1, char*);
4273	4	100	for (i = 1; i < items; i++) {
4274			STRLEN name_len;
4275	2		const char *name_pv = SvPV(ST(i), name_len);
4276	2		Newx(meta->required_methods[meta->required_count], name_len + 1, char);
4277	2		Copy(name_pv, meta->required_methods[meta->required_count], name_len, char);
4278	2		meta->required_methods[meta->required_count][name_len] = '\0';
4279	2		meta->required_count++;
4280			}
4281
4282	2		XSRETURN_EMPTY;
4283			}
4284
4285			/* Object::Proto::with("ClassName", @role_names) - apply roles to a class */
4286	9		static XS(xs_with) {
4287	9		dXSARGS;
4288			STRLEN class_len;
4289			const char *class_pv;
4290			ClassMeta *class_meta;
4291			IV i;
4292
4293	9	50	if (items < 2) croak("Usage: Object::Proto::with($class_name, @role_names)");
4294
4295	9		class_pv = SvPV(ST(0), class_len);
4296	9		class_meta = get_class_meta(aTHX_ class_pv, class_len);
4297	9	50	if (!class_meta) {
4298	0		croak("Class '%s' not defined with Object::Proto::define", class_pv);
4299			}
4300
4301	17	100	for (i = 1; i < items; i++) {
4302			STRLEN role_len;
4303	11		const char *role_pv = SvPV(ST(i), role_len);
4304	11		RoleMeta *role_meta = get_role_meta(aTHX_ role_pv, role_len);
4305
4306	11	50	if (!role_meta) {
4307			/* Auto-load the role module */
4308	0		SV *module_sv = newSVpvn(role_pv, role_len);
4309			SV *err;
4310	0		load_module(PERL_LOADMOD_NOIMPORT, module_sv, NULL);
4311	0	0	err = ERRSV;
4312	0	0	if (SvTRUE(err)) {
4313	0		croak("Role '%s' not defined (failed to load: %" SVf ")", role_pv, SVfARG(err));
4314			}
4315	0		role_meta = get_role_meta(aTHX_ role_pv, role_len);
4316			}
4317	11	50	if (!role_meta) {
4318	0		croak("Role '%s' not defined", role_pv);
4319			}
4320
4321	11		apply_role_to_class(aTHX_ class_meta, role_meta);
4322			}
4323
4324	6		XSRETURN_EMPTY;
4325			}
4326
4327			/* Object::Proto::does("ClassName" or $obj, "RoleName") - check if class/object does role */
4328	8		static XS(xs_does) {
4329	8		dXSARGS;
4330			ClassMeta *meta;
4331			STRLEN role_len;
4332			const char *role_pv;
4333			IV i;
4334
4335	8	50	if (items < 2) croak("Usage: Object::Proto::does($class_or_obj, $role_name)");
4336
4337			/* Get class meta from class name or object */
4338	8	100	if (SvROK(ST(0))) {
4339			/* Object - get stash name */
4340	7		HV *stash = SvSTASH(SvRV(ST(0)));
4341	7	50	meta = get_class_meta(aTHX_ HvNAME(stash), HvNAMELEN(stash));
		50
		50
		0
		50
		50
		50
		50
		50
		0
		50
		50
4342			} else {
4343			STRLEN class_len;
4344	1		const char *class_pv = SvPV(ST(0), class_len);
4345	1		meta = get_class_meta(aTHX_ class_pv, class_len);
4346			}
4347
4348	8	50	if (!meta) {
4349	0		XSRETURN_NO;
4350			}
4351
4352	8		role_pv = SvPV(ST(1), role_len);
4353
4354			/* Check if role is in consumed_roles */
4355	11	100	for (i = 0; i < meta->role_count; i++) {
4356	10	100	if (strEQ(meta->consumed_roles[i]->role_name, role_pv)) {
4357	7		XSRETURN_YES;
4358			}
4359			}
4360
4361	1		XSRETURN_NO;
4362			}
4363
4364			/* ============================================
4365			Method Modifier API
4366			============================================ */
4367
4368			/* Object::Proto::before("Class::method", \&callback) */
4369	4		static XS(xs_before) {
4370	4		dXSARGS;
4371			STRLEN full_name_len;
4372			const char *full_name;
4373			char class_name, method_name, *sep;
4374			ClassMeta *meta;
4375
4376	4	50	if (items != 2) croak("Usage: Object::Proto::before('Class::method', \\&callback)");
4377
4378	4		full_name = SvPV(ST(0), full_name_len);
4379	4	50	if (!SvROK(ST(1)) \|\| SvTYPE(SvRV(ST(1))) != SVt_PVCV) {
		50
4380	0		croak("Second argument must be a code reference");
4381			}
4382
4383			/* Parse "Class::method" */
4384	4		sep = strstr(full_name, "::");
4385	4	50	if (!sep) {
4386	0		croak("Method name must be fully qualified (Class::method)");
4387			}
4388
4389			{
4390	4		STRLEN class_len = sep - full_name;
4391	4		Newx(class_name, class_len + 1, char);
4392	4		Copy(full_name, class_name, class_len, char);
4393	4		class_name[class_len] = '\0';
4394	4		method_name = sep + 2;
4395			}
4396
4397	4		meta = get_class_meta(aTHX_ class_name, strlen(class_name));
4398	4	50	if (!meta) {
4399	0		Safefree(class_name);
4400	0		croak("Class '%s' not defined with Object::Proto::define", class_name);
4401			}
4402
4403	4		add_modifier(aTHX_ meta, method_name, ST(1), 0); /* 0 = before */
4404
4405	4		Safefree(class_name);
4406	4		XSRETURN_EMPTY;
4407			}
4408
4409			/* Object::Proto::after("Class::method", \&callback) */
4410	4		static XS(xs_after) {
4411	4		dXSARGS;
4412			STRLEN full_name_len;
4413			const char *full_name;
4414			char class_name, method_name, *sep;
4415			ClassMeta *meta;
4416
4417	4	50	if (items != 2) croak("Usage: Object::Proto::after('Class::method', \\&callback)");
4418
4419	4		full_name = SvPV(ST(0), full_name_len);
4420	4	50	if (!SvROK(ST(1)) \|\| SvTYPE(SvRV(ST(1))) != SVt_PVCV) {
		50
4421	0		croak("Second argument must be a code reference");
4422			}
4423
4424	4		sep = strstr(full_name, "::");
4425	4	50	if (!sep) {
4426	0		croak("Method name must be fully qualified (Class::method)");
4427			}
4428
4429			{
4430	4		STRLEN class_len = sep - full_name;
4431	4		Newx(class_name, class_len + 1, char);
4432	4		Copy(full_name, class_name, class_len, char);
4433	4		class_name[class_len] = '\0';
4434	4		method_name = sep + 2;
4435			}
4436
4437	4		meta = get_class_meta(aTHX_ class_name, strlen(class_name));
4438	4	50	if (!meta) {
4439	0		Safefree(class_name);
4440	0		croak("Class '%s' not defined with Object::Proto::define", class_name);
4441			}
4442
4443	4		add_modifier(aTHX_ meta, method_name, ST(1), 1); /* 1 = after */
4444
4445	4		Safefree(class_name);
4446	4		XSRETURN_EMPTY;
4447			}
4448
4449			/* Object::Proto::around("Class::method", \&callback) */
4450	2		static XS(xs_around) {
4451	2		dXSARGS;
4452			STRLEN full_name_len;
4453			const char *full_name;
4454			char class_name, method_name, *sep;
4455			ClassMeta *meta;
4456
4457	2	50	if (items != 2) croak("Usage: Object::Proto::around('Class::method', \\&callback)");
4458
4459	2		full_name = SvPV(ST(0), full_name_len);
4460	2	50	if (!SvROK(ST(1)) \|\| SvTYPE(SvRV(ST(1))) != SVt_PVCV) {
		50
4461	0		croak("Second argument must be a code reference");
4462			}
4463
4464	2		sep = strstr(full_name, "::");
4465	2	50	if (!sep) {
4466	0		croak("Method name must be fully qualified (Class::method)");
4467			}
4468
4469			{
4470	2		STRLEN class_len = sep - full_name;
4471	2		Newx(class_name, class_len + 1, char);
4472	2		Copy(full_name, class_name, class_len, char);
4473	2		class_name[class_len] = '\0';
4474	2		method_name = sep + 2;
4475			}
4476
4477	2		meta = get_class_meta(aTHX_ class_name, strlen(class_name));
4478	2	50	if (!meta) {
4479	0		Safefree(class_name);
4480	0		croak("Class '%s' not defined with Object::Proto::define", class_name);
4481			}
4482
4483	2		add_modifier(aTHX_ meta, method_name, ST(1), 2); /* 2 = around */
4484
4485	2		Safefree(class_name);
4486	2		XSRETURN_EMPTY;
4487			}
4488
4489			/* Object::Proto::singleton("Class") - marks class as singleton and installs instance() method */
4490	8		static XS(xs_singleton) {
4491	8		dXSARGS;
4492			STRLEN class_len;
4493			const char *class_pv;
4494			ClassMeta *meta;
4495			char full_name[256];
4496			CV *instance_cv;
4497
4498	8	50	if (items < 1) croak("Usage: Object::Proto::singleton($class)");
4499
4500	8		class_pv = SvPV(ST(0), class_len);
4501
4502	8		meta = get_class_meta(aTHX_ class_pv, class_len);
4503	8	50	if (!meta) {
4504	0		croak("Class '%s' not defined with Object::Proto::define", class_pv);
4505			}
4506
4507			/* Mark as singleton */
4508	8		meta->is_singleton = 1;
4509	8		meta->singleton_instance = NULL;
4510
4511			/* Install instance() class method */
4512	8		snprintf(full_name, sizeof(full_name), "%s::instance", class_pv);
4513	8		instance_cv = newXS(full_name, xs_singleton_instance, __FILE__);
4514	8		CvXSUBANY(instance_cv).any_iv = PTR2IV(meta);
4515
4516	8		XSRETURN_EMPTY;
4517			}
4518
4519			/* ============================================
4520			Boot
4521			============================================ */
4522
4523	52		XS_EXTERNAL(boot_Object__Proto) {
4524	52		dXSBOOTARGSXSAPIVERCHK;
4525			PERL_UNUSED_VAR(items);
4526
4527			/* Register custom ops */
4528	52		XopENTRY_set(&object_new_xop, xop_name, "object_new");
4529	52		XopENTRY_set(&object_new_xop, xop_desc, "object constructor");
4530	52		XopENTRY_set(&object_new_xop, xop_class, OA_BASEOP);
4531	52		Perl_custom_op_register(aTHX_ pp_object_new, &object_new_xop);
4532
4533	52		XopENTRY_set(&object_get_xop, xop_name, "object_get");
4534	52		XopENTRY_set(&object_get_xop, xop_desc, "object property get");
4535	52		XopENTRY_set(&object_get_xop, xop_class, OA_UNOP);
4536	52		Perl_custom_op_register(aTHX_ pp_object_get, &object_get_xop);
4537
4538	52		XopENTRY_set(&object_set_xop, xop_name, "object_set");
4539	52		XopENTRY_set(&object_set_xop, xop_desc, "object property set");
4540	52		XopENTRY_set(&object_set_xop, xop_class, OA_BINOP);
4541	52		Perl_custom_op_register(aTHX_ pp_object_set, &object_set_xop);
4542
4543	52		XopENTRY_set(&object_set_typed_xop, xop_name, "object_set_typed");
4544	52		XopENTRY_set(&object_set_typed_xop, xop_desc, "object property set with type check");
4545	52		XopENTRY_set(&object_set_typed_xop, xop_class, OA_BINOP);
4546	52		Perl_custom_op_register(aTHX_ pp_object_set_typed, &object_set_typed_xop);
4547
4548	52		XopENTRY_set(&object_func_get_xop, xop_name, "object_func_get");
4549	52		XopENTRY_set(&object_func_get_xop, xop_desc, "object function-style get");
4550	52		XopENTRY_set(&object_func_get_xop, xop_class, OA_UNOP);
4551	52		Perl_custom_op_register(aTHX_ pp_object_func_get, &object_func_get_xop);
4552
4553	52		XopENTRY_set(&object_func_set_xop, xop_name, "object_func_set");
4554	52		XopENTRY_set(&object_func_set_xop, xop_desc, "object function-style set");
4555	52		XopENTRY_set(&object_func_set_xop, xop_class, OA_BINOP);
4556	52		Perl_custom_op_register(aTHX_ pp_object_func_set, &object_func_set_xop);
4557
4558			/* Initialize registries */
4559	52		g_class_registry = newHV();
4560	52		g_type_registry = newHV();
4561
4562			/* Install XS functions */
4563	52		newXS("Object::Proto::import", xs_import, __FILE__);
4564	52		newXS("Object::Proto::define", xs_define, __FILE__);
4565	52		newXS("Object::Proto::import_accessors", xs_import_accessors, __FILE__);
4566	52		newXS("Object::Proto::import_accessor", xs_import_accessor, __FILE__);
4567	52		newXS("Object::Proto::prototype", xs_prototype, __FILE__);
4568	52		newXS("Object::Proto::set_prototype", xs_set_prototype, __FILE__);
4569	52		newXS("Object::Proto::prototype_chain", xs_prototype_chain, __FILE__);
4570	52		newXS("Object::Proto::has_own_property", xs_has_own_property, __FILE__);
4571	52		newXS("Object::Proto::prototype_depth", xs_prototype_depth, __FILE__);
4572	52		newXS("Object::Proto::lock", xs_lock, __FILE__);
4573	52		newXS("Object::Proto::unlock", xs_unlock, __FILE__);
4574	52		newXS("Object::Proto::freeze", xs_freeze, __FILE__);
4575	52		newXS("Object::Proto::is_frozen", xs_is_frozen, __FILE__);
4576	52		newXS("Object::Proto::is_locked", xs_is_locked, __FILE__);
4577
4578			/* Introspection API */
4579	52		newXS("Object::Proto::clone", xs_clone, __FILE__);
4580	52		newXS("Object::Proto::properties", xs_properties, __FILE__);
4581	52		newXS("Object::Proto::slot_info", xs_slot_info, __FILE__);
4582
4583			/* Inheritance API */
4584	52		newXS("Object::Proto::parent", xs_parent, __FILE__);
4585	52		newXS("Object::Proto::ancestors", xs_ancestors, __FILE__);
4586
4587			/* Type registry API */
4588	52		newXS("Object::Proto::register_type", xs_register_type, __FILE__);
4589	52		newXS("Object::Proto::has_type", xs_has_type, __FILE__);
4590	52		newXS("Object::Proto::list_types", xs_list_types, __FILE__);
4591
4592			/* Singleton support */
4593	52		newXS("Object::Proto::singleton", xs_singleton, __FILE__);
4594
4595			/* Role API */
4596	52		newXS("Object::Proto::role", xs_role, __FILE__);
4597	52		newXS("Object::Proto::requires", xs_requires, __FILE__);
4598	52		newXS("Object::Proto::with", xs_with, __FILE__);
4599	52		newXS("Object::Proto::does", xs_does, __FILE__);
4600
4601			/* Method modifier API */
4602	52		newXS("Object::Proto::before", xs_before, __FILE__);
4603	52		newXS("Object::Proto::after", xs_after, __FILE__);
4604	52		newXS("Object::Proto::around", xs_around, __FILE__);
4605
4606			/* Register cleanup for global destruction */
4607	52		Perl_call_atexit(aTHX_ object_cleanup_globals, NULL);
4608
4609	52		Perl_xs_boot_epilog(aTHX_ ax);
4610	52		}