Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 276 lines (247 sloc) 9.583 kb
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
1 module NativeCall;
8e36c74 Jonathan Worthington CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
2
898c645 Jonathan Worthington 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 Jonathan Worthington CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
6
d22dd75 Jonathan Worthington 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 Jonathan Worthington 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.
46d9cce Arne Skjærholt Functionality and tests for callbacks.
arnsholt authored
18 sub param_hash_for(Parameter $p, :$with-typeobj) {
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
19 my Mu $result := nqp::hash();
d22dd75 Jonathan Worthington Better string support, including multiple encodings.
authored
20 my $type := $p.type();
46d9cce Arne Skjærholt Functionality and tests for callbacks.
arnsholt authored
21 nqp::bindkey($result, 'typeobj', $type) if $with-typeobj;
d22dd75 Jonathan Worthington Better string support, including multiple encodings.
authored
22 if $type ~~ Str {
23 my $enc := $p.?native_call_encoded() || 'utf8';
24 nqp::bindkey($result, 'type', nqp::unbox_s(string_encoding_to_nci_type($enc)));
25 nqp::bindkey($result, 'free_str', nqp::unbox_i(1));
26 }
46d9cce Arne Skjærholt Functionality and tests for callbacks.
arnsholt authored
27 elsif $type ~~ Callable {
28 nqp::bindkey($result, 'type', nqp::unbox_s(type_code_for($p.type)));
dc43e90 Arne Skjærholt Change to right Parameter accessor for signatures.
arnsholt authored
29 my $info := param_list_for($p.sub_signature, :with-typeobj);
79429d9 Arne Skjærholt Return values from callbacks seem to work now as well.
arnsholt authored
30 nqp::unshift($info, return_hash_for($p.sub_signature));
46d9cce Arne Skjærholt Functionality and tests for callbacks.
arnsholt authored
31 nqp::bindkey($result, 'callback_args', $info);
32 }
d22dd75 Jonathan Worthington Better string support, including multiple encodings.
authored
33 else {
34 nqp::bindkey($result, 'type', nqp::unbox_s(type_code_for($p.type)));
35 }
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
36 $result
8e36c74 Jonathan Worthington CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
37 }
a32dace Jonathan Worthington More types, plus CPointer that translates to some abstract pointer-y thi...
authored
38
46d9cce Arne Skjærholt Functionality and tests for callbacks.
arnsholt authored
39 # Builds the list of parameter information for a callback argument.
40 sub param_list_for(Signature $sig, :$with-typeobj) {
41 my Mu $arg_info := nqp::list();
42 for $sig.params -> $p {
43 nqp::push($arg_info, param_hash_for($p, :with-typeobj($with-typeobj)))
44 }
45
2680acd Arne Skjærholt Unbreak everything.
arnsholt authored
46 $arg_info;
46d9cce Arne Skjærholt Functionality and tests for callbacks.
arnsholt authored
47 }
48
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
49 # Builds a hash of type information for the specified return type.
79429d9 Arne Skjærholt Return values from callbacks seem to work now as well.
arnsholt authored
50 sub return_hash_for(Signature $s) {
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
51 my Mu $result := nqp::hash();
79429d9 Arne Skjærholt Return values from callbacks seem to work now as well.
arnsholt authored
52 my $returns := $s.returns;
d22dd75 Jonathan Worthington Better string support, including multiple encodings.
authored
53 if $returns ~~ Str {
54 my $enc := &r.?native_call_encoded() || 'utf8';
55 nqp::bindkey($result, 'type', nqp::unbox_s(string_encoding_to_nci_type($enc)));
56 nqp::bindkey($result, 'free_str', nqp::unbox_i(0));
57 }
46d9cce Arne Skjærholt Functionality and tests for callbacks.
arnsholt authored
58 # TODO: If we ever want to handle function pointers returned from C, this
59 # bit of code needs to handle that.
d22dd75 Jonathan Worthington Better string support, including multiple encodings.
authored
60 else {
61 nqp::bindkey($result, 'type',
62 $returns =:= Mu ?? 'void' !! nqp::unbox_s(type_code_for($returns)));
63 }
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
64 $result
8525e82 Jonathan Worthington Use the declared return type of the routine in signature generation.
authored
65 }
66
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
67 # Gets the NCI type code to use based on a given Perl 6 type.
68 my %type_map =
46d9cce Arne Skjærholt Functionality and tests for callbacks.
arnsholt authored
69 'int8' => 'char',
70 'int16' => 'short',
71 'int32' => 'int',
72 'int' => 'long',
73 'Int' => 'longlong',
74 'num32' => 'float',
75 'num64' => 'double',
76 'num' => 'double',
77 'Num' => 'double',
78 'Callable' => 'callback';
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
79 sub type_code_for(Mu ::T) {
80 return %type_map{T.^name}
81 if %type_map.exists(T.^name);
e293ff0 Jonathan Worthington Add CStruct passing support. Improve error message when trying to pass a...
authored
82 return 'cstruct'
83 if T.REPR eq 'CStruct';
4561a4f Jonathan Worthington Support opaque pointers in NativeCall.
authored
84 return 'cpointer'
85 if T.REPR eq 'CPointer';
6803a5a Jonathan Worthington Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
86 return 'carray'
87 if T.REPR eq 'CArray';
e293ff0 Jonathan Worthington Add CStruct passing support. Improve error message when trying to pass a...
authored
88 die "Unknown type {T.^name} used in native call.\n" ~
89 "If you want to pass a struct, be sure to use the CStruct representation.\n" ~
90 "If you want to pass an array, be sure to use the CArray type.";
bd56459 Jonathan Worthington Add some initial experimental code that shows how we can call a Win32 AP...
authored
91 }
92
6424f48 Jonathan Worthington Unbust voids.
authored
93 multi sub map_return_type(Mu $type) { Mu }
94 multi sub map_return_type($type) {
64ca08b Jonathan Worthington Fix sized int/num returns.
authored
95 $type === int8 || $type === int16 || $type === int32 || $type === int ?? Int !!
96 $type === num32 || $type === num64 || $type === num ?? Num !!
97 $type
98 }
99
bc26b5e Arne Skjærholt Clean up pull request. As discussed on #perl6.
arnsholt authored
100 my role NativeCallSymbol[Str $name] {
101 method native_symbol() { $name }
eb3e3d8 Jonathan Scott Duff Add a way to name native routines
perlpilot authored
102 }
103
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
104 # This role is mixed in to any routine that is marked as being a
105 # native call.
106 my role Native[Routine $r, Str $libname] {
107 has int $!setup;
108 has native_callsite $!call is box_target;
109
110 method postcircumfix:<( )>($args) {
111 unless $!setup {
46d9cce Arne Skjærholt Functionality and tests for callbacks.
arnsholt authored
112 my Mu $arg_info := param_list_for($r.signature);
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
113 my str $conv = self.?native_call_convention || '';
aa0436c Arne Skjærholt Update library name handling to NQP handling extensions.
arnsholt authored
114 my $realname = !$libname.DEFINITE ?? "" !! $libname;
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
115 nqp::buildnativecall(self,
b3e94c4 Jonathan Worthington Restore auto-appending the .dll or .so rather than requiring it be menti...
authored
116 nqp::unbox_s($realname), # library name
bc26b5e Arne Skjærholt Clean up pull request. As discussed on #perl6.
arnsholt authored
117 nqp::unbox_s(self.?native_symbol // $r.name), # symbol to call
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
118 nqp::unbox_s($conv), # calling convention
119 $arg_info,
79429d9 Arne Skjærholt Return values from callbacks seem to work now as well.
arnsholt authored
120 return_hash_for($r.signature));
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
121 $!setup = 1;
8e36c74 Jonathan Worthington CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
122 }
64ca08b Jonathan Worthington Fix sized int/num returns.
authored
123 nqp::nativecall(nqp::p6decont(map_return_type($r.returns)), self,
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
124 nqp::getattr(nqp::p6decont($args), Capture, '$!list'))
8e36c74 Jonathan Worthington CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
125 }
126 }
127
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
128 # Role for carrying extra calling convention information.
129 my role NativeCallingConvention[$name] {
130 method native_call_convention() { $name };
131 }
d907f71 Martin Berends [lib/NativeCall.pm6] add patch provided by pmichaud++
mberends authored
132
d22dd75 Jonathan Worthington Better string support, including multiple encodings.
authored
133 # Role for carrying extra string encoding information.
134 my role NativeCallEncoded[$name] {
135 method native_call_encoded() { $name };
136 }
137
4561a4f Jonathan Worthington Support opaque pointers in NativeCall.
authored
138 # Expose an OpaquePointer class for working with raw pointers.
3228da6 Moritz Lenz add export tags
moritz authored
139 my class OpaquePointer is export(:types, :DEFAULT) is repr('CPointer') { }
4561a4f Jonathan Worthington Support opaque pointers in NativeCall.
authored
140
6803a5a Jonathan Worthington Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
141 # CArray class, used to represent C arrays.
3228da6 Moritz Lenz add export tags
moritz authored
142 my class CArray is export(:types, :DEFAULT) is repr('CArray') {
9d96c04 Moritz Lenz now that we have autoviv, our at_pos invocants need to be defined to avo...
moritz authored
143 method at_pos(CArray:D: $pos) { die "CArray cannot be used without a type" }
6803a5a Jonathan Worthington Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
144
145 my role IntTypedCArray[::TValue] does Positional[TValue] {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
146 multi method at_pos(::?CLASS:D \arr: $pos) is rw {
9ae5ba5 Jonathan Worthington Support creating and passing arrays to C also.
authored
147 Proxy.new:
148 FETCH => method () {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
149 nqp::p6box_i(nqp::r_atpos_i(arr, nqp::unbox_i($pos.Int)))
9ae5ba5 Jonathan Worthington Support creating and passing arrays to C also.
authored
150 },
151 STORE => method (int $v) {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
152 nqp::r_bindpos_i(arr, nqp::unbox_i($pos.Int), $v);
9ae5ba5 Jonathan Worthington Support creating and passing arrays to C also.
authored
153 self
154 }
6803a5a Jonathan Worthington Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
155 }
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
156 multi method at_pos(::?CLASS:D \arr: int $pos) is rw {
9ae5ba5 Jonathan Worthington Support creating and passing arrays to C also.
authored
157 Proxy.new:
158 FETCH => method () {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
159 nqp::p6box_i(nqp::r_atpos_i(arr, $pos))
9ae5ba5 Jonathan Worthington Support creating and passing arrays to C also.
authored
160 },
161 STORE => method (int $v) {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
162 nqp::r_bindpos_i(arr, $pos, $v);
9ae5ba5 Jonathan Worthington Support creating and passing arrays to C also.
authored
163 self
164 }
6803a5a Jonathan Worthington Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
165 }
166 }
167 multi method PARAMETERIZE_TYPE(Int:U $t) {
168 self but IntTypedCArray[$t.WHAT]
169 }
170
171 my role NumTypedCArray[::TValue] does Positional[TValue] {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
172 multi method at_pos(::?CLASS:D \arr: $pos) is rw {
9ae5ba5 Jonathan Worthington Support creating and passing arrays to C also.
authored
173 Proxy.new:
174 FETCH => method () {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
175 nqp::p6box_n(nqp::r_atpos_n(arr, nqp::unbox_i($pos.Int)))
9ae5ba5 Jonathan Worthington Support creating and passing arrays to C also.
authored
176 },
177 STORE => method (num $v) {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
178 nqp::r_bindpos_n(arr, nqp::unbox_i($pos.Int), $v);
9ae5ba5 Jonathan Worthington Support creating and passing arrays to C also.
authored
179 self
180 }
6803a5a Jonathan Worthington Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
181 }
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
182 multi method at_pos(::?CLASS:D \arr: int $pos) is rw {
9ae5ba5 Jonathan Worthington Support creating and passing arrays to C also.
authored
183 Proxy.new:
184 FETCH => method () {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
185 nqp::p6box_n(nqp::r_atpos_n(arr, $pos))
9ae5ba5 Jonathan Worthington Support creating and passing arrays to C also.
authored
186 },
187 STORE => method (num $v) {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
188 nqp::r_bindpos_n(arr, $pos, $v);
9ae5ba5 Jonathan Worthington Support creating and passing arrays to C also.
authored
189 self
190 }
6803a5a Jonathan Worthington Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
191 }
192 }
193 multi method PARAMETERIZE_TYPE(Num:U $t) {
194 self but NumTypedCArray[$t.WHAT]
195 }
731f841 Jonathan Worthington NativeCall library additions to prepare for arrays of strings.
authored
196
197 my role TypedCArray[::TValue] does Positional[TValue] {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
198 multi method at_pos(::?CLASS:D \arr: $pos) is rw {
731f841 Jonathan Worthington NativeCall library additions to prepare for arrays of strings.
authored
199 Proxy.new:
200 FETCH => method () {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
201 nqp::r_atpos(arr, nqp::unbox_i($pos.Int))
731f841 Jonathan Worthington NativeCall library additions to prepare for arrays of strings.
authored
202 },
203 STORE => method ($v) {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
204 nqp::r_bindpos(arr, nqp::unbox_i($pos.Int), nqp::p6decont($v));
731f841 Jonathan Worthington NativeCall library additions to prepare for arrays of strings.
authored
205 self
206 }
207 }
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
208 multi method at_pos(::?CLASS:D \arr: int $pos) is rw {
731f841 Jonathan Worthington NativeCall library additions to prepare for arrays of strings.
authored
209 Proxy.new:
210 FETCH => method () {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
211 nqp::r_atpos(arr, $pos)
731f841 Jonathan Worthington NativeCall library additions to prepare for arrays of strings.
authored
212 },
213 STORE => method ($v) {
3f79122 Arne Skjærholt Eliminate warnings from updated Rakudo.
arnsholt authored
214 nqp::r_bindpos(arr, $pos, nqp::p6decont($v));
731f841 Jonathan Worthington NativeCall library additions to prepare for arrays of strings.
authored
215 self
216 }
217 }
218 }
219 multi method PARAMETERIZE_TYPE(Mu:U $t) {
220 die "A C array can only hold integers, numbers, strings, CStructs, CPointers or CArrays (not $t.perl())"
221 unless $t === Str || $t.REPR eq 'CStruct' | 'CPointer' | 'CArray';
222 self but TypedCArray[$t.WHAT]
223 }
6803a5a Jonathan Worthington Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
224 }
225
3228da6 Moritz Lenz add export tags
moritz authored
226 multi trait_mod:<is>(Routine $r, :$symbol!) is export(:DEFAULT, :traits) {
bc26b5e Arne Skjærholt Clean up pull request. As discussed on #perl6.
arnsholt authored
227 $r does NativeCallSymbol[$symbol];
eb3e3d8 Jonathan Scott Duff Add a way to name native routines
perlpilot authored
228 }
229
bcbdb85 Jonathan Worthington Overload of the native trait_mod that handles the 'call in current execu...
authored
230 # Specifies that the routine is actually a native call, into the
d419ffa Moritz Lenz adapt to updated trait calling conventions
moritz authored
231 # current executable (platform specific) or into a named library
3228da6 Moritz Lenz add export tags
moritz authored
232 multi trait_mod:<is>(Routine $r, :$native!) is export(:DEFAULT, :traits) {
d419ffa Moritz Lenz adapt to updated trait calling conventions
moritz authored
233 $r does Native[$r, $native === True ?? Str !! $native];
bcbdb85 Jonathan Worthington Overload of the native trait_mod that handles the 'call in current execu...
authored
234 }
235
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
236 # Specifies the calling convention to use for a native call.
3228da6 Moritz Lenz add export tags
moritz authored
237 multi trait_mod:<is>(Routine $r, :$nativeconv!) is export(:DEFAULT, :traits) {
a78f01d Moritz Lenz update calling convention of other traits too
moritz authored
238 $r does NativeCallingConvention[$nativeconv];
898c645 Jonathan Worthington Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
239 }
d22dd75 Jonathan Worthington Better string support, including multiple encodings.
authored
240
241 # Ways to specify how to marshall strings.
3228da6 Moritz Lenz add export tags
moritz authored
242 multi trait_mod:<is>(Parameter $p, :$encoded!) is export(:DEFAULT, :traits) {
a78f01d Moritz Lenz update calling convention of other traits too
moritz authored
243 $p does NativeCallEncoded[$encoded];
d22dd75 Jonathan Worthington Better string support, including multiple encodings.
authored
244 }
3228da6 Moritz Lenz add export tags
moritz authored
245 multi trait_mod:<is>(Routine $p, :$encoded!) is export(:DEFAULT, :traits) {
a78f01d Moritz Lenz update calling convention of other traits too
moritz authored
246 $p does NativeCallEncoded[$encoded];
d22dd75 Jonathan Worthington Better string support, including multiple encodings.
authored
247 }
8619523 Arne Skjærholt Add vim modeline to NativeCall.pm6.
arnsholt authored
248
216d11c Arne Skjærholt Pass encoding parameter to CStr representation.
arnsholt authored
249 class CStr is repr('CStr') {
250 my role Encoding[$encoding] {
251 method encoding() { $encoding }
252 }
253
254 multi method PARAMETERIZE_TYPE(Str:D $encoding) {
255 die "Unknown string encoding for native call: $encoding" if not $encoding eq any('utf8', 'utf16', 'ascii');
256 self but Encoding[$encoding];
257 }
258 }
259
260 role ExplicitlyManagedString {
261 has CStr $.cstr is rw;
262 }
263
3228da6 Moritz Lenz add export tags
moritz authored
264 multi explicitly-manage(Str $x is rw, :$encoding = 'utf8') is export(:DEFAULT,
265 :utils) {
216d11c Arne Skjærholt Pass encoding parameter to CStr representation.
arnsholt authored
266 $x does ExplicitlyManagedString;
267 $x.cstr = pir::repr_box_str__PsP(nqp::unbox_s($x), CStr[$encoding]);
e94f45c Arne Skjærholt Tests and support functions for explicitly managing strings.
arnsholt authored
268 }
269
3228da6 Moritz Lenz add export tags
moritz authored
270 multi refresh($obj) is export(:DEFAULT, :utils) {
3bf6712 Arne Skjærholt Expose refresh op through function, tests for refresh().
arnsholt authored
271 nqp::nativecallrefresh($obj);
272 1;
273 }
274
8619523 Arne Skjærholt Add vim modeline to NativeCall.pm6.
arnsholt authored
275 # vim:ft=perl6
Something went wrong with that request. Please try again.