X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=XSUB.h;h=cd8a732be0cd6676afe14fb9e623f0378630c1b1;hb=dcb4812c733545a68ef39b77c2dc4f7d440de203;hp=8cb3b86a1109f1dc3ea112f0cf9451529de68774;hpb=5dc0d6134ebb76636f69238201dde15cec972fd0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/XSUB.h b/XSUB.h index 8cb3b86..cd8a732 100644 --- a/XSUB.h +++ b/XSUB.h @@ -1,13 +1,17 @@ #define ST(off) stack_base[ax + (off)] #ifdef CAN_PROTOTYPE +#ifdef PERL_OBJECT +#define XS(name) void name(CV* cv, CPerlObj* pPerl) +#else #define XS(name) void name(CV* cv) +#endif #else #define XS(name) void name(cv) CV* cv; #endif #define dXSARGS \ - dTHR; dSP; dMARK; \ + dSP; dMARK; \ I32 ax = mark - stack_base + 1; \ I32 items = sp - mark @@ -15,7 +19,21 @@ #define dXSI32 I32 ix = XSANY.any_i32 -#define XSRETURN(off) stack_sp = stack_base + ax + ((off) - 1); return +#ifdef __cplusplus +# define XSINTERFACE_CVT(ret,name) ret (*name)(...) +#else +# define XSINTERFACE_CVT(ret,name) ret (*name)() +#endif +#define dXSFUNCTION(ret) XSINTERFACE_CVT(ret,XSFUNCTION) +#define XSINTERFACE_FUNC(ret,cv,f) ((XSINTERFACE_CVT(ret,))(f)) +#define XSINTERFACE_FUNC_SET(cv,f) \ + CvXSUBANY(cv).any_dptr = (void (*) _((void*)))(f) + +#define XSRETURN(off) \ + STMT_START { \ + stack_sp = stack_base + ax + ((off) - 1); \ + return; \ + } STMT_END /* Simple macros to put new mortal values onto the stack. */ /* Typically used to return values from XS functions. */ @@ -39,19 +57,36 @@ #ifdef XS_VERSION # define XS_VERSION_BOOTCHECK \ STMT_START { \ - char *vn = "", *module = SvPV(ST(0),na); \ + char *vn = Nullch, *module = SvPV(ST(0),na); \ if (items >= 2) /* version supplied as bootstrap arg */ \ Sv = ST(1); \ else { \ /* XXX GV_ADDWARN */ \ - Sv = perl_get_sv(vn = form("%s::XS_VERSION", module), FALSE); \ + Sv = perl_get_sv(form("%s::%s", module, \ + vn = "XS_VERSION"), FALSE); \ if (!Sv || !SvOK(Sv)) \ - Sv = perl_get_sv(vn = form("%s::VERSION", module), FALSE); \ + Sv = perl_get_sv(form("%s::%s", module, \ + vn = "VERSION"), FALSE); \ } \ if (Sv && (!SvOK(Sv) || strNE(XS_VERSION, SvPV(Sv, na)))) \ - croak("%s object version %s does not match $%s %_", \ - module, XS_VERSION, vn, Sv); \ + croak("%s object version %s does not match %s%s%s%s %_", \ + module, XS_VERSION, \ + vn ? "$" : "", vn ? module : "", vn ? "::" : "", \ + vn ? vn : "bootstrap parameter", Sv); \ } STMT_END #else # define XS_VERSION_BOOTCHECK #endif + +#ifdef PERL_OBJECT +#include "ObjXSub.h" +#ifndef NO_XSLOCKS +#ifdef WIN32 +#include "XSLock.h" +#endif /* WIN32 */ +#endif /* NO_XSLOCKS */ +#else +#ifdef PERL_CAPI +#include "PerlCAPI.h" +#endif +#endif /* PERL_OBJECT */