Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 247 lines (224 sloc) 8.438 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
e94f45c @arnsholt Tests and support functions for explicitly managing strings.
arnsholt authored
7 class CStr is export is repr('CStr') { }
8 role ExplicitlyManagedString {
9 has CStr $.cstr is rw;
10 }
11
d22dd75 @jnthn Better string support, including multiple encodings.
authored
12 # Maps a chosen string encoding to a type recognized by the native call engine.
13 sub string_encoding_to_nci_type($enc) {
14 given $enc {
15 when 'utf8' { 'utf8str' }
16 when 'utf16' { 'utf16str' }
17 when 'ascii' { 'asciistr' }
18 default { die "Unknown string encoding for native call: $enc"; }
19 }
20 }
21
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
22 # Builds a hash of type information for the specified parameter.
23 sub param_hash_for(Parameter $p) {
24 my Mu $result := nqp::hash();
d22dd75 @jnthn Better string support, including multiple encodings.
authored
25 my $type := $p.type();
26 if $type ~~ Str {
27 my $enc := $p.?native_call_encoded() || 'utf8';
28 nqp::bindkey($result, 'type', nqp::unbox_s(string_encoding_to_nci_type($enc)));
29 nqp::bindkey($result, 'free_str', nqp::unbox_i(1));
30 }
31 else {
32 nqp::bindkey($result, 'type', nqp::unbox_s(type_code_for($p.type)));
33 }
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
34 $result
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
35 }
a32dace @jnthn More types, plus CPointer that translates to some abstract pointer-y thi...
authored
36
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
37 # Builds a hash of type information for the specified return type.
d22dd75 @jnthn Better string support, including multiple encodings.
authored
38 sub return_hash_for(&r) {
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
39 my Mu $result := nqp::hash();
d22dd75 @jnthn Better string support, including multiple encodings.
authored
40 my $returns := &r.returns;
41 if $returns ~~ Str {
42 my $enc := &r.?native_call_encoded() || 'utf8';
43 nqp::bindkey($result, 'type', nqp::unbox_s(string_encoding_to_nci_type($enc)));
44 nqp::bindkey($result, 'free_str', nqp::unbox_i(0));
45 }
46 else {
47 nqp::bindkey($result, 'type',
48 $returns =:= Mu ?? 'void' !! nqp::unbox_s(type_code_for($returns)));
49 }
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
50 $result
8525e82 @jnthn Use the declared return type of the routine in signature generation.
authored
51 }
52
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
53 # Gets the NCI type code to use based on a given Perl 6 type.
54 my %type_map =
55 'int8' => 'char',
56 'int16' => 'short',
57 'int32' => 'int',
58 'int' => 'long',
59 'Int' => 'longlong',
60 'num32' => 'float',
61 'num64' => 'double',
62 'num' => 'double',
d22dd75 @jnthn Better string support, including multiple encodings.
authored
63 'Num' => 'double';
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
64 sub type_code_for(Mu ::T) {
65 return %type_map{T.^name}
66 if %type_map.exists(T.^name);
e293ff0 @jnthn Add CStruct passing support. Improve error message when trying to pass a...
authored
67 return 'cstruct'
68 if T.REPR eq 'CStruct';
4561a4f @jnthn Support opaque pointers in NativeCall.
authored
69 return 'cpointer'
70 if T.REPR eq 'CPointer';
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
71 return 'carray'
72 if T.REPR eq 'CArray';
e293ff0 @jnthn Add CStruct passing support. Improve error message when trying to pass a...
authored
73 die "Unknown type {T.^name} used in native call.\n" ~
74 "If you want to pass a struct, be sure to use the CStruct representation.\n" ~
75 "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
76 }
77
6424f48 @jnthn Unbust voids.
authored
78 multi sub map_return_type(Mu $type) { Mu }
79 multi sub map_return_type($type) {
64ca08b @jnthn Fix sized int/num returns.
authored
80 $type === int8 || $type === int16 || $type === int32 || $type === int ?? Int !!
81 $type === num32 || $type === num64 || $type === num ?? Num !!
82 $type
83 }
84
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
85 # This role is mixed in to any routine that is marked as being a
86 # native call.
87 my role Native[Routine $r, Str $libname] {
88 has int $!setup;
89 has native_callsite $!call is box_target;
90
91 method postcircumfix:<( )>($args) {
92 unless $!setup {
93 my Mu $arg_info := nqp::list();
94 for $r.signature.params -> $p {
95 nqp::push($arg_info, param_hash_for($p))
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 my str $conv = self.?native_call_convention || '';
4ed29ae @jnthn Fixes to loading from current executing module functionality.
authored
98 my $realname =
99 !$libname.DEFINITE ?? "" !!
100 $libname ~~ /\.\w+$/ ?? $libname !!
101 "$libname$*VM<config><load_ext>";
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
102 nqp::buildnativecall(self,
b3e94c4 @jnthn Restore auto-appending the .dll or .so rather than requiring it be menti...
authored
103 nqp::unbox_s($realname), # library name
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
104 nqp::unbox_s($r.name), # symbol to call
105 nqp::unbox_s($conv), # calling convention
106 $arg_info,
d22dd75 @jnthn Better string support, including multiple encodings.
authored
107 return_hash_for($r));
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
108 $!setup = 1;
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
109 }
64ca08b @jnthn Fix sized int/num returns.
authored
110 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 stuf...
authored
111 nqp::getattr(nqp::p6decont($args), Capture, '$!list'))
8e36c74 @jnthn CPointer becomes OpaquePointer for better naming win; start to stub in s...
authored
112 }
113 }
114
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
115 # Role for carrying extra calling convention information.
116 my role NativeCallingConvention[$name] {
117 method native_call_convention() { $name };
118 }
d907f71 @mberends [lib/NativeCall.pm6] add patch provided by pmichaud++
mberends authored
119
d22dd75 @jnthn Better string support, including multiple encodings.
authored
120 # Role for carrying extra string encoding information.
121 my role NativeCallEncoded[$name] {
122 method native_call_encoded() { $name };
123 }
124
4561a4f @jnthn Support opaque pointers in NativeCall.
authored
125 # Expose an OpaquePointer class for working with raw pointers.
126 my class OpaquePointer is export is repr('CPointer') { }
127
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
128 # CArray class, used to represent C arrays.
129 my class CArray is export is repr('CArray') {
9d96c04 @moritz now that we have autoviv, our at_pos invocants need to be defined to avo...
moritz authored
130 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 yet, ...
authored
131
132 my role IntTypedCArray[::TValue] does Positional[TValue] {
9d96c04 @moritz now that we have autoviv, our at_pos invocants need to be defined to avo...
moritz authored
133 multi method at_pos(::?CLASS:D \$arr: $pos) is rw {
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
134 Proxy.new:
135 FETCH => method () {
136 nqp::p6box_i(nqp::r_atpos_i($arr, nqp::unbox_i($pos.Int)))
137 },
138 STORE => method (int $v) {
139 nqp::r_bindpos_i($arr, nqp::unbox_i($pos.Int), $v);
140 self
141 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
142 }
9d96c04 @moritz now that we have autoviv, our at_pos invocants need to be defined to avo...
moritz authored
143 multi method at_pos(::?CLASS:D \$arr: int $pos) is rw {
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
144 Proxy.new:
145 FETCH => method () {
146 nqp::p6box_i(nqp::r_atpos_i($arr, $pos))
147 },
148 STORE => method (int $v) {
149 nqp::r_bindpos_i($arr, $pos, $v);
150 self
151 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
152 }
153 }
154 multi method PARAMETERIZE_TYPE(Int:U $t) {
155 self but IntTypedCArray[$t.WHAT]
156 }
157
158 my role NumTypedCArray[::TValue] does Positional[TValue] {
9d96c04 @moritz now that we have autoviv, our at_pos invocants need to be defined to avo...
moritz authored
159 multi method at_pos(::?CLASS:D \$arr: $pos) is rw {
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
160 Proxy.new:
161 FETCH => method () {
162 nqp::p6box_n(nqp::r_atpos_n($arr, nqp::unbox_i($pos.Int)))
163 },
164 STORE => method (num $v) {
165 nqp::r_bindpos_n($arr, nqp::unbox_i($pos.Int), $v);
166 self
167 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
168 }
9d96c04 @moritz now that we have autoviv, our at_pos invocants need to be defined to avo...
moritz authored
169 multi method at_pos(::?CLASS:D \$arr: int $pos) is rw {
9ae5ba5 @jnthn Support creating and passing arrays to C also.
authored
170 Proxy.new:
171 FETCH => method () {
172 nqp::p6box_n(nqp::r_atpos_n($arr, $pos))
173 },
174 STORE => method (num $v) {
175 nqp::r_bindpos_n($arr, $pos, $v);
176 self
177 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
178 }
179 }
180 multi method PARAMETERIZE_TYPE(Num:U $t) {
181 self but NumTypedCArray[$t.WHAT]
182 }
731f841 @jnthn NativeCall library additions to prepare for arrays of strings.
authored
183
184 my role TypedCArray[::TValue] does Positional[TValue] {
9d96c04 @moritz now that we have autoviv, our at_pos invocants need to be defined to avo...
moritz authored
185 multi method at_pos(::?CLASS:D \$arr: $pos) is rw {
731f841 @jnthn NativeCall library additions to prepare for arrays of strings.
authored
186 Proxy.new:
187 FETCH => method () {
188 nqp::r_atpos($arr, nqp::unbox_i($pos.Int))
189 },
190 STORE => method ($v) {
191 nqp::r_bindpos($arr, nqp::unbox_i($pos.Int), nqp::p6decont($v));
192 self
193 }
194 }
9d96c04 @moritz now that we have autoviv, our at_pos invocants need to be defined to avo...
moritz authored
195 multi method at_pos(::?CLASS:D \$arr: int $pos) is rw {
731f841 @jnthn NativeCall library additions to prepare for arrays of strings.
authored
196 Proxy.new:
197 FETCH => method () {
198 nqp::r_atpos($arr, $pos)
199 },
200 STORE => method ($v) {
201 nqp::r_bindpos($arr, $pos, nqp::p6decont($v));
202 self
203 }
204 }
205 }
206 multi method PARAMETERIZE_TYPE(Mu:U $t) {
207 die "A C array can only hold integers, numbers, strings, CStructs, CPointers or CArrays (not $t.perl())"
208 unless $t === Str || $t.REPR eq 'CStruct' | 'CPointer' | 'CArray';
209 self but TypedCArray[$t.WHAT]
210 }
6803a5a @jnthn Put in first few bits of C array handling support. Doesn't do much yet, ...
authored
211 }
212
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
213 # Specifies that the routine is actually a native call, and gives
214 # the name of the library to load it from.
215 multi trait_mod:<is>(Routine $r, $libname, :$native!) is export {
216 $r does Native[$r, $libname];
bd56459 @jnthn Add some initial experimental code that shows how we can call a Win32 AP...
authored
217 }
9766cd2 @jnthn If there's no returns type declared, we assume void return.
authored
218
bcbdb85 @jnthn Overload of the native trait_mod that handles the 'call in current execu...
authored
219 # Specifies that the routine is actually a native call, into the
220 # current executable (platform specific).
221 multi trait_mod:<is>(Routine $r, :$native!) is export {
222 $r does Native[$r, Str];
223 }
224
898c645 @jnthn Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array stuf...
authored
225 # Specifies the calling convention to use for a native call.
226 multi trait_mod:<is>(Routine $r, $name, :$nativeconv!) is export {
227 $r does NativeCallingConvention[$name];
228 }
d22dd75 @jnthn Better string support, including multiple encodings.
authored
229
230 # Ways to specify how to marshall strings.
231 multi trait_mod:<is>(Parameter $p, $name, :$encoded!) is export {
232 $p does NativeCallEncoded[$name];
233 }
234 multi trait_mod:<is>(Routine $p, $name, :$encoded!) is export {
235 $p does NativeCallEncoded[$name];
236 }
8619523 @arnsholt Add vim modeline to NativeCall.pm6.
arnsholt authored
237
e94f45c @arnsholt Tests and support functions for explicitly managing strings.
arnsholt authored
238 # TODO: Encodings
239 multi explicitly-manage(Str $s) is export {
240 $s does ExplicitlyManagedString;
241 # repr_box_str
242 #$s.cstr = nqp::unbox_s($s);
243 $s.cstr = pir::repr_box_str__PsP(nqp::unbox_s($s), CStr);
244 }
245
8619523 @arnsholt Add vim modeline to NativeCall.pm6.
arnsholt authored
246 # vim:ft=perl6
Something went wrong with that request. Please try again.