Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

CArray cannot allocate contiguous memory #5828

Open
p6rt opened this issue Nov 27, 2016 · 1 comment
Open

CArray cannot allocate contiguous memory #5828

p6rt opened this issue Nov 27, 2016 · 1 comment
Labels
Bug NativeCall RFC Request For Comments

Comments

@p6rt
Copy link

p6rt commented Nov 27, 2016

Migrated from rt.perl.org#130187 (status was 'new')

Searchable as RT130187$

@p6rt
Copy link
Author

p6rt commented Nov 27, 2016

From @titsuki

See the following codes and results​:

*** codes ***

* t/05-pointer.c


#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include "05-pointer.h"

#ifdef _WIN32
#define DLLEXPORT __declspec(dllexport)
#else
#define DLLEXPORT extern
#endif

double dot(struct Feature* lhs, struct Feature* rhs) {
    double sum = 0.0;

    while(lhs->index != -1 && rhs->index != -1) {
        if (lhs->index == rhs->index) {
            sum += lhs->value * rhs->value;
            lhs++;
            rhs++;
        }
        else if (lhs->index < rhs->index) {
            lhs++;
        }
        else {
            rhs++;
        }
    }
    return sum;
}


*t/05-pointer.h


#if ! defined(HEADER_POINTER_H)
#define HEADER_POINTER_H

#ifdef __cplusplus
extern "C" {
#endif

struct Feature {
  int index;
  double value;
} Feature;

double dot(struct Feature*, struct Feature*);

#ifdef __cplusplus
} /* closing brace for extern "C" */
#endif

#endif /* HEADER_POINTER_H */


* t/CompileTestLib.pm


unit module CompileTestLib;

my @​cleanup;  # files to be cleaned up afterwards

sub compile_test_lib($name) is export {
    my ($c_line, $l_line);
    my $VM  := $*VM;
    my $cfg := $VM.config;
    my $libname = $VM.platform-library-name($name.IO);
    if $VM.name eq 'moar' {
        my $o  = $cfg<obj>;

        # MoarVM exposes exposes GNU make directives here, but we cannot pass this to gcc directly.
        my $ldshared = $cfg&lt;ldshared&gt;.subst(/'--out-implib,lib$(notdir $@​).a'/, "--out-implib,$libname.a");

        $c_line = "$cfg<cc> -c $cfg<ccshared> $cfg<ccout>$name$o $cfg<cflags> t/$name.c";
        $l_line = "$cfg<ld> $ldshared $cfg<ldflags> $cfg<ldlibs> $cfg<ldout>$libname $name$o";
        @​cleanup = << "$libname" "$name$o" >>;
    }
    elsif $VM.name eq 'jvm' {
        $c_line = "$cfg<nativecall.cc> -c $cfg<nativecall.ccdlflags> -o$name$cfg<nativecall.o> $cfg<nativecall.ccflags> t/04-nativecall/$name.c";
        $l_line = "$cfg<nativecall.ld> $cfg<nativecall.perllibs> $cfg<nativecall.lddlflags> $cfg<nativecall.ldflags> $cfg<nativecall.ldout>$libname $name$cfg<nativecall.o>";
        @​cleanup = << $libname "$name$cfg<nativecall.o>" >>;
    }
    else {
        die "Unknown VM; don't know how to compile test libraries";
    }
    shell($c_line);
    shell($l_line);
}

sub compile_cpp_test_lib($name) is export {
    my @​cmds;
    my $VM  := $*VM;
    my $cfg := $VM.config;
    my $libname = $VM.platform-library-name($name.IO);
    @​cleanup = $libname;
    if $*DISTRO.is-win {
        @​cmds    = "cl /LD /EHsc /Fe$libname t/$name.cpp",
                   "g++ --shared -fPIC -o $libname t/$name.cpp",
    }
    else {
        @​cmds    = "g++ --shared -fPIC -o $libname t/$name.cpp",
                   "clang++ -stdlib=libc++ --shared -fPIC -o $libname t/$name.cpp",
    }

    my (@​fails, $succeeded);
    for @​cmds -> $cmd {
        my $handle = shell("$cmd 2>&1", :out);
        my $output = $handle.out.slurp-rest;
        if $handle.out.close.status {
            @​fails.push​: "Running '$cmd'​:\n$output"
        }
        else {
            $succeeded = 1;
            last
        }
    }
    fail @​fails.join('=' x 80 ~ "\n") unless $succeeded;
}

END {
    #    say "cleaning up @​cleanup[]";
    unlink @​cleanup;
}


* t/05-pointer.t


use v6;
use Test;
use NativeCall;
use lib <lib t>;
use CompileTestLib;

compile_test_lib('05-pointer');

class Feature is repr('CStruct') {
      has int32 $.index;
      has num64 $.value;
}

my sub dot(Feature, Feature) returns num64 is native("./05-pointer") { * }

my CArray[Feature] $lhs .= new;
my CArray[Feature] $rhs .= new;
$lhs[5] = Feature.new(index => -1, value => 0e0);
$rhs[5] = Feature.new(index => -1, value => 0e0);

for 1..5 -> $index {
    $rhs[$index - 1] = Feature.new(index => $index, value => 2.5e0);
    $lhs[$index - 1] = Feature.new(index => $index, value => 2.5e0);
}

for ^5 {
    is $lhs[$_].value, 2.5e0, "\$lhs[$_].value = 2.5e0";
    is $rhs[$_].value, 2.5e0, "\$rhs[$_].value = 2.5e0";
    is $lhs[$_].index, $_ + 1, "\$lhs[$_].index = {$_ + 1}";
    is $rhs[$_].index, $_ + 1, "\$rhs[$_].index = {$_ + 1}";
}

is dot($lhs[0], $rhs[0]), [+] ((2.5 * 2.5) xx 5);

done-testing;


*** results ***


$ mi6 test -v t/05-pointer.t
==> Set PERL6LIB=/home/itoyota/Programs/p6-Foo/lib
==> prove -e /home/itoyota/.rakudobrew/bin/../moar-nom/install/bin/perl6 -r -v t/05-pointer.t
t/05-pointer.t .. 
ok 1 - $lhs[0].value = 2.5e0
ok 2 - $rhs[0].value = 2.5e0
ok 3 - $lhs[0].index = 1
ok 4 - $rhs[0].index = 1
ok 5 - $lhs[1].value = 2.5e0
ok 6 - $rhs[1].value = 2.5e0
ok 7 - $lhs[1].index = 2
ok 8 - $rhs[1].index = 2
ok 9 - $lhs[2].value = 2.5e0
ok 10 - $rhs[2].value = 2.5e0
ok 11 - $lhs[2].index = 3
ok 12 - $rhs[2].index = 3
ok 13 - $lhs[3].value = 2.5e0
ok 14 - $rhs[3].value = 2.5e0
ok 15 - $lhs[3].index = 4
ok 16 - $rhs[3].index = 4
ok 17 - $lhs[4].value = 2.5e0
ok 18 - $rhs[4].value = 2.5e0
ok 19 - $lhs[4].index = 5
ok 20 - $rhs[4].index = 5
not ok 21 - 

# Failed test at t/05-pointer.t line 33
# expected​: '31.25'
#      got​: '6.25'
1..21
# Looks like you failed 1 test of 21
Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/21 subtests 

Test Summary Report


t/05-pointer.t (Wstat​: 256 Tests​: 21 Failed​: 1)
  Failed test​:  21 
  Non-zero exit status​: 1
Files=1, Tests=21,  1 wallclock secs ( 0.02 usr  0.00 sys +  0.51 cusr  0.06 csys =  0.59 CPU)
Result​: FAIL


In the above example, dot method accepts entry address of given two vectors and computes the dot product of the values they have.
Hence, in the test case 21, dot($lhs[0],$rhs[0]) should return 31.25e0, where $lhs[0] is the entry address of the CArray[Feature] (the values it has are 2.5e0 xx 5) and $rhs[0] is the entry address of the other CArray[Feature] (the values it has are 2.5e0 xx 5).

However, in fact, it returns 6.25e0. 
It seems that dot function in C side receive the entry address of the given vector correctly, but it fails in incrementing the pointer address and points a irrelevant address, because CArray cannot allocate contiguous memory.
I think that NativeCall needs something for allocating contiguous memory.

(I faced this type of error while creating a libsvm bindings for Perl 6​: https://github.com/cjlin1/libsvm/blob/master/svm.cpp#L294-L314 )

$ perl6 --version
This is Rakudo version 2016.10-309-g3dcc52b built on MoarVM version 2016.10-71-g9d5c874
implementing Perl 6.c.

@p6rt p6rt added Bug NativeCall RFC Request For Comments labels Jan 5, 2020
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
Bug NativeCall RFC Request For Comments
Projects
None yet
Development

No branches or pull requests

1 participant