X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a12c3db7a22851458ab65429b1888bb9c4112382..9b5c3821be1f2a9a84772171c8bbadbf9cfc4a53:/XSUB.h diff --git a/XSUB.h b/XSUB.h index af91137..c74d6f6 100644 --- a/XSUB.h +++ b/XSUB.h @@ -67,6 +67,14 @@ This is usually handled automatically by C. Sets up the C variable for an XSUB which has aliases. This is usually handled automatically by C. +=for apidoc Ams||dUNDERBAR +Sets up the C variable for an XSUB that wishes to use +C. + +=for apidoc AmU||UNDERBAR +The SV* corresponding to the $_ variable. Works even if there +is a lexical $_ in scope. + =cut */ @@ -106,6 +114,11 @@ handled automatically by C. #define XSINTERFACE_FUNC_SET(cv,f) \ CvXSUBANY(cv).any_dxptr = (void (*) (pTHX_ void*))(f) +#define dUNDERBAR I32 padoff_du = find_rundefsvoffset() +#define UNDERBAR ((padoff_du == NOT_IN_PAD \ + || PAD_COMPNAME_FLAGS(padoff_du) & SVpad_OUR) \ + ? DEFSV : PAD_SVl(padoff_du)) + /* Simple macros to put new mortal values onto the stack. */ /* Typically used to return values from XS functions. */ @@ -143,6 +156,9 @@ handled by C. =for apidoc Am|void|XSRETURN_IV|IV iv Return an integer from an XSUB immediately. Uses C. +=for apidoc Am|void|XSRETURN_UV|IV uv +Return an integer from an XSUB immediately. Uses C. + =for apidoc Am|void|XSRETURN_NV|NV nv Return a double from an XSUB immediately. Uses C. @@ -163,7 +179,7 @@ Return an empty list from an XSUB immediately. =head1 Variables created by C and C internal functions -=for apidoc AmU||newXSproto +=for apidoc AmU||newXSproto|char* name|XSUBADDR_t f|char* filename|const char *proto Used by C to hook up XSUBs as Perl subs. Adds Perl prototypes to the subs. @@ -176,10 +192,29 @@ Macro to verify that a PM module's $VERSION variable matches the XS module's C variable. This is usually handled automatically by C. See L. +=head1 Simple Exception Handling Macros + +=for apidoc Ams||dXCPT +Set up neccessary local variables for exception handling. +See L. + +=for apidoc AmU||XCPT_TRY_START +Starts a try block. See L. + +=for apidoc AmU||XCPT_TRY_END +Ends a try block. See L. + +=for apidoc AmU||XCPT_CATCH +Introduces a catch block. See L. + +=for apidoc Ams||XCPT_RETHROW +Rethrows a previously caught exception. See L. + =cut */ #define XST_mIV(i,v) (ST(i) = sv_2mortal(newSViv(v)) ) +#define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) #define XST_mNV(i,v) (ST(i) = sv_2mortal(newSVnv(v)) ) #define XST_mPV(i,v) (ST(i) = sv_2mortal(newSVpv(v,0))) #define XST_mPVN(i,v,n) (ST(i) = sv_2mortal(newSVpvn(v,n))) @@ -189,11 +224,13 @@ C. See L. #define XSRETURN(off) \ STMT_START { \ - PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ + IV tmpXSoff = (off); \ + PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); \ return; \ } STMT_END #define XSRETURN_IV(v) STMT_START { XST_mIV(0,v); XSRETURN(1); } STMT_END +#define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END #define XSRETURN_NV(v) STMT_START { XST_mNV(0,v); XSRETURN(1); } STMT_END #define XSRETURN_PV(v) STMT_START { XST_mPV(0,v); XSRETURN(1); } STMT_END #define XSRETURN_PVN(v,n) STMT_START { XST_mPVN(0,v,n); XSRETURN(1); } STMT_END @@ -207,28 +244,42 @@ C. See L. #ifdef XS_VERSION # define XS_VERSION_BOOTCHECK \ STMT_START { \ - SV *tmpsv; STRLEN n_a; \ + SV *_sv; STRLEN n_a; \ char *vn = Nullch, *module = SvPV(ST(0),n_a); \ if (items >= 2) /* version supplied as bootstrap arg */ \ - tmpsv = ST(1); \ + _sv = ST(1); \ else { \ /* XXX GV_ADDWARN */ \ - tmpsv = get_sv(Perl_form(aTHX_ "%s::%s", module, \ + _sv = get_sv(Perl_form(aTHX_ "%s::%s", module, \ vn = "XS_VERSION"), FALSE); \ - if (!tmpsv || !SvOK(tmpsv)) \ - tmpsv = get_sv(Perl_form(aTHX_ "%s::%s", module, \ + if (!_sv || !SvOK(_sv)) \ + _sv = get_sv(Perl_form(aTHX_ "%s::%s", module, \ vn = "VERSION"), FALSE); \ } \ - if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, n_a)))) \ - Perl_croak(aTHX_ "%s object version %s does not match %s%s%s%s %"SVf,\ - module, XS_VERSION, \ - vn ? "$" : "", vn ? module : "", vn ? "::" : "", \ - vn ? vn : "bootstrap parameter", tmpsv); \ + if (_sv) { \ + SV *xssv = Perl_newSVpvf(aTHX_ "%s",XS_VERSION); \ + xssv = new_version(xssv); \ + if ( !sv_derived_from(_sv, "version") ) \ + _sv = new_version(_sv); \ + if ( vcmp(_sv,xssv) ) \ + Perl_croak(aTHX_ "%s object version %"SVf" does not match %s%s%s%s %"SVf,\ + module, vstringify(xssv), \ + vn ? "$" : "", vn ? module : "", vn ? "::" : "", \ + vn ? vn : "bootstrap parameter", vstringify(_sv));\ + } \ } STMT_END #else # define XS_VERSION_BOOTCHECK #endif +#ifdef NO_XSLOCKS +# define dXCPT dJMPENV; int rEtV = 0 +# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0) +# define XCPT_TRY_END JMPENV_POP; +# define XCPT_CATCH if (rEtV != 0) +# define XCPT_RETHROW JMPENV_JUMP(rEtV) +#endif + /* The DBM_setFilter & DBM_ckFilter macros are only used by the *DB*_File modules @@ -261,6 +312,8 @@ C. See L. SAVEINT(db->filtering) ; \ db->filtering = TRUE ; \ SAVESPTR(DEFSV) ; \ + if (name[7] == 's') \ + arg = newSVsv(arg); \ DEFSV = arg ; \ SvTEMP_off(arg) ; \ PUSHMARK(SP) ; \ @@ -270,6 +323,10 @@ C. See L. PUTBACK ; \ FREETMPS ; \ LEAVE ; \ + if (name[7] == 's'){ \ + arg = sv_2mortal(arg); \ + } \ + SvOKp(arg); \ } #if 1 /* for compatibility */