Skip to content
This repository
Newer
Older
100644 233 lines (213 sloc) 8.12 kb
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
1 module NativeCall;
8e36c743 »
2010-03-03 CPointer becomes OpaquePointer for better naming win; start to stub i…
2
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
3 # Throwaway type just to get us some way to get at the NativeCall
4 # representation.
5 my class native_callsite is repr('NativeCall') { }
8e36c743 »
2010-03-03 CPointer becomes OpaquePointer for better naming win; start to stub i…
6
d22dd75a »
2011-11-27 Better string support, including multiple encodings.
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
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
17 # Builds a hash of type information for the specified parameter.
18 sub param_hash_for(Parameter $p) {
19 my Mu $result := nqp::hash();
d22dd75a »
2011-11-27 Better string support, including multiple encodings.
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 }
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
29 $result
8e36c743 »
2010-03-03 CPointer becomes OpaquePointer for better naming win; start to stub i…
30 }
a32dace9 »
2010-03-02 More types, plus CPointer that translates to some abstract pointer-y …
31
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
32 # Builds a hash of type information for the specified return type.
d22dd75a »
2011-11-27 Better string support, including multiple encodings.
33 sub return_hash_for(&r) {
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
34 my Mu $result := nqp::hash();
d22dd75a »
2011-11-27 Better string support, including multiple encodings.
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 }
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
45 $result
8525e82e »
2010-03-03 Use the declared return type of the routine in signature generation.
46 }
47
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
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',
d22dd75a »
2011-11-27 Better string support, including multiple encodings.
58 'Num' => 'double';
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
59 sub type_code_for(Mu ::T) {
60 return %type_map{T.^name}
61 if %type_map.exists(T.^name);
e293ff0a »
2011-11-27 Add CStruct passing support. Improve error message when trying to pas…
62 return 'cstruct'
63 if T.REPR eq 'CStruct';
4561a4f4 »
2011-11-28 Support opaque pointers in NativeCall.
64 return 'cpointer'
65 if T.REPR eq 'CPointer';
6803a5aa »
2011-12-18 Put in first few bits of C array handling support. Doesn't do much ye…
66 return 'carray'
67 if T.REPR eq 'CArray';
e293ff0a »
2011-11-27 Add CStruct passing support. Improve error message when trying to pas…
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.";
bd56459f »
2010-03-02 Add some initial experimental code that shows how we can call a Win32…
71 }
72
6424f48f »
2012-01-13 Unbust voids.
73 multi sub map_return_type(Mu $type) { Mu }
74 multi sub map_return_type($type) {
64ca08bd »
2012-01-13 Fix sized int/num returns.
75 $type === int8 || $type === int16 || $type === int32 || $type === int ?? Int !!
76 $type === num32 || $type === num64 || $type === num ?? Num !!
77 $type
78 }
79
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
80 # This role is mixed in to any routine that is marked as being a
81 # native call.
82 my role Native[Routine $r, Str $libname] {
83 has int $!setup;
84 has native_callsite $!call is box_target;
85
86 method postcircumfix:<( )>($args) {
87 unless $!setup {
88 my Mu $arg_info := nqp::list();
89 for $r.signature.params -> $p {
90 nqp::push($arg_info, param_hash_for($p))
8e36c743 »
2010-03-03 CPointer becomes OpaquePointer for better naming win; start to stub i…
91 }
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
92 my str $conv = self.?native_call_convention || '';
4ed29aed »
2012-01-13 Fixes to loading from current executing module functionality.
93 my $realname =
94 !$libname.DEFINITE ?? "" !!
95 $libname ~~ /\.\w+$/ ?? $libname !!
96 "$libname$*VM<config><load_ext>";
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
97 nqp::buildnativecall(self,
b3e94c4d »
2012-01-13 Restore auto-appending the .dll or .so rather than requiring it be me…
98 nqp::unbox_s($realname), # library name
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
99 nqp::unbox_s($r.name), # symbol to call
100 nqp::unbox_s($conv), # calling convention
101 $arg_info,
d22dd75a »
2011-11-27 Better string support, including multiple encodings.
102 return_hash_for($r));
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
103 $!setup = 1;
8e36c743 »
2010-03-03 CPointer becomes OpaquePointer for better naming win; start to stub i…
104 }
64ca08bd »
2012-01-13 Fix sized int/num returns.
105 nqp::nativecall(nqp::p6decont(map_return_type($r.returns)), self,
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
106 nqp::getattr(nqp::p6decont($args), Capture, '$!list'))
8e36c743 »
2010-03-03 CPointer becomes OpaquePointer for better naming win; start to stub i…
107 }
108 }
109
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
110 # Role for carrying extra calling convention information.
111 my role NativeCallingConvention[$name] {
112 method native_call_convention() { $name };
113 }
d907f71c » mberends
2011-06-02 [lib/NativeCall.pm6] add patch provided by pmichaud++
114
d22dd75a »
2011-11-27 Better string support, including multiple encodings.
115 # Role for carrying extra string encoding information.
116 my role NativeCallEncoded[$name] {
117 method native_call_encoded() { $name };
118 }
119
4561a4f4 »
2011-11-28 Support opaque pointers in NativeCall.
120 # Expose an OpaquePointer class for working with raw pointers.
121 my class OpaquePointer is export is repr('CPointer') { }
122
6803a5aa »
2011-12-18 Put in first few bits of C array handling support. Doesn't do much ye…
123 # CArray class, used to represent C arrays.
124 my class CArray is export is repr('CArray') {
9d96c04b » moritz
2012-04-21 now that we have autoviv, our at_pos invocants need to be defined to …
125 method at_pos(CArray:D: $pos) { die "CArray cannot be used without a type" }
6803a5aa »
2011-12-18 Put in first few bits of C array handling support. Doesn't do much ye…
126
127 my role IntTypedCArray[::TValue] does Positional[TValue] {
9d96c04b » moritz
2012-04-21 now that we have autoviv, our at_pos invocants need to be defined to …
128 multi method at_pos(::?CLASS:D \$arr: $pos) is rw {
9ae5ba5b »
2011-12-18 Support creating and passing arrays to C also.
129 Proxy.new:
130 FETCH => method () {
131 nqp::p6box_i(nqp::r_atpos_i($arr, nqp::unbox_i($pos.Int)))
132 },
133 STORE => method (int $v) {
134 nqp::r_bindpos_i($arr, nqp::unbox_i($pos.Int), $v);
135 self
136 }
6803a5aa »
2011-12-18 Put in first few bits of C array handling support. Doesn't do much ye…
137 }
9d96c04b » moritz
2012-04-21 now that we have autoviv, our at_pos invocants need to be defined to …
138 multi method at_pos(::?CLASS:D \$arr: int $pos) is rw {
9ae5ba5b »
2011-12-18 Support creating and passing arrays to C also.
139 Proxy.new:
140 FETCH => method () {
141 nqp::p6box_i(nqp::r_atpos_i($arr, $pos))
142 },
143 STORE => method (int $v) {
144 nqp::r_bindpos_i($arr, $pos, $v);
145 self
146 }
6803a5aa »
2011-12-18 Put in first few bits of C array handling support. Doesn't do much ye…
147 }
148 }
149 multi method PARAMETERIZE_TYPE(Int:U $t) {
150 self but IntTypedCArray[$t.WHAT]
151 }
152
153 my role NumTypedCArray[::TValue] does Positional[TValue] {
9d96c04b » moritz
2012-04-21 now that we have autoviv, our at_pos invocants need to be defined to …
154 multi method at_pos(::?CLASS:D \$arr: $pos) is rw {
9ae5ba5b »
2011-12-18 Support creating and passing arrays to C also.
155 Proxy.new:
156 FETCH => method () {
157 nqp::p6box_n(nqp::r_atpos_n($arr, nqp::unbox_i($pos.Int)))
158 },
159 STORE => method (num $v) {
160 nqp::r_bindpos_n($arr, nqp::unbox_i($pos.Int), $v);
161 self
162 }
6803a5aa »
2011-12-18 Put in first few bits of C array handling support. Doesn't do much ye…
163 }
9d96c04b » moritz
2012-04-21 now that we have autoviv, our at_pos invocants need to be defined to …
164 multi method at_pos(::?CLASS:D \$arr: int $pos) is rw {
9ae5ba5b »
2011-12-18 Support creating and passing arrays to C also.
165 Proxy.new:
166 FETCH => method () {
167 nqp::p6box_n(nqp::r_atpos_n($arr, $pos))
168 },
169 STORE => method (num $v) {
170 nqp::r_bindpos_n($arr, $pos, $v);
171 self
172 }
6803a5aa »
2011-12-18 Put in first few bits of C array handling support. Doesn't do much ye…
173 }
174 }
175 multi method PARAMETERIZE_TYPE(Num:U $t) {
176 self but NumTypedCArray[$t.WHAT]
177 }
731f8412 »
2012-01-13 NativeCall library additions to prepare for arrays of strings.
178
179 my role TypedCArray[::TValue] does Positional[TValue] {
9d96c04b » moritz
2012-04-21 now that we have autoviv, our at_pos invocants need to be defined to …
180 multi method at_pos(::?CLASS:D \$arr: $pos) is rw {
731f8412 »
2012-01-13 NativeCall library additions to prepare for arrays of strings.
181 Proxy.new:
182 FETCH => method () {
183 nqp::r_atpos($arr, nqp::unbox_i($pos.Int))
184 },
185 STORE => method ($v) {
186 nqp::r_bindpos($arr, nqp::unbox_i($pos.Int), nqp::p6decont($v));
187 self
188 }
189 }
9d96c04b » moritz
2012-04-21 now that we have autoviv, our at_pos invocants need to be defined to …
190 multi method at_pos(::?CLASS:D \$arr: int $pos) is rw {
731f8412 »
2012-01-13 NativeCall library additions to prepare for arrays of strings.
191 Proxy.new:
192 FETCH => method () {
193 nqp::r_atpos($arr, $pos)
194 },
195 STORE => method ($v) {
196 nqp::r_bindpos($arr, $pos, nqp::p6decont($v));
197 self
198 }
199 }
200 }
201 multi method PARAMETERIZE_TYPE(Mu:U $t) {
202 die "A C array can only hold integers, numbers, strings, CStructs, CPointers or CArrays (not $t.perl())"
203 unless $t === Str || $t.REPR eq 'CStruct' | 'CPointer' | 'CArray';
204 self but TypedCArray[$t.WHAT]
205 }
6803a5aa »
2011-12-18 Put in first few bits of C array handling support. Doesn't do much ye…
206 }
207
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
208 # Specifies that the routine is actually a native call, and gives
209 # the name of the library to load it from.
210 multi trait_mod:<is>(Routine $r, $libname, :$native!) is export {
211 $r does Native[$r, $libname];
bd56459f »
2010-03-02 Add some initial experimental code that shows how we can call a Win32…
212 }
9766cd27 »
2010-04-15 If there's no returns type declared, we assume void return.
213
bcbdb85d »
2012-01-13 Overload of the native trait_mod that handles the 'call in current ex…
214 # Specifies that the routine is actually a native call, into the
215 # current executable (platform specific).
216 multi trait_mod:<is>(Routine $r, :$native!) is export {
217 $r does Native[$r, Str];
218 }
219
898c6457 »
2011-11-24 Add first cut of version 2 of Zavolaj. Doesn't do any pointer/array s…
220 # Specifies the calling convention to use for a native call.
221 multi trait_mod:<is>(Routine $r, $name, :$nativeconv!) is export {
222 $r does NativeCallingConvention[$name];
223 }
d22dd75a »
2011-11-27 Better string support, including multiple encodings.
224
225 # Ways to specify how to marshall strings.
226 multi trait_mod:<is>(Parameter $p, $name, :$encoded!) is export {
227 $p does NativeCallEncoded[$name];
228 }
229 multi trait_mod:<is>(Routine $p, $name, :$encoded!) is export {
230 $p does NativeCallEncoded[$name];
231 }
8619523b » arnsholt
2012-05-01 Add vim modeline to NativeCall.pm6.
232
233 # vim:ft=perl6
Something went wrong with that request. Please try again.