Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 276 lines (247 sloc) 9.583 kB
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
1 module NativeCall;
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub i…
authored
2
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
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 i…
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 s…
authored
17 # Builds a hash of type information for the specified parameter.
46d9cce @arnsholt Functionality and tests for callbacks.
arnsholt authored
18 sub param_hash_for(Parameter $p, :$with-typeobj) {
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
19 my Mu $result := nqp::hash();
d22dd75 @jnthn Better string support, including multiple encodings.
authored
20 my $type := $p.type();
46d9cce @arnsholt Functionality and tests for callbacks.
arnsholt authored
21 nqp::bindkey($result, 'typeobj', $type) if $with-typeobj;
d22dd75 @jnthn 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 @arnsholt 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 @arnsholt Change to right Parameter accessor for signatures.
arnsholt authored
29 my $info := param_list_for($p.sub_signature, :with-typeobj);
79429d9 @arnsholt Return values from callbacks seem to work now as well.
arnsholt authored
30 nqp::unshift($info, return_hash_for($p.sub_signature));
46d9cce @arnsholt Functionality and tests for callbacks.
arnsholt authored
31 nqp::bindkey($result, 'callback_args', $info);
32 }
d22dd75 @jnthn Better string support, including multiple encodings.
authored
33 else {
34 nqp::bindkey($result, 'type', nqp::unbox_s(type_code_for($p.type)));
35 }
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
36 $result
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub i…
authored
37 }
a32dace @jnthn More types, plus CPointer that translates to some abstract pointer-y …
authored
38
46d9cce @arnsholt 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 @arnsholt Unbreak everything.
arnsholt authored
46 $arg_info;
46d9cce @arnsholt Functionality and tests for callbacks.
arnsholt authored
47 }
48
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
49 # Builds a hash of type information for the specified return type.
79429d9 @arnsholt Return values from callbacks seem to work now as well.
arnsholt authored
50 sub return_hash_for(Signature $s) {
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
51 my Mu $result := nqp::hash();
79429d9 @arnsholt Return values from callbacks seem to work now as well.
arnsholt authored
52 my $returns := $s.returns;
d22dd75 @jnthn 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 @arnsholt 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 @jnthn 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 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
64 $result
8525e82 @jnthn Use the declared return type of the routine in signature generation.
authored
65 }
66
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
67 # Gets the NCI type code to use based on a given Perl 6 type.
68 my %type_map =
46d9cce @arnsholt 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 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
79 sub type_code_for(Mu ::T) {
80 return %type_map{T.^name}
81 if %type_map.exists(T.^name);
e293ff0 @jnthn Add CStruct passing support. Improve error message when trying to pas…
authored
82 return 'cstruct'
83 if T.REPR eq 'CStruct';
4561a4f @jnthn Support opaque pointers in NativeCall.
authored
84 return 'cpointer'
85 if T.REPR eq 'CPointer';
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much ye…
authored
86 return 'carray'
87 if T.REPR eq 'CArray';
e293ff0 @jnthn Add CStruct passing support. Improve error message when trying to pas…
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 @jnthn Add some initial experimental code that shows how we can call a Win32…
authored
91 }
92
6424f48 @jnthn Unbust voids.
authored
93 multi sub map_return_type(Mu $type) { Mu }
94 multi sub map_return_type($type) {
64ca08b @jnthn 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 @arnsholt Clean up pull request. As discussed on #perl6.
arnsholt authored
100 my role NativeCallSymbol[Str $name] {
101 method native_symbol() { $name }
eb3e3d8 @perlpilot Add a way to name native routines
perlpilot authored
102 }
103
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
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 @arnsholt Functionality and tests for callbacks.
arnsholt authored
112 my Mu $arg_info := param_list_for($r.signature);
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
113 my str $conv = self.?native_call_convention || '';
aa0436c @arnsholt Update library name handling to NQP handling extensions.
arnsholt authored
114 my $realname = !$libname.DEFINITE ?? "" !! $libname;
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
115 nqp::buildnativecall(self,
b3e94c4 @jnthn Restore auto-appending the .dll or .so rather than requiring it be me…
authored
116 nqp::unbox_s($realname), # library name
bc26b5e @arnsholt Clean up pull request. As discussed on #perl6.
arnsholt authored
117 nqp::unbox_s(self.?native_symbol // $r.name), # symbol to call
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
118 nqp::unbox_s($conv), # calling convention
119 $arg_info,
79429d9 @arnsholt Return values from callbacks seem to work now as well.
arnsholt authored
120 return_hash_for($r.signature));
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
121 $!setup = 1;
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub i…
authored
122 }
64ca08b @jnthn Fix sized int/num returns.
authored
123 nqp::nativecall(nqp::p6decont(map_return_type($r.returns)), self,
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
124 nqp::getattr(nqp::p6decont($args), Capture, '$!list'))
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub i…
authored
125 }
126 }
127
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
128 # Role for carrying extra calling convention information.
129 my role NativeCallingConvention[$name] {
130 method native_call_convention() { $name };
131 }
d907f71 @mberends [lib/NativeCall.pm6] add patch provided by pmichaud++
mberends authored
132
d22dd75 @jnthn 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 @jnthn Support opaque pointers in NativeCall.
authored
138 # Expose an OpaquePointer class for working with raw pointers.
3228da6 @moritz add export tags
moritz authored
139 my class OpaquePointer is export(:types, :DEFAULT) is repr('CPointer') { }
4561a4f @jnthn Support opaque pointers in NativeCall.
authored
140
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much ye…
authored
141 # CArray class, used to represent C arrays.
3228da6 @moritz add export tags
moritz authored
142 my class CArray is export(:types, :DEFAULT) is repr('CArray') {
9d96c04 @moritz now that we have autoviv, our at_pos invocants need to be defined to …
moritz authored
143 method at_pos(CArray:D: $pos) { die "CArray cannot be used without a type" }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much ye…
authored
144
145 my role IntTypedCArray[::TValue] does Positional[TValue] {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
146 multi method at_pos(::?CLASS:D \arr: $pos) is rw {
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
147 Proxy.new:
148 FETCH => method () {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
149 nqp::p6box_i(nqp::r_atpos_i(arr, nqp::unbox_i($pos.Int)))
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
150 },
151 STORE => method (int $v) {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
152 nqp::r_bindpos_i(arr, nqp::unbox_i($pos.Int), $v);
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
153 self
154 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much ye…
authored
155 }
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
156 multi method at_pos(::?CLASS:D \arr: int $pos) is rw {
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
157 Proxy.new:
158 FETCH => method () {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
159 nqp::p6box_i(nqp::r_atpos_i(arr, $pos))
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
160 },
161 STORE => method (int $v) {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
162 nqp::r_bindpos_i(arr, $pos, $v);
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
163 self
164 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much ye…
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 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
172 multi method at_pos(::?CLASS:D \arr: $pos) is rw {
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
173 Proxy.new:
174 FETCH => method () {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
175 nqp::p6box_n(nqp::r_atpos_n(arr, nqp::unbox_i($pos.Int)))
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
176 },
177 STORE => method (num $v) {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
178 nqp::r_bindpos_n(arr, nqp::unbox_i($pos.Int), $v);
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
179 self
180 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much ye…
authored
181 }
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
182 multi method at_pos(::?CLASS:D \arr: int $pos) is rw {
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
183 Proxy.new:
184 FETCH => method () {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
185 nqp::p6box_n(nqp::r_atpos_n(arr, $pos))
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
186 },
187 STORE => method (num $v) {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
188 nqp::r_bindpos_n(arr, $pos, $v);
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
189 self
190 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much ye…
authored
191 }
192 }
193 multi method PARAMETERIZE_TYPE(Num:U $t) {
194 self but NumTypedCArray[$t.WHAT]
195 }
731f841 @jnthn NativeCall library additions to prepare for arrays of strings.
authored
196
197 my role TypedCArray[::TValue] does Positional[TValue] {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
198 multi method at_pos(::?CLASS:D \arr: $pos) is rw {
731f841 @jnthn NativeCall library additions to prepare for arrays of strings.
authored
199 Proxy.new:
200 FETCH => method () {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
201 nqp::r_atpos(arr, nqp::unbox_i($pos.Int))
731f841 @jnthn NativeCall library additions to prepare for arrays of strings.
authored
202 },
203 STORE => method ($v) {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
204 nqp::r_bindpos(arr, nqp::unbox_i($pos.Int), nqp::p6decont($v));
731f841 @jnthn NativeCall library additions to prepare for arrays of strings.
authored
205 self
206 }
207 }
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
208 multi method at_pos(::?CLASS:D \arr: int $pos) is rw {
731f841 @jnthn NativeCall library additions to prepare for arrays of strings.
authored
209 Proxy.new:
210 FETCH => method () {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
211 nqp::r_atpos(arr, $pos)
731f841 @jnthn NativeCall library additions to prepare for arrays of strings.
authored
212 },
213 STORE => method ($v) {
3f79122 @arnsholt Eliminate warnings from updated Rakudo.
arnsholt authored
214 nqp::r_bindpos(arr, $pos, nqp::p6decont($v));
731f841 @jnthn 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 @jnthn Put in first few bits of C array handling support. Doesn't do much ye…
authored
224 }
225
3228da6 @moritz add export tags
moritz authored
226 multi trait_mod:<is>(Routine $r, :$symbol!) is export(:DEFAULT, :traits) {
bc26b5e @arnsholt Clean up pull request. As discussed on #perl6.
arnsholt authored
227 $r does NativeCallSymbol[$symbol];
eb3e3d8 @perlpilot Add a way to name native routines
perlpilot authored
228 }
229
bcbdb85 @jnthn Overload of the native trait_mod that handles the 'call in current ex…
authored
230 # Specifies that the routine is actually a native call, into the
d419ffa @moritz adapt to updated trait calling conventions
moritz authored
231 # current executable (platform specific) or into a named library
3228da6 @moritz add export tags
moritz authored
232 multi trait_mod:<is>(Routine $r, :$native!) is export(:DEFAULT, :traits) {
d419ffa @moritz adapt to updated trait calling conventions
moritz authored
233 $r does Native[$r, $native === True ?? Str !! $native];
bcbdb85 @jnthn Overload of the native trait_mod that handles the 'call in current ex…
authored
234 }
235
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
236 # Specifies the calling convention to use for a native call.
3228da6 @moritz add export tags
moritz authored
237 multi trait_mod:<is>(Routine $r, :$nativeconv!) is export(:DEFAULT, :traits) {
a78f01d @moritz update calling convention of other traits too
moritz authored
238 $r does NativeCallingConvention[$nativeconv];
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
authored
239 }
d22dd75 @jnthn Better string support, including multiple encodings.
authored
240
241 # Ways to specify how to marshall strings.
3228da6 @moritz add export tags
moritz authored
242 multi trait_mod:<is>(Parameter $p, :$encoded!) is export(:DEFAULT, :traits) {
a78f01d @moritz update calling convention of other traits too
moritz authored
243 $p does NativeCallEncoded[$encoded];
d22dd75 @jnthn Better string support, including multiple encodings.
authored
244 }
3228da6 @moritz add export tags
moritz authored
245 multi trait_mod:<is>(Routine $p, :$encoded!) is export(:DEFAULT, :traits) {
a78f01d @moritz update calling convention of other traits too
moritz authored
246 $p does NativeCallEncoded[$encoded];
d22dd75 @jnthn Better string support, including multiple encodings.
authored
247 }
8619523 @arnsholt Add vim modeline to NativeCall.pm6.
arnsholt authored
248
216d11c @arnsholt 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 add export tags
moritz authored
264 multi explicitly-manage(Str $x is rw, :$encoding = 'utf8') is export(:DEFAULT,
265 :utils) {
216d11c @arnsholt 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 @arnsholt Tests and support functions for explicitly managing strings.
arnsholt authored
268 }
269
3228da6 @moritz add export tags
moritz authored
270 multi refresh($obj) is export(:DEFAULT, :utils) {
3bf6712 @arnsholt Expose refresh op through function, tests for refresh().
arnsholt authored
271 nqp::nativecallrefresh($obj);
272 1;
273 }
274
8619523 @arnsholt Add vim modeline to NativeCall.pm6.
arnsholt authored
275 # vim:ft=perl6
Something went wrong with that request. Please try again.