haiku/Haiku/Haiku.xs

   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_ register 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 }