Permalink
Browse files

added 'is inline' feature

  • Loading branch information...
1 parent 3d6ee45 commit 8d9afca6d0438a0f98b3a076eaeb3bee9c6ad8d2 @FROGGS committed Sep 15, 2012
Showing with 69 additions and 0 deletions.
  1. +42 −0 lib/NativeCall.pm6
  2. +27 −0 t/09-inline.t
View
@@ -1,5 +1,7 @@
module NativeCall;
+use File::Spec; # for 'is inline'
+
# Throwaway type just to get us some way to get at the NativeCall
# representation.
my class native_callsite is repr('NativeCall') { }
@@ -128,6 +130,42 @@ my role Native[Routine $r, Str $libname] {
}
}
+my role Inline[Routine $r, Str $code] {
+ has int $!setup;
+ has native_callsite $!call is box_target;
+
+ method postcircumfix:<( )>($args) {
+ unless $!setup {
+ my $basename = File::Spec.catfile( File::Spec.tmpdir, 'inline' );
+ my $libname = $basename;
+ $libname = $basename ~ 1000.rand while $libname.IO.e;
+ my $o = $*VM<config><o>;
+ my $so = $*VM<config><load_ext>;
+ my $c_line = "echo '$code' | $*VM<config><cc> -c $*VM<config><cc_shared> $*VM<config><cc_o_out>$libname$o $*VM<config><ccflags> -xc -";
+ my $l_line = "$*VM<config><ld> $*VM<config><ld_load_flags> $*VM<config><ldflags> " ~
+ "$*VM<config><libs> $*VM<config><ld_out>$libname$so $libname$o";
+ shell($c_line);
+ shell($l_line);
+
+ my Mu $arg_info := param_list_for($r.signature);
+ my str $conv = self.?native_call_convention || '';
+ my $realname =
+ !$libname.DEFINITE ?? "" !!
+ $libname ~~ /\.\w+$/ ?? $libname !!
+ "$libname$*VM<config><load_ext>";
+ nqp::buildnativecall(self,
+ nqp::unbox_s($realname), # library name
+ nqp::unbox_s(self.?native_symbol // $r.name), # symbol to call
+ nqp::unbox_s($conv), # calling convention
+ $arg_info,
+ return_hash_for($r.signature));
+ $!setup = 1;
+ }
+ nqp::nativecall(nqp::p6decont(map_return_type($r.returns)), self,
+ nqp::getattr(nqp::p6decont($args), Capture, '$!list'))
+ }
+}
+
# Role for carrying extra calling convention information.
my role NativeCallingConvention[$name] {
method native_call_convention() { $name };
@@ -230,6 +268,10 @@ multi trait_mod:<is>(Routine $r, :$symbol!) is export(:DEFAULT, :traits) {
$r does NativeCallSymbol[$symbol];
}
+multi trait_mod:<is>(Routine $r, :$inline!) is export {
+ $r does Inline[$r, $inline === True ?? Str !! $inline];
+}
+
# Specifies that the routine is actually a native call, into the
# current executable (platform specific) or into a named library
multi trait_mod:<is>(Routine $r, :$native!) is export(:DEFAULT, :traits) {
View
@@ -0,0 +1,27 @@
+use lib '.';
+use NativeCall;
+use Test;
+
+plan(1);
+
+BEGIN my $inline = '
+#ifdef WIN32
+#define DLLEXPORT __declspec(dllexport)
+#else
+#define DLLEXPORT extern
+#endif
+
+DLLEXPORT int GetTheAnswer( int question )
+{
+ if( question == 7 )
+ return 42;
+
+ return -1;
+}
+';
+
+sub GetTheAnswer( int ) returns Int is inline($inline) is symbol('GetTheAnswer') { * }
+
+is GetTheAnswer( 7 ), 42;
+
+# vim:ft=perl6

0 comments on commit 8d9afca

Please sign in to comment.