Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 190 lines (173 sloc) 6.369 kb
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
1 module NativeCall;
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
2
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
3 # Throwaway type just to get us some way to get at the NativeCall
4 # representation.
5 my class native_callsite is repr('NativeCall') { }
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
6
d22dd75 @jnthn Better string support, including multiple encodings.
authored
7 # Maps a chosen string encoding to a type recognized by the native call engine.
8 sub string_encoding_to_nci_type($enc) {
9 given $enc {
10 when 'utf8' { 'utf8str' }
11 when 'utf16' { 'utf16str' }
12 when 'ascii' { 'asciistr' }
13 default { die "Unknown string encoding for native call: $enc"; }
14 }
15 }
16
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
17 # Builds a hash of type information for the specified parameter.
18 sub param_hash_for(Parameter $p) {
19 my Mu $result := nqp::hash();
d22dd75 @jnthn Better string support, including multiple encodings.
authored
20 my $type := $p.type();
21 if $type ~~ Str {
22 my $enc := $p.?native_call_encoded() || 'utf8';
23 nqp::bindkey($result, 'type', nqp::unbox_s(string_encoding_to_nci_type($enc)));
24 nqp::bindkey($result, 'free_str', nqp::unbox_i(1));
25 }
26 else {
27 nqp::bindkey($result, 'type', nqp::unbox_s(type_code_for($p.type)));
28 }
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
29 $result
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
30 }
a32dace @jnthn More types, plus CPointer that translates to some abstract pointer-y thi...
authored
31
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
32 # Builds a hash of type information for the specified return type.
d22dd75 @jnthn Better string support, including multiple encodings.
authored
33 sub return_hash_for(&r) {
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
34 my Mu $result := nqp::hash();
d22dd75 @jnthn Better string support, including multiple encodings.
authored
35 my $returns := &r.returns;
36 if $returns ~~ Str {
37 my $enc := &r.?native_call_encoded() || 'utf8';
38 nqp::bindkey($result, 'type', nqp::unbox_s(string_encoding_to_nci_type($enc)));
39 nqp::bindkey($result, 'free_str', nqp::unbox_i(0));
40 }
41 else {
42 nqp::bindkey($result, 'type',
43 $returns =:= Mu ?? 'void' !! nqp::unbox_s(type_code_for($returns)));
44 }
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
45 $result
8525e82 @jnthn Use the declared return type of the routine in signature generation.
authored
46 }
47
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
48 # Gets the NCI type code to use based on a given Perl 6 type.
49 my %type_map =
50 'int8' => 'char',
51 'int16' => 'short',
52 'int32' => 'int',
53 'int' => 'long',
54 'Int' => 'longlong',
55 'num32' => 'float',
56 'num64' => 'double',
57 'num' => 'double',
d22dd75 @jnthn Better string support, including multiple encodings.
authored
58 'Num' => 'double';
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
59 sub type_code_for(Mu ::T) {
60 return %type_map{T.^name}
61 if %type_map.exists(T.^name);
e293ff0 @jnthn Add CStruct passing support. Improve error message when trying to pass a...
authored
62 return 'cstruct'
63 if T.REPR eq 'CStruct';
4561a4f @jnthn Support opaque pointers in NativeCall.
authored
64 return 'cpointer'
65 if T.REPR eq 'CPointer';
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
66 return 'carray'
67 if T.REPR eq 'CArray';
e293ff0 @jnthn Add CStruct passing support. Improve error message when trying to pass a...
authored
68 die "Unknown type {T.^name} used in native call.\n" ~
69 "If you want to pass a struct, be sure to use the CStruct representation.\n" ~
70 "If you want to pass an array, be sure to use the CArray type.";
bd56459 @jnthn Add some initial experimental code that shows how we can call a Win32 AP...
authored
71 }
72
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
73 # This role is mixed in to any routine that is marked as being a
74 # native call.
75 my role Native[Routine $r, Str $libname] {
76 has int $!setup;
77 has native_callsite $!call is box_target;
78
79 method postcircumfix:<( )>($args) {
80 unless $!setup {
81 my Mu $arg_info := nqp::list();
82 for $r.signature.params -> $p {
83 nqp::push($arg_info, param_hash_for($p))
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
84 }
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
85 my str $conv = self.?native_call_convention || '';
b3e94c4 @jnthn Restore auto-appending the .dll or .so rather than requiring it be menti...
authored
86 my $realname = $libname && $libname !~~ /\.\w+$/ ??
87 "$libname$*VM<config><load_ext>" !!
88 $libname;
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
89 nqp::buildnativecall(self,
b3e94c4 @jnthn Restore auto-appending the .dll or .so rather than requiring it be menti...
authored
90 nqp::unbox_s($realname), # library name
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
91 nqp::unbox_s($r.name), # symbol to call
92 nqp::unbox_s($conv), # calling convention
93 $arg_info,
d22dd75 @jnthn Better string support, including multiple encodings.
authored
94 return_hash_for($r));
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
95 $!setup = 1;
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
96 }
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
97 nqp::nativecall(nqp::p6decont($r.returns), self,
98 nqp::getattr(nqp::p6decont($args), Capture, '$!list'))
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
99 }
100 }
101
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
102 # Role for carrying extra calling convention information.
103 my role NativeCallingConvention[$name] {
104 method native_call_convention() { $name };
105 }
d907f71 @mberends [lib/NativeCall.pm6] add patch provided by pmichaud++
mberends authored
106
d22dd75 @jnthn Better string support, including multiple encodings.
authored
107 # Role for carrying extra string encoding information.
108 my role NativeCallEncoded[$name] {
109 method native_call_encoded() { $name };
110 }
111
4561a4f @jnthn Support opaque pointers in NativeCall.
authored
112 # Expose an OpaquePointer class for working with raw pointers.
113 my class OpaquePointer is export is repr('CPointer') { }
114
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
115 # CArray class, used to represent C arrays.
116 my class CArray is export is repr('CArray') {
117 method at_pos($pos) { die "CArray cannot be used without a type" }
118
119 my role IntTypedCArray[::TValue] does Positional[TValue] {
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
120 multi method at_pos(\$arr: $pos) is rw {
121 Proxy.new:
122 FETCH => method () {
123 nqp::p6box_i(nqp::r_atpos_i($arr, nqp::unbox_i($pos.Int)))
124 },
125 STORE => method (int $v) {
126 nqp::r_bindpos_i($arr, nqp::unbox_i($pos.Int), $v);
127 self
128 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
129 }
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
130 multi method at_pos(\$arr: int $pos) is rw {
131 Proxy.new:
132 FETCH => method () {
133 nqp::p6box_i(nqp::r_atpos_i($arr, $pos))
134 },
135 STORE => method (int $v) {
136 nqp::r_bindpos_i($arr, $pos, $v);
137 self
138 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
139 }
140 }
141 multi method PARAMETERIZE_TYPE(Int:U $t) {
142 self but IntTypedCArray[$t.WHAT]
143 }
144
145 my role NumTypedCArray[::TValue] does Positional[TValue] {
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
146 multi method at_pos(\$arr: $pos) is rw {
147 Proxy.new:
148 FETCH => method () {
149 nqp::p6box_n(nqp::r_atpos_n($arr, nqp::unbox_i($pos.Int)))
150 },
151 STORE => method (num $v) {
152 nqp::r_bindpos_n($arr, nqp::unbox_i($pos.Int), $v);
153 self
154 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
155 }
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
156 multi method at_pos(\$arr: int $pos) is rw {
157 Proxy.new:
158 FETCH => method () {
159 nqp::p6box_n(nqp::r_atpos_n($arr, $pos))
160 },
161 STORE => method (num $v) {
162 nqp::r_bindpos_n($arr, $pos, $v);
163 self
164 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
165 }
166 }
167 multi method PARAMETERIZE_TYPE(Num:U $t) {
168 self but NumTypedCArray[$t.WHAT]
169 }
170 }
171
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
172 # Specifies that the routine is actually a native call, and gives
173 # the name of the library to load it from.
174 multi trait_mod:<is>(Routine $r, $libname, :$native!) is export {
175 $r does Native[$r, $libname];
bd56459 @jnthn Add some initial experimental code that shows how we can call a Win32 AP...
authored
176 }
9766cd2 @jnthn If there's no returns type declared, we assume void return.
authored
177
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
178 # Specifies the calling convention to use for a native call.
179 multi trait_mod:<is>(Routine $r, $name, :$nativeconv!) is export {
180 $r does NativeCallingConvention[$name];
181 }
d22dd75 @jnthn Better string support, including multiple encodings.
authored
182
183 # Ways to specify how to marshall strings.
184 multi trait_mod:<is>(Parameter $p, $name, :$encoded!) is export {
185 $p does NativeCallEncoded[$name];
186 }
187 multi trait_mod:<is>(Routine $p, $name, :$encoded!) is export {
188 $p does NativeCallEncoded[$name];
189 }
Something went wrong with that request. Please try again.