File Coverage

/usr/local/lib/perl5/site_perl/5.26.1/x86_64-linux/Panda/XS.x/i/xs/xs.h
Criterion Covered Total %
statement 23 32 71.8
branch 6 14 42.8
condition n/a
subroutine n/a
pod n/a
total 29 46 63.0


line stmt bran cond sub pod time code
1             #pragma once
2             #define NO_XSLOCKS // dont hook libc calls
3             #define PERLIO_NOT_STDIO 0 // dont hook IO
4             #define PERL_NO_GET_CONTEXT // we want efficiency for threaded perls
5             extern "C" {
6             # include "EXTERN.h"
7             # include "perl.h"
8             # include "XSUB.h"
9             # undef do_open
10             # undef do_close
11             }
12             #include "ppport.h"
13              
14             #include // safe c++11 compilation
15             #include
16             #include
17             #include
18             #include
19             #include
20              
21             typedef SV OSV;
22             typedef HV OHV;
23             typedef AV OAV;
24             typedef IO OIO;
25              
26             #ifndef hv_storehek
27             # define hv_storehek(hv, hek, val) \
28             hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, (val), HEK_HASH(hek))
29             # define hv_fetchhek(hv, hek, lval) \
30             ((SV**)hv_common( \
31             (hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), (lval) ? (HV_FETCH_JUST_SV|HV_FETCH_LVALUE) : HV_FETCH_JUST_SV, NULL, HEK_HASH(hek) \
32             ))
33             # define hv_deletehek(hv, hek, flags) \
34             hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), (flags)|HV_DELETE, NULL, HEK_HASH(hek))
35             #endif
36              
37             #define PXS_TRY(code) { \
38             try { code; } \
39             catch (const std::exception& err) { croak_sv(xs::error_sv(err)); } \
40             catch (const char* err) { croak_sv(newSVpv(err, 0)); } \
41             catch (const std::string& err) { croak_sv(newSVpvn(err.data(), err.length())); } \
42             catch (const panda::string& err) { croak_sv(newSVpvn(err.data(), err.length())); } \
43             catch (...) { croak_sv(newSVpvs("unknown c++ exception thrown")); } \
44             }
45              
46             #define XS_HV_ITER(hv,code) { \
47             STRLEN hvmax = HvMAX(hv); \
48             HE** hvarr = HvARRAY(hv); \
49             if (HvUSEDKEYS(hv)) \
50             for (STRLEN bucket_num = 0; bucket_num <= hvmax; ++bucket_num) \
51             for (const HE* he = hvarr[bucket_num]; he; he = HeNEXT(he)) { code } \
52             }
53             #define XS_HV_ITER_NU(hv,code) XS_HV_ITER(hv,{if(!SvOK(HeVAL(he))) continue; code})
54              
55             #define XS_AV_ITER(av,code) { \
56             SV** list = AvARRAY(av); \
57             SSize_t fillp = AvFILLp(av); \
58             for (SSize_t i = 0; i <= fillp; ++i) { SV* elem = *list++; code } \
59             }
60             #define XS_AV_ITER_NE(av,code) XS_AV_ITER(av,{if(!elem) continue; code})
61             #define XS_AV_ITER_NU(av,code) XS_AV_ITER(av,{if(!elem || !SvOK(elem)) continue; code})
62              
63             // Threaded-perl helpers
64              
65             #ifdef PERL_IMPLICIT_CONTEXT // define class member helpers for storing perl interpreter
66             # define mTHX pTHX;
67             # define mTHXa(a) aTHX(a),
68             #else
69             # define mTHX
70             # define mTHXa(a)
71             #endif
72              
73             namespace xs {
74              
75             enum next_t {
76             NEXT_SUPER = 0,
77             NEXT_METHOD = 1,
78             NEXT_MAYBE = 2
79             };
80              
81             struct my_perl_auto_t { // per-thread interpreter to help dealing with pTHX/aTHX, especially for static initialization
82             #ifdef PERL_IMPLICIT_CONTEXT
83             operator PerlInterpreter* () const { return PERL_GET_THX; }
84             PerlInterpreter* operator-> () const { return PERL_GET_THX; }
85             #endif
86             };
87             extern my_perl_auto_t my_perl;
88              
89             typedef int (*on_svdup_t) (pTHX_ MAGIC* mg, CLONE_PARAMS* param);
90              
91             typedef MGVTBL payload_marker_t;
92             extern payload_marker_t sv_payload_default_marker;
93             payload_marker_t* sv_payload_marker (const char* class_name, on_svdup_t svdup_callback = NULL);
94              
95             template
96             struct SVPayloadMarker {
97             static payload_marker_t marker;
98             static payload_marker_t* get (on_svdup_t dup_callback = NULL) {
99             if (dup_callback) marker.svt_dup = dup_callback;
100             return ▮
101             }
102             };
103             template payload_marker_t SVPayloadMarker::marker;
104              
105             inline void sv_payload_attach (pTHX_ SV* sv, void* ptr, const payload_marker_t* marker = &sv_payload_default_marker) {
106             MAGIC* mg = sv_magicext(sv, NULL, PERL_MAGIC_ext, marker ? marker : &sv_payload_default_marker, (const char*) ptr, 0);
107             if (marker->svt_dup) mg->mg_flags |= MGf_DUP;
108             SvRMAGICAL_off(sv); // remove unnecessary perfomance overheat
109             }
110              
111             inline void sv_payload_attach (pTHX_ SV* sv, void* ptr, SV* obj, const payload_marker_t* marker = &sv_payload_default_marker) {
112             MAGIC* mg = sv_magicext(sv, obj, PERL_MAGIC_ext, marker ? marker : &sv_payload_default_marker, (const char*) ptr, 0);
113             mg->mg_flags |= MGf_REFCOUNTED;
114             if (marker->svt_dup) mg->mg_flags |= MGf_DUP;
115             SvRMAGICAL_off(sv); // remove unnecessary perfomance overheat
116             }
117              
118             inline void sv_payload_attach (pTHX_ SV* sv, SV* obj, const payload_marker_t* marker = &sv_payload_default_marker) {
119             sv_payload_attach(aTHX_ sv, NULL, obj, marker);
120             }
121              
122             inline bool sv_payload_exists (pTHX_ const SV* sv, const payload_marker_t* marker) {
123             if (SvTYPE(sv) < SVt_PVMG) return false;
124             return mg_findext(sv, PERL_MAGIC_ext, marker ? marker : &sv_payload_default_marker) != NULL;
125             }
126              
127 13           inline void* sv_payload (pTHX_ const SV* sv, const payload_marker_t* marker) {
128 13 50         if (SvTYPE(sv) < SVt_PVMG) return NULL;
129 13 50         MAGIC* mg = mg_findext(sv, PERL_MAGIC_ext, marker ? marker : &sv_payload_default_marker);
130 13 50         return mg ? mg->mg_ptr : NULL;
131             }
132              
133             inline SV* sv_payload_sv (pTHX_ const SV* sv, const payload_marker_t* marker) {
134             if (SvTYPE(sv) < SVt_PVMG) return NULL;
135             MAGIC* mg = mg_findext(sv, PERL_MAGIC_ext, marker ? marker : &sv_payload_default_marker);
136             return mg ? mg->mg_obj : NULL;
137             }
138              
139             inline int sv_payload_detach (pTHX_ SV* sv, payload_marker_t* marker) {
140             if (SvTYPE(sv) < SVt_PVMG) return 0;
141             return sv_unmagicext(sv, PERL_MAGIC_ext, marker ? marker : &sv_payload_default_marker);
142             }
143              
144             inline void rv_payload_attach (pTHX_ SV* rv, void* ptr, const payload_marker_t* marker = NULL) {
145             sv_payload_attach(aTHX_ SvRV(rv), ptr, marker);
146             }
147              
148             inline void rv_payload_attach (pTHX_ SV* rv, void* ptr, SV* obj, const payload_marker_t* marker = NULL) {
149             sv_payload_attach(aTHX_ SvRV(rv), ptr, obj, marker);
150             }
151              
152             inline void rv_payload_attach (pTHX_ SV* rv, SV* obj, const payload_marker_t* marker = NULL) {
153             sv_payload_attach(aTHX_ SvRV(rv), obj, marker);
154             }
155              
156             inline bool rv_payload_exists (pTHX_ SV* rv, const payload_marker_t* marker = NULL) {
157             return sv_payload_exists(aTHX_ SvRV(rv), marker);
158             }
159              
160 13           inline void* rv_payload (pTHX_ SV* rv, const payload_marker_t* marker = NULL) {
161 13           return sv_payload(aTHX_ SvRV(rv), marker);
162             }
163              
164             inline SV* rv_payload_sv (pTHX_ SV* rv, const payload_marker_t* marker = NULL) {
165             return sv_payload_sv(aTHX_ SvRV(rv), marker);
166             }
167              
168             inline int rv_payload_detach (pTHX_ SV* rv, payload_marker_t* marker = NULL) {
169             return sv_payload_detach(aTHX_ SvRV(rv), marker);
170             }
171              
172             SV* call_next (pTHX_ CV* cv, SV** args, I32 items, next_t type, I32 flags = 0);
173             inline SV* call_super (pTHX_ CV* cv, SV** args, I32 items, I32 flags = 0) { return call_next(aTHX_ cv, args, items, NEXT_SUPER, flags); }
174             inline SV* call_next_method (pTHX_ CV* cv, SV** args, I32 items, I32 flags = 0) { return call_next(aTHX_ cv, args, items, NEXT_METHOD, flags); }
175             inline SV* call_next_maybe (pTHX_ CV* cv, SV** args, I32 items, I32 flags = 0) { return call_next(aTHX_ cv, args, items, NEXT_MAYBE, flags); }
176              
177             I32 _call_sub (pTHX_ CV* cv, I32 flags, SV** ret, I32 maxret, AV** aref, SV* first_arg, SV** rest_args, I32 rest_items);
178             I32 _call_method (pTHX_ SV* obj, I32 flags, const char* name, STRLEN len, SV** ret, I32 maxret, AV** aref, SV** args, I32 items);
179              
180 0           inline void call_sub_void (pTHX_ CV* cv, SV** args = NULL, I32 items = 0) {
181 0           _call_sub(aTHX_ cv, G_VOID, NULL, 0, NULL, NULL, args, items);
182 0           }
183              
184 9           inline SV* call_sub_scalar (pTHX_ CV* cv, SV** args = NULL, I32 items = 0, I32 flags = 0) {
185 9           SV* ret = NULL;
186 9 50         _call_sub(aTHX_ cv, flags|G_SCALAR, &ret, 1, NULL, NULL, args, items);
187 9           return ret;
188             }
189              
190             inline I32 call_sub_list (pTHX_ CV* cv, SV** ret, I32 maxret, SV** args = NULL, I32 items = 0, I32 flags = 0) {
191             return _call_sub(aTHX_ cv, flags|G_ARRAY, ret, maxret, NULL, NULL, args, items);
192             }
193              
194             inline AV* call_sub_av (pTHX_ CV* cv, SV** args = NULL, I32 items = 0, I32 flags = 0) {
195             AV* ret;
196             _call_sub(aTHX_ cv, flags|G_ARRAY, NULL, 0, &ret, NULL, args, items);
197             return ret;
198              
199             }
200              
201             inline void call_method_void (pTHX_ SV* obj, const char* name, STRLEN len, SV** args = NULL, I32 items = 0) {
202             _call_method(aTHX_ obj, G_VOID, name, len, NULL, 0, NULL, args, items);
203             }
204              
205             inline SV* call_method_scalar (pTHX_ SV* obj, const char* name, STRLEN len, SV** args = NULL, I32 items = 0, I32 flags = 0) {
206             SV* ret = NULL;
207             _call_method(aTHX_ obj, flags|G_SCALAR, name, len, &ret, 1, NULL, args, items);
208             return ret;
209             }
210              
211             inline I32 call_method_list (pTHX_ SV* obj, const char* name, STRLEN len, SV** ret, I32 maxret, SV** args = NULL, I32 items = 0, I32 flags = 0) {
212             return _call_method(aTHX_ obj, flags|G_ARRAY, name, len, ret, maxret, NULL, args, items);
213             }
214              
215             inline AV* call_method_av (pTHX_ SV* obj, const char* name, STRLEN len, SV** args = NULL, I32 items = 0, I32 flags = 0) {
216             AV* ret;
217             _call_method(aTHX_ obj, flags|G_ARRAY, name, len, NULL, 0, &ret, args, items);
218             return ret;
219             }
220              
221             bool register_package (pTHX_ const char* module, const char* source_module);
222             void inherit_package (pTHX_ const char* module, const char* parent);
223             SV* error_sv (const std::exception& err);
224              
225             class XSBackref : public virtual panda::RefCounted {
226             public:
227             SV* perl_object;
228              
229             void on_perl_dup (pTHX_ int32_t refcnt); /* should be called when interpreter is cloned */
230              
231             protected:
232             XSBackref () : perl_object(NULL) {}
233              
234             virtual void on_retain () const {
235             SvREFCNT_inc_simple_void(perl_object);
236             }
237              
238             // XS DTOR typemap sets perl_object = NULL just before DTOR code, to avoid infinite loop
239             virtual void on_release () const {
240             SvREFCNT_dec(perl_object);
241             }
242              
243             virtual ~XSBackref () {};
244             };
245              
246             // interface to refcounted object. if user uses its own refcnt base class, he should add overloading for these functions
247             inline int32_t refcnt_get (const panda::RefCounted* var) { return var->refcnt(); }
248             inline void refcnt_inc (const panda::RefCounted* var) { var->retain(); }
249             inline void refcnt_dec (const panda::RefCounted* var) { var->release(); }
250              
251             inline panda::string sv2string (pTHX_ SV* svstr) {
252             STRLEN len;
253             char* ptr = SvPV(svstr, len);
254             return panda::string(ptr, len);
255             }
256              
257             inline std::string_view sv2string_view (pTHX_ SV* svstr) {
258             STRLEN len;
259             char* ptr = SvPV(svstr, len);
260             return std::string_view(ptr, len);
261             }
262              
263             struct SvIntrPtr {
264 0           SvIntrPtr() : sv(NULL) {}
265              
266             static const bool INCREMENT = true;
267             static const bool NONE = false;
268              
269 9           SvIntrPtr(SV* sv, bool policy = INCREMENT) : sv(sv) {
270 9 50         if (policy == INCREMENT) {
271 9 50         SvREFCNT_inc_simple_void(sv);
272             }
273 9           }
274              
275             SvIntrPtr(AV* sv, bool policy = INCREMENT) : SvIntrPtr(reinterpret_cast(sv), policy) {}
276             SvIntrPtr(HV* sv, bool policy = INCREMENT) : SvIntrPtr(reinterpret_cast(sv), policy) {}
277 16           SvIntrPtr(CV* sv, bool policy = INCREMENT) : SvIntrPtr(reinterpret_cast(sv), policy) {}
278              
279 2           SvIntrPtr(const SvIntrPtr& oth) : SvIntrPtr(oth.sv){}
280              
281 8           SvIntrPtr(SvIntrPtr&& oth) : sv(oth.sv) {
282 8           oth.sv = NULL;
283 8           }
284              
285 0           SvIntrPtr& operator=(const SvIntrPtr& oth) {
286 0           SvREFCNT_dec(sv);
287 0           sv = oth.sv;
288 0 0         SvREFCNT_inc_simple_void(sv);
289 0           return *this;
290             }
291              
292             SvIntrPtr& operator=(SvIntrPtr&& oth) {
293             sv = oth.sv;
294             oth.sv = NULL;
295             return *this;
296             }
297              
298 17           ~SvIntrPtr () {
299 17           SvREFCNT_dec(sv);
300 17           }
301              
302             operator SV*() {
303             return sv;
304             }
305              
306             SV* operator -> () {
307             return sv;
308             }
309              
310             SV& operator* () {
311             return *sv;
312             }
313              
314             template
315 34           T* get () const { return reinterpret_cast(sv); }
316              
317             private:
318             SV* sv;
319             };
320              
321             struct SvMortalPtr : public SvIntrPtr {
322             template
323             SvMortalPtr(T val) : SvIntrPtr(val, false) {}
324             };
325              
326             }
327              
328             #include