From df00ff3beeb297b9622f8acbed9c80d320c87580 Mon Sep 17 00:00:00 2001 From: Ingo Weinhold Date: Wed, 29 Oct 2008 03:25:44 +0100 Subject: Haiku Port Message-Id: <20081029022544.413.1@knochen-vm.localdomain> p4raw-id: //depot/perl@34630 --- haiku/Haiku/Haiku.pm | 54 +++++++++++++++++++ haiku/Haiku/Haiku.xs | 137 ++++++++++++++++++++++++++++++++++++++++++++++++ haiku/Haiku/Makefile.PL | 20 +++++++ haiku/haikuish.h | 11 ++++ 4 files changed, 222 insertions(+) create mode 100644 haiku/Haiku/Haiku.pm create mode 100644 haiku/Haiku/Haiku.xs create mode 100644 haiku/Haiku/Makefile.PL create mode 100644 haiku/haikuish.h (limited to 'haiku') diff --git a/haiku/Haiku/Haiku.pm b/haiku/Haiku/Haiku.pm new file mode 100644 index 0000000000..2577bec496 --- /dev/null +++ b/haiku/Haiku/Haiku.pm @@ -0,0 +1,54 @@ +package Haiku; + +BEGIN { + use strict; + use vars qw|$VERSION $XS_VERSION @ISA @EXPORT @EXPORT_OK|; + + require Exporter; + require DynaLoader; + + @ISA = qw|Exporter DynaLoader|; + $VERSION = '0.34'; + $XS_VERSION = $VERSION; + $VERSION = eval $VERSION; + + @EXPORT = qw( + ); + @EXPORT_OK = qw( + ); +} + +bootstrap Haiku; + +1; + +__END__ + +=head1 NAME + +Haiku - Interfaces to some Haiku API Functions + +=head1 DESCRIPTION + +The Haiku module contains functions to access Haiku APIs. + +=head2 Alphabetical Listing of Haiku Functions + +=over + +=item Haiku::debug_printf(FORMAT,...) + +Similar to printf, but prints to system debug output. + +=item Haiku::debugger(FORMAT,...) + +Drops the program into the debugger. The printf like arguments define the +debugger message. + +=item Haiku::ktrace_printf(FORMAT,...) + +Similar to printf, but prints to a kernel tracing entry. + +=back + +=cut diff --git a/haiku/Haiku/Haiku.xs b/haiku/Haiku/Haiku.xs new file mode 100644 index 0000000000..c5a121dad1 --- /dev/null +++ b/haiku/Haiku/Haiku.xs @@ -0,0 +1,137 @@ +#define PERL_NO_GET_CONTEXT +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include + +#include + +static void +haiku_do_debugger(const char* format,...) +{ + char buffer[1024]; + va_list args; + va_start(args, format); + my_vsnprintf(buffer, sizeof(buffer), format, args); + va_end(args); + + debugger(buffer); +} + +static void +haiku_do_debug_printf(pTHX_ register SV *sv, + void (*printfFunc)(const char*,...)) +{ + dVAR; + + if (!sv) + return; + if (SvTYPE(sv) == SVt_IV && SvIOK(sv)) { + assert(!SvGMAGICAL(sv)); + if (SvIsUV(sv)) + (*printfFunc)("%"UVuf, (UV)SvUVX(sv)); + else + (*printfFunc)("%"IVdf, (IV)SvIVX(sv)); + return; + } + else { + STRLEN len; + /* Do this first to trigger any overloading. */ + const char *tmps = SvPV_const(sv, len); + U8 *tmpbuf = NULL; + + if (!SvUTF8(sv)) { + /* We don't modify the original scalar. */ + tmpbuf = bytes_to_utf8((const U8*) tmps, &len); + tmps = (char *) tmpbuf; + } + + if (len) + (*printfFunc)("%.*s", (int)len, tmps); + Safefree(tmpbuf); + } +} + +XS(haiku_debug_printf) +{ + dVAR; + dXSARGS; + dORIGMARK; + SV *sv; + + if (items < 1) + Perl_croak(aTHX_ "usage: Haiku::debug_printf($format,...)"); + + sv = newSV(0); + + if (SvTAINTED(MARK[1])) + TAINT_PROPER("debug_printf"); + do_sprintf(sv, SP - MARK, MARK + 1); + + haiku_do_debug_printf(sv, &debug_printf); + + SvREFCNT_dec(sv); + SP = ORIGMARK; + PUSHs(&PL_sv_yes); +} + +XS(haiku_ktrace_printf) +{ + dVAR; + dXSARGS; + dORIGMARK; + SV *sv; + + if (items < 1) + Perl_croak(aTHX_ "usage: Haiku::debug_printf($format,...)"); + + sv = newSV(0); + + if (SvTAINTED(MARK[1])) + TAINT_PROPER("ktrace_printf"); + do_sprintf(sv, SP - MARK, MARK + 1); + + haiku_do_debug_printf(sv, &ktrace_printf); + + SvREFCNT_dec(sv); + SP = ORIGMARK; + PUSHs(&PL_sv_yes); +} + +XS(haiku_debugger) +{ + dVAR; + dXSARGS; + dORIGMARK; + SV *sv; + + if (items < 1) + Perl_croak(aTHX_ "usage: Haiku::debugger($format,...)"); + + sv = newSV(0); + + if (SvTAINTED(MARK[1])) + TAINT_PROPER("debugger"); + do_sprintf(sv, SP - MARK, MARK + 1); + + haiku_do_debug_printf(sv, &haiku_do_debugger); + + SvREFCNT_dec(sv); + SP = ORIGMARK; + PUSHs(&PL_sv_yes); +} + +MODULE = Haiku PACKAGE = Haiku + +PROTOTYPES: DISABLE + +BOOT: +{ + char *file = __FILE__; + + newXS("Haiku::debug_printf", haiku_debug_printf, file); + newXS("Haiku::ktrace_printf", haiku_ktrace_printf, file); + newXS("Haiku::debugger", haiku_debugger, file); + XSRETURN_YES; +} diff --git a/haiku/Haiku/Makefile.PL b/haiku/Haiku/Makefile.PL new file mode 100644 index 0000000000..dacf230201 --- /dev/null +++ b/haiku/Haiku/Makefile.PL @@ -0,0 +1,20 @@ +use 5.006; +use ExtUtils::MakeMaker; + +unless ($^O eq "haiku") { + die "OS unsupported\n"; +} + +#my @libs; +#push @libs, '-L/lib/w32api -lole32 -lversion' if $^O eq "cygwin"; + +WriteMakefile( + NAME => 'Haiku', + VERSION_FROM => 'Haiku.pm', +# LIBS => \@libs, + INSTALLDIRS => ($] >= 5.008004 ? 'perl' : 'site'), + NO_META => 1, + + AUTHOR => 'Ingo Weinhold ', + ABSTRACT_FROM => 'Haiku.pm', +); diff --git a/haiku/haikuish.h b/haiku/haikuish.h new file mode 100644 index 0000000000..55869b4941 --- /dev/null +++ b/haiku/haikuish.h @@ -0,0 +1,11 @@ +#ifndef PERL_HAIKU_HAIKUISH_H +#define PERL_HAIKU_HAIKUISH_H + +#include "../unixish.h" + +/* We need or else the W* macros aren't defined in perl.h. */ + +#include + +#endif + -- cgit v1.2.1