X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=universal.c;h=ef4f5b306676e6156b589c04b2805b451321c600;hb=87c2f9c4716d6ca80eef0a77058013da1536e87d;hp=d6689f8acf979e4ac81e59ecc4e9880709af4e70;hpb=e09f3e01ccd721309f0eb0aae224d84db2e8436a;p=p5sagit%2Fp5-mst-13.2.git diff --git a/universal.c b/universal.c index d6689f8..ef4f5b3 100644 --- a/universal.c +++ b/universal.c @@ -1,18 +1,13 @@ #include "EXTERN.h" #include "perl.h" -#include "XSUB.h" /* * Contributed by Graham Barr * The main guts of traverse_isa was actually copied from gv_fetchmeth */ -static SV * -isa_lookup(stash, name, len, level) -HV *stash; -char *name; -int len; -int level; +STATIC SV * +isa_lookup(HV *stash, char *name, int len, int level) { AV* av; GV* gv; @@ -26,7 +21,7 @@ int level; return &sv_yes; if (level > 100) - croak("Recursive inheritance detected"); + croak("Recursive inheritance detected in package '%s'", HvNAME(stash)); gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE); @@ -52,7 +47,8 @@ int level; } if(hv) { SV** svp = AvARRAY(av); - I32 items = AvFILL(av) + 1; + /* NOTE: No support for tied ISA */ + I32 items = AvFILLp(av) + 1; while (items--) { SV* sv = *svp++; HV* basestash = gv_stashsv(sv, FALSE); @@ -75,9 +71,7 @@ int level; } bool -sv_derived_from(sv, name) -SV * sv ; -char * name ; +sv_derived_from(SV *sv, char *name) { SV *rv; char *type; @@ -106,6 +100,11 @@ char * name ; } +#ifdef PERL_OBJECT +#define NO_XSLOCKS +#endif /* PERL_OBJECT */ + +#include "XSUB.h" static XS(XS_UNIVERSAL_isa) @@ -202,8 +201,14 @@ XS(XS_UNIVERSAL_VERSION) XSRETURN(1); } +#ifdef PERL_OBJECT +#undef boot_core_UNIVERSAL +#define boot_core_UNIVERSAL CPerlObj::Perl_boot_core_UNIVERSAL +#define pPerl this +#endif + void -boot_core_UNIVERSAL() +boot_core_UNIVERSAL(void) { char *file = __FILE__;