Haiku Port

Message-Id: <20081029022544.413.1@knochen-vm.localdomain>

p4raw-id: //depot/perl@34630

4 files changed, 222 insertions, 0 deletions

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 <stdarg.h>
+
+#include <OS.h>
+
+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 <ingo_weinhold@gmx.de>',
+    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 <sys/wait.h> or else the W* macros aren't defined in perl.h. */
+
+#include <sys/wait.h>
+
+#endif
+