xref: /openbsd/gnu/usr.bin/perl/haiku/Haiku/Haiku.xs (revision 76d0caae)
1 #define PERL_NO_GET_CONTEXT
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5 
6 #include <stdarg.h>
7 
8 #include <OS.h>
9 
10 static void
11 haiku_do_debugger(const char* format,...)
12 {
13     char buffer[1024];
14     va_list args;
15     va_start(args, format);
16     my_vsnprintf(buffer, sizeof(buffer), format, args);
17     va_end(args);
18 
19     debugger(buffer);
20 }
21 
22 static void
23 haiku_do_debug_printf(pTHX_ SV *sv,
24     void (*printfFunc)(const char*,...))
25 {
26     dVAR;
27 
28     if (!sv)
29 	return;
30     if (SvTYPE(sv) == SVt_IV && SvIOK(sv)) {
31 	assert(!SvGMAGICAL(sv));
32 	if (SvIsUV(sv))
33 	    (*printfFunc)("%"UVuf, (UV)SvUVX(sv));
34 	else
35 	    (*printfFunc)("%"IVdf, (IV)SvIVX(sv));
36 	return;
37     }
38     else {
39 	STRLEN len;
40 	/* Do this first to trigger any overloading.  */
41 	const char *tmps = SvPV_const(sv, len);
42 	U8 *tmpbuf = NULL;
43 
44 	if (!SvUTF8(sv)) {
45 	    /* We don't modify the original scalar.  */
46 	    tmpbuf = bytes_to_utf8((const U8*) tmps, &len);
47 	    tmps = (char *) tmpbuf;
48 	}
49 
50 	if (len)
51 	    (*printfFunc)("%.*s", (int)len, tmps);
52 	Safefree(tmpbuf);
53     }
54 }
55 
56 XS(haiku_debug_printf)
57 {
58     dVAR;
59     dXSARGS;
60     dORIGMARK;
61     SV *sv;
62 
63     if (items < 1)
64 	Perl_croak(aTHX_ "usage: Haiku::debug_printf($format,...)");
65 
66     sv = newSV(0);
67 
68     if (SvTAINTED(MARK[1]))
69 	TAINT_PROPER("debug_printf");
70     do_sprintf(sv, SP - MARK, MARK + 1);
71 
72     haiku_do_debug_printf(sv, &debug_printf);
73 
74     SvREFCNT_dec(sv);
75     SP = ORIGMARK;
76     PUSHs(&PL_sv_yes);
77 }
78 
79 XS(haiku_ktrace_printf)
80 {
81     dVAR;
82     dXSARGS;
83     dORIGMARK;
84     SV *sv;
85 
86     if (items < 1)
87 	Perl_croak(aTHX_ "usage: Haiku::debug_printf($format,...)");
88 
89     sv = newSV(0);
90 
91     if (SvTAINTED(MARK[1]))
92 	TAINT_PROPER("ktrace_printf");
93     do_sprintf(sv, SP - MARK, MARK + 1);
94 
95     haiku_do_debug_printf(sv, &ktrace_printf);
96 
97     SvREFCNT_dec(sv);
98     SP = ORIGMARK;
99     PUSHs(&PL_sv_yes);
100 }
101 
102 XS(haiku_debugger)
103 {
104     dVAR;
105     dXSARGS;
106     dORIGMARK;
107     SV *sv;
108 
109     if (items < 1)
110 	Perl_croak(aTHX_ "usage: Haiku::debugger($format,...)");
111 
112     sv = newSV(0);
113 
114     if (SvTAINTED(MARK[1]))
115 	TAINT_PROPER("debugger");
116     do_sprintf(sv, SP - MARK, MARK + 1);
117 
118     haiku_do_debug_printf(sv, &haiku_do_debugger);
119 
120     SvREFCNT_dec(sv);
121     SP = ORIGMARK;
122     PUSHs(&PL_sv_yes);
123 }
124 
125 MODULE = Haiku            PACKAGE = Haiku
126 
127 PROTOTYPES: DISABLE
128 
129 BOOT:
130 {
131     char *file = __FILE__;
132 
133     newXS("Haiku::debug_printf", haiku_debug_printf, file);
134     newXS("Haiku::ktrace_printf", haiku_ktrace_printf, file);
135     newXS("Haiku::debugger", haiku_debugger, file);
136     XSRETURN_YES;
137 }
138