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