Permalink
Switch branches/tags
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
255 lines (232 sloc) 9.71 KB
use nqp;
unit module NativeCall::Types;
sub nativecast($target-type, $source) {
nqp::nativecallcast(nqp::decont($target-type),
nqp::decont(map_return_type($target-type)), nqp::decont($source));
}
our native long is Int is ctype("long") is repr("P6int") { };
our native longlong is Int is ctype("longlong") is repr("P6int") { };
our native ulong is Int is ctype("long") is unsigned is repr("P6int") { };
our native ulonglong is Int is ctype("longlong") is unsigned is repr("P6int") { };
our native size_t is Int is ctype("size_t") is unsigned is repr("P6int") { };
our native ssize_t is Int is ctype("size_t") is repr("P6int") { };
our native bool is Int is ctype("bool") is repr("P6int") { };
our class void is repr('Uninstantiable') { };
# Expose a Pointer class for working with raw pointers.
our class Pointer is repr('CPointer') {
method of() { void }
multi method new() {
self.CREATE()
}
multi method new(int $addr) {
nqp::box_i($addr, ::?CLASS)
}
multi method new(Int $addr) {
nqp::box_i(nqp::unbox_i(nqp::decont($addr)), ::?CLASS)
}
method Numeric(::?CLASS:D:) { self.Int }
method Int(::?CLASS:D:) {
nqp::p6box_i(nqp::unbox_i(nqp::decont(self)))
}
proto method Bool() {*}
multi method Bool(::?CLASS:U: --> False) { }
multi method Bool(::?CLASS:D:) { so self.Int }
method deref(::?CLASS:D \ptr:) { self ?? nativecast(void, ptr) !! fail("Can't dereference a Null Pointer") }
multi method gist(::?CLASS:U:) { '(' ~ self.^name ~ ')' }
multi method gist(::?CLASS:D:) {
if self.Int -> $addr {
self.^name ~ '<' ~ $addr.fmt('%#x') ~ '>'
}
else {
self.^name ~ '<NULL>'
}
}
multi method perl(::?CLASS:U:) { self.^name }
multi method perl(::?CLASS:D:) { self.^name ~ '.new(' ~ self.Int ~ ')' }
my role TypedPointer[::TValue] {
method of() { TValue }
method deref(::?CLASS:D \ptr:) { self ?? nativecast(TValue, ptr) !! fail("Can't dereference a Null Pointer"); }
method add(Int $off) returns Pointer {
die "Can't do arithmetic with a void pointer"
if TValue.isa(void);
nqp::box_i(self.Int + nqp::nativecallsizeof(TValue) * $off, self.WHAT);
}
method succ {
self.add(1);
}
method pred {
self.add(-1);
}
method AT-POS(Int $pos) {
nqp::nativecallcast(
TValue,
nqp::istype(TValue, Int) ?? Int
!! nqp::istype(TValue, Num) ?? Num !! TValue,
nqp::box_i(nqp::unbox_i(nqp::decont(self)) + nqp::nativecallsizeof(TValue) * $pos, Pointer)
)
}
}
method ^parameterize(Mu:U \p, Mu:U \t) {
die "A typed pointer can only hold:\n" ~
" (u)int8, (u)int16, (u)int32, (u)int64, (u)long, (u)longlong, num16, num32, (s)size_t, bool, Str\n" ~
" and types with representation: CArray, CPointer, CStruct, CPPStruct and CUnion" ~
"not: {t.^name}"
unless t ~~ Int|Num|Bool || t === Str|void || t.REPR eq any <CStruct CUnion CPPStruct CPointer CArray>;
my $w := p.^mixin: TypedPointer[t.WHAT];
$w.^set_name: "{p.^name}[{t.^name}]";
$w;
}
}
# CArray class, used to represent C arrays.
our class CArray is repr('CArray') is array_type(Pointer) {
method AT-POS(::?CLASS:D: $pos) { die "CArray cannot be used without a type" }
my role IntTypedCArray[::TValue] does Positional[TValue] is array_type(TValue) {
multi method AT-POS(::?CLASS:D \arr: $pos) is raw {
nqp::atposref_i(nqp::decont(arr), $pos);
}
multi method AT-POS(::?CLASS:D \arr: int $pos) is raw {
nqp::atposref_i(nqp::decont(arr), $pos);
}
multi method ASSIGN-POS(::?CLASS:D \arr: int $pos, int $assignee) {
nqp::bindpos_i(nqp::decont(arr), $pos, $assignee);
}
multi method ASSIGN-POS(::?CLASS:D \arr: Int $pos, int $assignee) {
nqp::bindpos_i(nqp::decont(arr), nqp::unbox_i($pos), $assignee);
}
multi method ASSIGN-POS(::?CLASS:D \arr: Int $pos, Int $assignee) {
nqp::bindpos_i(nqp::decont(arr), nqp::unbox_i($pos), nqp::unbox_i($assignee));
}
multi method ASSIGN-POS(::?CLASS:D \arr: int $pos, Int $assignee) {
nqp::bindpos_i(nqp::decont(arr), $pos, nqp::unbox_i($assignee));
}
multi method allocate(::?CLASS:U \type: int $elems) {
my $arr := nqp::create(type);
nqp::bindpos_i($arr, $_, nqp::create(Int)) for ^$elems;
$arr;
}
multi method allocate(::?CLASS:U \type: Int:D $elems) {
my $arr := nqp::create(type);
nqp::bindpos_i($arr, $_, nqp::create(Int)) for ^$elems;
$arr;
}
}
my role NumTypedCArray[::TValue] does Positional[TValue] is array_type(TValue) {
multi method AT-POS(::?CLASS:D \arr: $pos) is raw {
nqp::atposref_n(nqp::decont(arr), $pos);
}
multi method AT-POS(::?CLASS:D \arr: int $pos) is raw {
nqp::atposref_n(nqp::decont(arr), $pos);
}
multi method ASSIGN-POS(::?CLASS:D \arr: int $pos, num $assignee) {
nqp::bindpos_n(nqp::decont(arr), $pos, $assignee);
}
multi method ASSIGN-POS(::?CLASS:D \arr: Int $pos, num $assignee) {
nqp::bindpos_n(nqp::decont(arr), nqp::unbox_i($pos), $assignee);
}
multi method ASSIGN-POS(::?CLASS:D \arr: Int $pos, Num $assignee) {
nqp::bindpos_n(nqp::decont(arr), nqp::unbox_i($pos), nqp::unbox_n($assignee));
}
multi method ASSIGN-POS(::?CLASS:D \arr: int $pos, Num $assignee) {
nqp::bindpos_n(nqp::decont(arr), $pos, nqp::unbox_n($assignee));
}
multi method allocate(::?CLASS:U \type: int $elems) {
my $arr := nqp::create(type);
nqp::bindpos_n($arr, $_, nqp::create(Num)) for ^$elems;
$arr;
}
multi method allocate(::?CLASS:U \type: Int:D $elems) {
my $arr := nqp::create(type);
nqp::bindpos_n($arr, $_, nqp::create(Num)) for ^$elems;
$arr;
}
}
my role TypedCArray[::TValue] does Positional[TValue] is array_type(TValue) {
multi method AT-POS(::?CLASS:D \arr: $pos) is rw {
Proxy.new:
FETCH => method () {
nqp::atpos(nqp::decont(arr), nqp::unbox_i($pos.Int))
},
STORE => method ($v) {
nqp::bindpos(nqp::decont(arr), nqp::unbox_i($pos.Int), nqp::decont($v));
self
}
}
multi method AT-POS(::?CLASS:D \arr: int $pos) is rw {
Proxy.new:
FETCH => method () {
nqp::atpos(nqp::decont(arr), $pos)
},
STORE => method ($v) {
nqp::bindpos(nqp::decont(arr), $pos, nqp::decont($v));
self
}
}
multi method ASSIGN-POS(::?CLASS:D \arr: int $pos, \assignee) {
nqp::bindpos(nqp::decont(arr), $pos, nqp::decont(assignee));
}
multi method ASSIGN-POS(::?CLASS:D \arr: Int $pos, \assignee) {
nqp::bindpos(nqp::decont(arr), nqp::unbox_i($pos), nqp::decont(assignee));
}
multi method allocate(::?CLASS:U: int $elems) {
my $arr := nqp::create(self);
my $type := ::?CLASS.^array_type;
nqp::bindpos($arr, $_, nqp::create($type)) for ^$elems;
$arr;
}
multi method allocate(::?CLASS:U: Int:D $elems) {
my $arr := nqp::create(self);
my $type := ::?CLASS.^array_type;
nqp::bindpos($arr, $_, nqp::create($type)) for ^$elems;
$arr;
}
}
method ^parameterize(Mu:U \arr, Mu:U \t) {
my $mixin;
if t ~~ Int {
$mixin := IntTypedCArray[t.WHAT];
}
elsif t ~~ Num {
$mixin := NumTypedCArray[t.WHAT];
}
else {
die "A C array can only hold:\n" ~
" (u)int8, (u)int16, (u)int32, (u)int64, (u)long, (u)longlong, num16, num32, (s)size_t, bool, Str\n" ~
" and types with representation: CArray, CPointer, CStruct, CPPStruct and CUnion\n" ~
"not: {t.^name}"
unless t === Str || t.REPR eq 'CStruct' | 'CPPStruct' | 'CUnion' | 'CPointer' | 'CArray';
$mixin := TypedCArray[t];
}
my $what := arr.^mixin: $mixin;
$what.^set_name("{arr.^name}[{t.^name}]");
$what;
}
method Str { self.join(' ') }
method elems { nqp::elems(self) }
method list {
do for ^self.elems { self.AT-POS($_) }
}
multi method new() { nqp::create(self) }
multi method new(*@values) { self.new(@values) }
multi method new(@values) {
if @values.elems -> $n {
my int $elems = $n - 1;
my $result := nqp::create(self); # XXX setelems would be nice
$result.ASSIGN-POS($elems,@values.AT-POS($elems)); # fake setelems
my int $i = -1;
nqp::while(
nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
$result.ASSIGN-POS($i,@values.AT-POS($i)),
);
$result
}
else {
nqp::create(self)
}
}
}
# duplicated code from NativeCall.pm to support Pointer.deref
multi sub map_return_type(Mu $type) { Mu }
multi sub map_return_type($type) {
nqp::istype($type, Int) ?? Int
!! nqp::istype($type, Num) ?? Num !! $type;
}