├── .gitignore ├── LICENSE ├── README.md ├── easyxs.h ├── easyxs_debug.h ├── easyxs_numeric.h ├── easyxs_perlcall.h ├── easyxs_scalar.h ├── easyxs_string.h ├── easyxs_structref.h ├── init.h └── ppport.h /.gitignore: -------------------------------------------------------------------------------- 1 | .*.sw* 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022 Felipe Gasper 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # EasyXS 2 | 3 | This library is a toolbox that assists with creation & maintenance 4 | of [Perl XS](https://perldoc.perl.org/perlxs) code. 5 | 6 | # Usage 7 | 8 | 1. Make this repository a 9 | [git submodule](https://git-scm.com/book/en/v2/Git-Tools-Submodules) 10 | of your own XS module. 11 | 12 | 2. Replace the standard XS includes (`EXTERN.h`, `perl.h`, and `XSUB.h`) 13 | with just `#include "easyxs/easyxs.h"`. 14 | 15 | … and that’s it! You now have a suite of tools that’ll make writing XS 16 | easier and safer. 17 | 18 | # Rationale 19 | 20 | Perl’s C API makes lots of things _possible_ without making them 21 | _easy_ (or _safe_). 22 | 23 | This library attempts to provide shims around that API that make it easy 24 | and safe (or, at least, safe-_er_!) to write XS code … maybe even *fun!* :-) 25 | 26 | # Library Components 27 | 28 | ## Initialization 29 | 30 | `init.h` includes the standard boilerplate code you normally stick at the 31 | top of a `*.xs` file. It also includes a fix for the 32 | [torrent of warnings that clang 12 throws](https://github.com/Perl/perl5/issues/18780) 33 | in pre-5.36 perls. `easyxs.h` brings this in, but you can also 34 | `#include "easyxs/init.h"` on its own. 35 | 36 | `init.h` also includes a fairly up-to-date (as of this writing!) `ppport.h`. 37 | 38 | ## Calling Perl 39 | 40 | ### `void exs_call_sv_void(SV* callback, SV** args)` 41 | 42 | Like the Perl API’s `call_sv()` but simplifies argument-passing. 43 | `args` points to a NULL-terminated array of `SV*`s. 44 | (It may itself also be NULL.) 45 | 46 | The callback is called in void context, so nothing is returned. 47 | 48 | **IMPORTANT CAVEATS:** 49 | 50 | - This does _not_ trap exceptions. Ensure either that the callback won’t 51 | throw, or that no corruption will happen in the event of an exception. 52 | 53 | - This **mortalizes** each `args` member. That means Perl 54 | will reduce each of those SVs’ reference counts at some point “soon” after. 55 | This is often desirable, but not always; to counteract it, do `SvREFCNT_inc()` 56 | around whichever arguments you want to be unaffected by the mortalization. 57 | (They’ll still be mortalized, but the eventual reference-count reduction will 58 | just have zero net effect.) 59 | 60 | ### `SV* exs_call_sv_scalar(SV* callback, SV** args)` 61 | 62 | Like `exs_call_sv_void()` but calls the callback in scalar context. 63 | The result is returned. 64 | 65 | ### `SV* exs_call_sv_scalar_trapped(SV* callback, SV** args, SV** error_svp)` 66 | 67 | Like `exs_call_sv_scalar()` but traps exceptions. If one happens, 68 | NULL is returned, and `*error_svp` will contain the error SV. 69 | (This SV is a **copy** of Perl’s `$@` and so **must be freed**.) 70 | 71 | ### `void exs_call_sv_void_trapped(SV* callback, SV** args, SV** error_svp)` 72 | 73 | Like `exs_call_sv_scalar_trapped()` but calls the Perl callback in void 74 | context and doesn’t return anything. 75 | 76 | ### `void exs_call_method_void(SV* object, const char* methname, SV** args)` 77 | 78 | Like `exs_call_sv_void()` but for calling object methods. See 79 | the Perl API’s `call_method()` for more details. 80 | 81 | ### `SV* exs_call_method_scalar(SV* object, const char* methname, SV** args)` 82 | 83 | Like `exs_call_method_void()` but calls the method in scalar context. 84 | The result is returned. 85 | 86 | ### `SV** exs_call_sv_list(SV* callback, SV** args)` 87 | 88 | Like `exs_call_sv_scalar` but calls the callback in list context. 89 | 90 | The return is a pointer to a NUL-terminated array of `SV*`s. The pointer will 91 | be freed automatically, but the SVs are non-mortals with reference count 1, 92 | so you’ll need to dispose of those however is best for you. 93 | 94 | ### `SV** exs_call_sv_list_trapped(SV* callback, SV** args, SV** error_svp)` 95 | 96 | Like both `exs_call_sv_list` and `exs_call_sv_scalar_trapped`. If the 97 | callback throws, this behaves as `exs_call_sv_scalar_trapped` does; 98 | otherwise, this behaves as `exs_call_sv_list` does. 99 | 100 | ## SV “Typing” 101 | 102 | Perl scalars are supposed to be “untyped”, at least insofar as 103 | strings/numbers. When conversing with other languages, though, or 104 | serializing it’s usually helpful to break things down in greater 105 | detail. 106 | 107 | EasyXS defines an `exs_sv_type` macro that takes an SV as argument 108 | and returns a member of `enum exs_sv_type_e` (typedef’d as just 109 | `exs_sv_type_e`; see `easyxs_scalar.h` for values). The logic is compatible 110 | with the serialization logic formulated during Perl 5.36’s development cycle. 111 | 112 | ## SV/Number Conversion 113 | 114 | ### `UV* exs_SvUV(SV* sv)` 115 | 116 | Like `SvUV`, but if the SV’s content can’t be a UV 117 | (e.g., the IV is negative, or the string has non-numeric characters) 118 | an exception is thrown. 119 | 120 | ## SV/String Conversion 121 | 122 | ### `char* exs_SvPVbyte_nolen(SV* sv)` 123 | 124 | Like the Perl API’s `SvPVbyte_nolen`, but if there are any NULs in the 125 | string then an exception is thrown. 126 | 127 | ### `char* exs_SvPVutf8_nolen(SV* sv)` 128 | 129 | Like `exs_SvPVbyte_nolen()` but returns the code points as UTF-8 rather 130 | than Latin-1/bytes. 131 | 132 | ## Struct References 133 | 134 | It’s common in XS code to need to persist a C struct via a Perl variable, 135 | then free that struct once the Perl variable is garbage-collected. Perl’s 136 | `sv_setref_pv` and similar APIs present one way to do this: store a pointer 137 | to the struct in an SV, then pass around a blessed (Perl) reference to that 138 | SV, freeing the struct when the referent SV gets DESTROYed. 139 | 140 | EasyXS’s “struct references” are a slight simplification of this workflow: 141 | use the referent SV’s PV to store the struct itself. Thus, Perl cleans up 142 | the struct for you, and there’s no need for a DESTROY to free your struct. 143 | (You may, of course, still need a DESTROY to free blocks to which your 144 | struct refers.) 145 | 146 | ### `exs_new_structref(type, classname)` 147 | 148 | Creates a new structref for the given (C) `type` and (Perl) `classname`. 149 | 150 | ### `exs_structref_ptr(svrv)` 151 | 152 | Returns a pointer to `svrv`’s contained struct. 153 | 154 | ## Debugging 155 | 156 | ### `exs_debug_sv_summary(SV* sv)` 157 | 158 | Writes a visual representation of the SV’s contents to `Perl_debug_log`. 159 | **NO** trailing newline is written. 160 | 161 | ### `exs_debug_showstack(const char *pattern, ...)` 162 | 163 | Writes a visual representation of Perl’s argument stack 164 | to `Perl_debug_log`. 165 | 166 | # Usage Notes 167 | 168 | If you use GitHub Actions or similar, ensure that you grab the submodule 169 | as part of your workflow’s checkout. If you use GitHub’s own 170 | [checkout](https://github.com/actions/checkout) workflow, that’s: 171 | 172 | - with: 173 | submodules: true # (or `recursive`) 174 | 175 | Alternatively, run `git submodule init && git submodule update` 176 | during the workflow’s repository setup. 177 | 178 | # License & Copyright 179 | 180 | Copyright 2022 by Gasper Software Consulting. All rights reserved. 181 | 182 | This library is released under the terms of the 183 | [MIT License](https://mitlicense.org/). 184 | -------------------------------------------------------------------------------- /easyxs.h: -------------------------------------------------------------------------------- 1 | #ifndef EASYXS_H 2 | #define EASYXS_H 1 3 | 4 | #include "init.h" 5 | 6 | #define _EASYXS_CROAK_UNDEF(expected) \ 7 | croak("undef given; " expected " expected") 8 | 9 | #define _EASYXS_CROAK_STRINGIFY_REFERENCE(sv) \ 10 | croak("%" SVf " given where string expected!", sv) 11 | 12 | #include "easyxs_perlcall.h" 13 | #include "easyxs_numeric.h" 14 | #include "easyxs_scalar.h" 15 | #include "easyxs_string.h" 16 | #include "easyxs_structref.h" 17 | #include "easyxs_debug.h" 18 | 19 | #endif 20 | -------------------------------------------------------------------------------- /easyxs_debug.h: -------------------------------------------------------------------------------- 1 | #ifndef EASYXS_DEBUG_H 2 | #define EASYXS_DEBUG_H 1 3 | 4 | #include "init.h" 5 | 6 | /* The following is courtesy of Paul Evans: */ 7 | 8 | #define exs_debug_sv_summary(sv) S_debug_sv_summary(aTHX_ sv) 9 | 10 | /* ------------------------------------------------------------ */ 11 | 12 | static inline void S_debug_sv_summary(pTHX_ const SV *sv) 13 | { 14 | const char *type; 15 | 16 | if(!sv) { 17 | PerlIO_printf(Perl_debug_log, "NULL"); 18 | return; 19 | } 20 | 21 | if(sv == &PL_sv_undef) { 22 | PerlIO_printf(Perl_debug_log, "SV=undef"); 23 | return; 24 | } 25 | if(sv == &PL_sv_no) { 26 | PerlIO_printf(Perl_debug_log, "SV=false"); 27 | return; 28 | } 29 | if(sv == &PL_sv_yes) { 30 | PerlIO_printf(Perl_debug_log, "SV=true"); 31 | return; 32 | } 33 | 34 | switch(SvTYPE(sv)) { 35 | case SVt_NULL: type = "NULL"; break; 36 | case SVt_IV: type = "IV"; break; 37 | case SVt_NV: type = "NV"; break; 38 | case SVt_PV: type = "PV"; break; 39 | case SVt_PVIV: type = "PVIV"; break; 40 | case SVt_PVNV: type = "PVNV"; break; 41 | case SVt_PVGV: type = "PVGV"; break; 42 | case SVt_PVAV: type = "PVAV"; break; 43 | case SVt_PVHV: type = "PVHV"; break; 44 | case SVt_PVCV: type = "PVCV"; break; 45 | default: { 46 | char buf[16]; 47 | snprintf(buf, sizeof(buf), "(%d)", SvTYPE(sv)); 48 | type = buf; 49 | break; 50 | } 51 | } 52 | 53 | if(SvROK(sv)) 54 | type = "RV"; 55 | 56 | PerlIO_printf(Perl_debug_log, "SV{type=%s,refcnt=%" IVdf, type, (IV) SvREFCNT(sv)); 57 | 58 | if(SvTEMP(sv)) 59 | PerlIO_printf(Perl_debug_log, ",TEMP"); 60 | if(SvOBJECT(sv)) 61 | PerlIO_printf(Perl_debug_log, ",blessed=%s", HvNAME(SvSTASH(sv))); 62 | 63 | switch(SvTYPE(sv)) { 64 | case SVt_PVAV: 65 | PerlIO_printf(Perl_debug_log, ",FILL=%d", (int) AvFILL((AV *)sv)); 66 | break; 67 | 68 | default: 69 | /* regular scalars */ 70 | if(SvROK(sv)) 71 | PerlIO_printf(Perl_debug_log, ",ROK"); 72 | else { 73 | if(SvIOK(sv)) 74 | PerlIO_printf(Perl_debug_log, ",IV=%" IVdf, SvIVX(sv)); 75 | if(SvUOK(sv)) 76 | PerlIO_printf(Perl_debug_log, ",UV=%" UVuf, SvUVX(sv)); 77 | if(SvPOK(sv)) { 78 | PerlIO_printf(Perl_debug_log, ",PVX=\"%.10s\"", SvPVX((SV *)sv)); 79 | if(SvCUR(sv) > 10) 80 | PerlIO_printf(Perl_debug_log, "..."); 81 | } 82 | } 83 | break; 84 | } 85 | 86 | PerlIO_printf(Perl_debug_log, "}"); 87 | } 88 | 89 | #ifdef CX_CUR 90 | 91 | #define exs_debug_showstack(pattern, ...) S_debug_showstack(aTHX_ pattern, ##__VA_ARGS__) 92 | 93 | static inline void S_debug_showstack(pTHX_ const char *pattern, ...) 94 | { 95 | SV **sp; 96 | 97 | va_list ap; 98 | va_start(ap, pattern); 99 | 100 | if (!pattern) pattern = "Stack"; 101 | 102 | PerlIO_vprintf(Perl_debug_log, pattern, ap); 103 | PerlIO_printf(Perl_debug_log, "\n"); 104 | va_end(ap); 105 | 106 | PERL_CONTEXT *cx = CX_CUR(); 107 | 108 | I32 floor = cx->blk_oldsp; 109 | I32 *mark = PL_markstack + cx->blk_oldmarksp + 1; 110 | 111 | PerlIO_printf(Perl_debug_log, " TOPMARK=%d, floor = %d\n", (int) TOPMARK, (int) floor); 112 | PerlIO_printf(Perl_debug_log, " marks (TOPMARK=@%" IVdf "):\n", (IV) (TOPMARK - floor)); 113 | for(; mark <= PL_markstack_ptr; mark++) 114 | PerlIO_printf(Perl_debug_log, " @%" IVdf "\n", (IV) (*mark - floor)); 115 | 116 | mark = PL_markstack + cx->blk_oldmarksp + 1; 117 | for(sp = PL_stack_base + floor + 1; sp <= PL_stack_sp; sp++) { 118 | PerlIO_printf(Perl_debug_log, sp == PL_stack_sp ? "-> " : " "); 119 | PerlIO_printf(Perl_debug_log, "%p = ", *sp); 120 | S_debug_sv_summary(aTHX_ *sp); 121 | while(mark <= PL_markstack_ptr && PL_stack_base + *mark == sp) 122 | PerlIO_printf(Perl_debug_log, " [*M]"), mark++; 123 | PerlIO_printf(Perl_debug_log, "\n"); 124 | } 125 | } 126 | #endif 127 | 128 | /* 129 | void static inline exs_debug_showmark_stack(pTHX) { 130 | PerlIO_printf(Perl_debug_log, "MARK STACK (start=%p; cur=%p, offset=%d):\n", PL_markstack, PL_markstack_ptr, (int) (PL_markstack_ptr - PL_markstack)); 131 | I32 *mp = PL_markstack; 132 | while (mp != PL_markstack_max) { 133 | const char* pattern = (mp == PL_markstack_ptr ? "[%d]" : "%d"); 134 | PerlIO_printf(Perl_debug_log, pattern, *mp++); 135 | PerlIO_printf(Perl_debug_log, (mp == PL_markstack_max) ? "\n" : ","); 136 | } 137 | } 138 | */ 139 | 140 | #endif 141 | -------------------------------------------------------------------------------- /easyxs_numeric.h: -------------------------------------------------------------------------------- 1 | #ifndef EASYXS_NUMERIC_H 2 | #define EASYXS_NUMERIC_H 1 3 | 4 | #include "init.h" 5 | 6 | UV _easyxs_SvUV (pTHX_ SV* sv) { 7 | if (!SvOK(sv)) _EASYXS_CROAK_UNDEF("unsigned integer"); 8 | 9 | if (SvROK(sv)) _EASYXS_CROAK_STRINGIFY_REFERENCE(sv); 10 | 11 | if (SvUOK(sv)) return SvUV(sv); 12 | 13 | if (SvIOK(sv)) { 14 | IV myiv = SvIV(sv); 15 | 16 | if (myiv >= 0) return myiv; 17 | } 18 | else { 19 | STRLEN pvlen; 20 | const char* pv = SvPVbyte(sv, pvlen); 21 | 22 | UV myuv; 23 | int grokked = grok_number(pv, pvlen, &myuv); 24 | 25 | if (grokked & (IS_NUMBER_IN_UV | !IS_NUMBER_NEG)) { 26 | const char* uvstr = form("%" UVuf, myuv); 27 | 28 | if (strlen(uvstr) == pvlen && strEQ(uvstr, pv)) return myuv; 29 | } 30 | } 31 | 32 | croak("`%" SVf "` given where unsigned integer expected!", sv); 33 | } 34 | 35 | #define exs_SvUV(sv) _easyxs_SvUV(aTHX_ sv) 36 | 37 | UV _easyxs_SvIV (pTHX_ SV* sv) { 38 | if (!SvOK(sv)) _EASYXS_CROAK_UNDEF("integer"); 39 | 40 | if (SvROK(sv)) _EASYXS_CROAK_STRINGIFY_REFERENCE(sv); 41 | 42 | if (SvIOK(sv)) return SvIV(sv); 43 | 44 | STRLEN pvlen; 45 | const char* pv = SvPVbyte(sv, pvlen); 46 | 47 | IV myiv; 48 | int grokked = grok_number(pv, pvlen, (UV*) &myiv); 49 | 50 | if (!(grokked & IS_NUMBER_NOT_INT) && !(grokked & IS_NUMBER_IN_UV)) { 51 | const char* ivstr = form("%" IVdf, myiv); 52 | 53 | if (strlen(ivstr) == pvlen && strEQ(ivstr, pv)) return myiv; 54 | } 55 | 56 | croak("`%" SVf "` given where integer expected!", sv); 57 | } 58 | 59 | #define exs_SvIV(sv) _easyxs_SvIV(aTHX_ sv) 60 | 61 | #endif 62 | -------------------------------------------------------------------------------- /easyxs_perlcall.h: -------------------------------------------------------------------------------- 1 | #ifndef EASYXS_PERLCALL_H 2 | #define EASYXS_PERLCALL_H 1 3 | 4 | #include "init.h" 5 | 6 | static inline void _EASYXS_SET_ARGS (pTHX_ SV* object, SV** args) { 7 | dSP; 8 | 9 | unsigned argscount = 0; 10 | 11 | if (args) { 12 | while (args[argscount] != NULL) argscount++; 13 | } 14 | 15 | ENTER; 16 | SAVETMPS; 17 | 18 | PUSHMARK(SP); 19 | 20 | if (object || argscount) { 21 | EXTEND(SP, (object ? 1 : 0) + argscount); 22 | 23 | if (object) PUSHs( sv_mortalcopy(object) ); 24 | 25 | unsigned a=0; 26 | while (a < argscount) mPUSHs( args[a++] ); 27 | 28 | PUTBACK; 29 | } 30 | } 31 | 32 | #define exs_call_sv_void(sv, args) STMT_START { \ 33 | _EASYXS_SET_ARGS(aTHX_ NULL, args); \ 34 | call_sv(sv, G_DISCARD | G_VOID); \ 35 | FREETMPS; \ 36 | LEAVE; \ 37 | } STMT_END 38 | 39 | #define exs_call_method_void(object, methname, args) STMT_START { \ 40 | _EASYXS_SET_ARGS(aTHX_ object, args); \ 41 | \ 42 | call_method( methname, G_DISCARD | G_VOID ); \ 43 | \ 44 | FREETMPS; \ 45 | LEAVE; \ 46 | } STMT_END 47 | 48 | static inline SV* _easyxs_fetch_scalar_return (pTHX_ int count) { 49 | dSP; 50 | 51 | SPAGAIN; 52 | 53 | SV* ret; 54 | 55 | if (count == 0) { 56 | ret = &PL_sv_undef; 57 | } 58 | else { 59 | ret = SvREFCNT_inc(POPs); 60 | 61 | while (count-- > 1) PERL_UNUSED_VAR(POPs); 62 | } 63 | 64 | PUTBACK; 65 | FREETMPS; 66 | LEAVE; 67 | 68 | return ret; 69 | } 70 | 71 | static inline SV** _easyxs_fetch_list_return (pTHX_ int count) { 72 | dSP; 73 | 74 | SPAGAIN; 75 | 76 | SV** ret; 77 | 78 | Newx(ret, 1 + count, SV*); 79 | ret[count] = NULL; 80 | 81 | while (count-- > 0) { 82 | ret[count] = SvREFCNT_inc(POPs); 83 | } 84 | 85 | PUTBACK; 86 | FREETMPS; 87 | LEAVE; 88 | 89 | SAVEFREEPV(ret); 90 | 91 | return ret; 92 | } 93 | 94 | static inline SV* _easyxs_call_method_scalar (pTHX_ SV* object, const char* methname, SV** args) { 95 | _EASYXS_SET_ARGS(aTHX_ object, args); 96 | 97 | int count = call_method(methname, G_SCALAR); 98 | 99 | return _easyxs_fetch_scalar_return(aTHX_ count); 100 | } 101 | 102 | #define exs_call_method_scalar(object, methname, args) \ 103 | _easyxs_call_method_scalar(aTHX_ object, methname, args) 104 | 105 | static inline SV* _easyxs_call_sv_scalar (pTHX_ SV* cb, SV** args) { 106 | _EASYXS_SET_ARGS(aTHX_ NULL, args); 107 | 108 | int count = call_sv(cb, G_SCALAR); 109 | 110 | return _easyxs_fetch_scalar_return(aTHX_ count); 111 | } 112 | 113 | #define exs_call_sv_scalar(sv, args) \ 114 | _easyxs_call_sv_scalar(aTHX_ sv, args) 115 | 116 | static inline SV** _easyxs_call_sv_list (pTHX_ SV* cb, SV** args) { 117 | _EASYXS_SET_ARGS(aTHX_ NULL, args); 118 | 119 | int count = call_sv(cb, G_ARRAY); 120 | 121 | return _easyxs_fetch_list_return(aTHX_ count); 122 | } 123 | 124 | #define exs_call_sv_list(sv, args) \ 125 | _easyxs_call_sv_list(aTHX_ sv, args) 126 | 127 | #define _handle_trapped_error(count, err_p) STMT_START { \ 128 | dSP; \ 129 | SV* err_tmp = ERRSV; \ 130 | if (SvTRUE(err_tmp)) { \ 131 | while (count--) PERL_UNUSED_VAR(POPs); \ 132 | \ 133 | *err_p = newSVsv(err_tmp); \ 134 | \ 135 | PUTBACK; \ 136 | FREETMPS; \ 137 | LEAVE; \ 138 | } \ 139 | } STMT_END 140 | 141 | static inline void _easyxs_call_sv_void_trapped (pTHX_ SV* cb, SV** args, SV** error) { 142 | _EASYXS_SET_ARGS(aTHX_ NULL, args); 143 | 144 | int count = call_sv(cb, G_VOID | G_EVAL); 145 | 146 | _handle_trapped_error(count, error); 147 | } 148 | 149 | #define exs_call_sv_void_trapped(sv, args, err_p) \ 150 | _easyxs_call_sv_void_trapped(aTHX_ sv, args, err_p) 151 | 152 | static inline SV* _easyxs_call_sv_scalar_trapped (pTHX_ SV* cb, SV** args, SV** error) { 153 | _EASYXS_SET_ARGS(aTHX_ NULL, args); 154 | 155 | int count = call_sv(cb, G_SCALAR | G_EVAL); 156 | 157 | _handle_trapped_error(count, error); 158 | 159 | if (SvTRUE(ERRSV)) return NULL; 160 | 161 | return _easyxs_fetch_scalar_return(aTHX_ count); 162 | } 163 | 164 | #define exs_call_sv_scalar_trapped(sv, args, err_p) \ 165 | _easyxs_call_sv_scalar_trapped(aTHX_ sv, args, err_p) 166 | 167 | static inline SV** _easyxs_call_sv_list_trapped (pTHX_ SV* cb, SV** args, SV** error) { 168 | _EASYXS_SET_ARGS(aTHX_ NULL, args); 169 | 170 | int count = call_sv(cb, G_ARRAY | G_EVAL); 171 | 172 | _handle_trapped_error(count, error); 173 | 174 | if (SvTRUE(ERRSV)) return NULL; 175 | 176 | return _easyxs_fetch_list_return(aTHX_ count); 177 | } 178 | 179 | #define exs_call_sv_list_trapped(sv, args, err_p) \ 180 | _easyxs_call_sv_list_trapped(aTHX_ sv, args, err_p) 181 | 182 | #endif 183 | -------------------------------------------------------------------------------- /easyxs_scalar.h: -------------------------------------------------------------------------------- 1 | #ifndef EASYXS_SCALAR_H 2 | #define EASYXS_SCALAR_H 1 3 | 4 | #include "init.h" 5 | 6 | /* EXPERIMENTAL! */ 7 | 8 | enum exs_sv_type_e { 9 | EXS_SVTYPE_UNKNOWN, 10 | EXS_SVTYPE_UNDEF, 11 | EXS_SVTYPE_REFERENCE, 12 | EXS_SVTYPE_BOOLEAN, 13 | EXS_SVTYPE_STRING, 14 | EXS_SVTYPE_UV, 15 | EXS_SVTYPE_IV, 16 | EXS_SVTYPE_NV, 17 | }; 18 | 19 | typedef enum exs_sv_type_e exs_sv_type_e; 20 | 21 | #ifndef SvIsBOOL 22 | #define SvIsBOOL(sv) FALSE 23 | #endif 24 | 25 | #define exs_sv_type(sv) ( \ 26 | !SvOK(sv) ? EXS_SVTYPE_UNDEF \ 27 | : SvROK(sv) ? EXS_SVTYPE_REFERENCE \ 28 | : SvIsBOOL(sv) ? EXS_SVTYPE_BOOLEAN \ 29 | : SvPOK(sv) ? EXS_SVTYPE_STRING \ 30 | : SvUOK(sv) ? EXS_SVTYPE_UV \ 31 | : SvIOK(sv) ? EXS_SVTYPE_IV \ 32 | : SvNOK(sv) ? EXS_SVTYPE_NV \ 33 | : EXS_SVTYPE_UNKNOWN \ 34 | ) 35 | 36 | #endif 37 | -------------------------------------------------------------------------------- /easyxs_string.h: -------------------------------------------------------------------------------- 1 | #ifndef EASYXS_STRING_H 2 | #define EASYXS_STRING_H 1 3 | 4 | #include "init.h" 5 | 6 | static inline char* _easyxs_sv_to_str (pTHX_ SV* sv, U8 is_utf8) { 7 | if (SvROK(sv)) _EASYXS_CROAK_STRINGIFY_REFERENCE(sv); 8 | 9 | char *str = is_utf8 ? SvPVutf8_nolen(sv) : SvPVbyte_nolen(sv); 10 | 11 | size_t len = strlen(str); 12 | if (len != SvCUR(sv)) { 13 | croak("Cannot convert scalar to C string (NUL byte detected, offset %" UVf ")", (UV) len); 14 | } 15 | 16 | return str; 17 | } 18 | 19 | /* ---------------------------------------------------------------------- */ 20 | 21 | #define exs_SvPVbyte_nolen(sv) _easyxs_sv_to_str(aTHX_ sv, 0) 22 | #define exs_SvPVutf8_nolen(sv) _easyxs_sv_to_str(aTHX_ sv, 1) 23 | 24 | #endif 25 | -------------------------------------------------------------------------------- /easyxs_structref.h: -------------------------------------------------------------------------------- 1 | #ifndef EASYXS_STRUCTREF_H 2 | #define EASYXS_STRUCTREF_H 1 3 | 4 | #include "init.h" 5 | 6 | #define exs_new_structref(type, classname) _exs_new_structref_f(aTHX_ sizeof(type), classname) 7 | 8 | #define exs_structref_ptr(svrv) ( (void *) SvPVX( SvRV(svrv) ) ) 9 | 10 | static inline SV* _exs_new_structref_f (pTHX_ unsigned size, const char* classname) { 11 | 12 | SV* referent = newSV(size); 13 | SvPOK_on(referent); 14 | 15 | SV* reference = newRV_noinc(referent); 16 | sv_bless(reference, gv_stashpv(classname, FALSE)); 17 | 18 | return reference; 19 | } 20 | 21 | #endif 22 | -------------------------------------------------------------------------------- /init.h: -------------------------------------------------------------------------------- 1 | #ifndef EASYXS_INIT 2 | #define EASYXS_INIT 1 3 | 4 | #ifdef __cplusplus 5 | extern "C" { 6 | #endif 7 | 8 | #define PERL_NO_GET_CONTEXT 9 | #include "EXTERN.h" 10 | 11 | /* Implement perl5 7169efc77525df for older perls (part 1): */ 12 | #define STMT_START do 13 | #define STMT_END while (0) 14 | 15 | #include "perl.h" 16 | #include "XSUB.h" 17 | 18 | #include "ppport.h" 19 | 20 | #ifdef __cplusplus 21 | } 22 | #endif 23 | 24 | /* Implement perl5 7169efc77525df for older perls (part 2): */ 25 | #undef STMT_START 26 | #undef STMT_END 27 | #define STMT_START do 28 | #define STMT_END while (0) 29 | 30 | #endif 31 | --------------------------------------------------------------------------------