triple pointer native call on perl 6 - raku

I try to wrap sd-bus with perl6, but have problem with a function call triple pointer.
from sd-bus.h
int sd_bus_list_names(sd_bus *bus, char ***acquired, char ***activatable); /* free the results */
try with native call
sub sd_bus_list_names(Pointer, Pointer[CArray[Str]] , Pointer[CArray[Str]] ) returns int32 is native('systemd') {*}
I call but I don't know how to dereferencies to array(#) the acquired and activable variable.
thank's, and sorry for my english
[EDIT]
dwarring reply solve my problem to derefencies Pointer[CArray[Str]]
this is a test code:
use v6;
use NativeCall;
sub strerror(int32) returns Str is native {*}
sub sd_bus_default_system(Pointer is rw) returns int32 is native('systemd') {*}
sub sd_bus_unref(Pointer) returns Pointer is native('systemd') {*}
sub sd_bus_list_names(Pointer,Pointer[CArray[Str]] is rw, Pointer[CArray[Str]] is rw ) returns int32 is native('systemd') {*}
my Pointer $bus .= new;
my int32 $error;
$error=sd_bus_default_system($bus);
if $error < 0 {
my Str $ser = strerror(-$error);
die "fail, can't test triple pointer, dbus return error $error $ser";
}
my Pointer[CArray[Str]] $acq .= new;
my Pointer[CArray[Str]] $act .= new;
$error=sd_bus_list_names($bus,$acq,$act);
my #love6acq;
loop (my $i = 0; $acq.deref[$i]; $i++){
#love6acq.push: $acq.deref[$i];
}
#love6acq.say;
my #love6act;
loop (my $i = 0; $act.deref[$i]; $i++){
#love6act.push: $act.deref[$i];
}
#love6act.say;
sd_bus_unref($bus);

The following stand-alone experiment, works for me:
C code:
#include <stdio.h>
static char* strs[3] = { "howdy", "doody", NULL };
extern void ptr_to_strs (char ***ptr) {
*ptr = strs;
}
Raku code:
use v6;
use LibraryMake;
use NativeCall;
sub testlib {
state $ = do {
my $so = get-vars('')<SO>;
~(%?RESOURCES{"lib/test$so"});
}
}
sub ptr_to_strs(Pointer[CArray[Str]] $strs is rw) is native(&testlib)
my Pointer[CArray[Str]] $a .= new;
ptr_to_strs($a);
say $a.deref[0]; # howdy
say $a.deref[1]; # doody
say $a.deref[2]; # (Str)
Using this approach (but untested), you need to add is rw to the signature and create the pointers before calling:
# assuming you've already got a $bus object
sub sd_bus_list_names(Pointer, Pointer[CArray[Str]] is rw, Pointer[CArray[Str]] is rw) returns int32 is native('systemd') {*}
my Pointer[CArray[Str]] $acq .= new;
my Pointer[CArray[Str]] $act .= new;
sd_bus_list_names($bus, $acq, $act);
say $acq.deref[0]; # first acquired name

Related

What's the minimum code required to make a NativeCall to the md_parse function in the md4c library?

Note: This post is similar, but not quite the same as a more open-ended questions asked on Reddit: https://www.reddit.com/r/rakulang/comments/vvpikh/looking_for_guidance_on_getting_nativecall/
I'm trying to use the md4c c library to process a markdown file with its md_parse function. I'm having no success, and the program just quietly dies. I don't think I'm calling it with the right arguments.
Documentation for the function is here: https://github.com/mity/md4c/wiki/Embedding-Parser%3A-Calling-MD4C
I'd like to at least figure out the minimum amount of code needed to do this without error. This is my latest attempt, though I've tried many:
use v6.d;
use NativeCall;
sub md_parse(str, int32, Pointer is rw ) is native('md4c') returns int32 { * }
md_parse('hello', 5, Pointer.new());
say 'hi'; # this never gets printed
md4c is a SAX-like streaming parser that calls your functions when it encounters markdown elements. If you call it with an uninitialised Pointer, or with an uninitialised CStruct then the code will SEGV when the md4c library tries to call a null function pointer.
The README says:
The main provided function is md_parse(). It takes a text in the
Markdown syntax and a pointer to a structure which provides pointers
to several callback functions.
As md_parse() processes the input, it calls the callbacks (when
entering or leaving any Markdown block or span; and when outputting
any textual content of the document), allowing application to convert
it into another format or render it onto the screen.
The function signature of md_parse is:
int md_parse(const MD_CHAR* text, MD_SIZE size, const MD_PARSER* parser, void* userdata);
In order for md_parse() to work, you will need to:
define a native CStruct that matches the MD_PARSER type definition
create an instance of this CStruct
initialise all the function pointers with Raku functions that have the right function signature
call md_parse() with the initialised CStruct instance as the third parameter
The 4th parameter to md_parse() is void* userdata which is a pointer that you provide which gets passed back to you as the last parameter of each of the callback functions. My guess is that it's optional and if you pass a null value then you'll get called back with a null userdata parameter in each callback.
Followup
This turned into an interesting rabbit hole to fall down.
The code that makes it possible to pass a Raku sub as a callback parameter to a native function is quite complex and relies on MoarVM ops to build and cache the FFI callback trampoline. This is a piece of code that marshals the C calling convention parameters into a call that MoarVM can dispatch to a Raku sub.
It will be a sizeable task to implement equivalent functionality to provide some kind of nativecast that will generate the required callback trampoline and return a Pointer that can be assigned into a CStruct.
But we can cheat
We can use a simple C function to return the pointer to a generated callback trampoline as if it was for a normal callback sub. We can then store this pointer in our CStruct and our problem is solved. The generated trampoline is specific to the function signature of the Raku sub we want to call, so we need to generate a different NativeCall binding for each function signature we need.
The C function:
void* get_pointer(void* p)
{
return p;
}
Binding a NativeCall sub for the function signature we need:
sub get_enter_leave_fn(&func (uint32, Pointer, Pointer))
is native('./getpointer') is symbol('get_pointer') returns Pointer { * }
Initialising a CStruct attribute:
$!enter_block := get_enter_leave_fn(&enter_block);
Putting it all together:
use NativeCall;
enum BlockType < DOC QUOTE UL OL LI HR H CODE HTML P TABLE THEAD TBODY TR TH TD >;
enum SpanType < EM STRONG A IMG SPAN_CODE DEL SPAN_LATEXMATH LATEXMATH_DISPLAY WIKILINK SPAN_U >;
enum TextType < NORMAL NULLCHAR BR SOFTBR ENTITY TEXT_CODE TEXT_HTML TEXT_LATEXMATH >;
sub enter_block(uint32 $type, Pointer $detail, Pointer $userdata --> int32) {
say "enter block { BlockType($type) }";
}
sub leave_block(uint32 $type, Pointer $detail, Pointer $userdata --> int32) {
say "leave block { BlockType($type) }";
}
sub enter_span(uint32 $type, Pointer $detail, Pointer $userdata --> int32) {
say "enter span { SpanType($type) }";
}
sub leave_span(uint32 $type, Pointer $detail, Pointer $userdata --> int32) {
say "leave span { SpanType($type) }";
}
sub text(uint32 $type, str $text, uint32 $size, Pointer $userdata --> int32) {
say "text '{$text.substr(0..^$size)}'";
}
sub debug_log(str $msg, Pointer $userdata --> int32) {
note $msg;
}
#
# Cast functions that are specific to the required function signature.
#
# Makes use of a utility C function that returns its `void*` parameter, compiled
# into a shared library called libgetpointer.dylib (on MacOS)
#
# gcc -shared -o libgetpointer.dylib get_pointer.c
#
# void* get_pointer(void* p)
# {
# return p;
# }
#
# Each cast function uses NativeCall to build an FFI callback trampoline that gets
# cached in an MVMThreadContext. The generated callback code is specific to the
# function signature of the Raku function that will be called.
#
sub get_enter_leave_fn(&func (uint32, Pointer, Pointer))
is native('./getpointer') is symbol('get_pointer') returns Pointer { * }
sub get_text_fn(&func (uint32, str, uint32, Pointer))
is native('./getpointer') is symbol('get_pointer') returns Pointer { * }
sub get_debug_fn(&func (str, Pointer))
is native('./getpointer') is symbol('get_pointer') returns Pointer { * }
class MD_PARSER is repr('CStruct') {
has uint32 $!abi_version; # unsigned int abi_version
has uint32 $!flags; # unsigned int flags
has Pointer $!enter_block; # F:int ( )* enter_block
has Pointer $!leave_block; # F:int ( )* leave_block
has Pointer $!enter_span; # F:int ( )* enter_span
has Pointer $!leave_span; # F:int ( )* leave_span
has Pointer $!text; # F:int ( )* text
has Pointer $!debug_log; # F:void ( )* debug_log
has Pointer $!syntax; # F:void ( )* syntax
submethod TWEAK() {
$!abi_version = 0;
$!flags = 0;
$!enter_block := get_enter_leave_fn(&enter_block);
$!leave_block := get_enter_leave_fn(&leave_block);
$!enter_span := get_enter_leave_fn(&enter_span);
$!leave_span := get_enter_leave_fn(&leave_span);
$!text := get_text_fn(&text);
$!debug_log := get_debug_fn(&debug_log);
}
}
sub md_parse(str, uint32, MD_PARSER, Pointer is rw) is native('md4c') returns int { * }
my $parser = MD_PARSER.new;
my $md = '
# Heading
## Sub Heading
hello *world*
';
md_parse($md, $md.chars, $parser, Pointer.new);
The output:
./md4c.raku
enter block DOC
enter block H
text 'Heading'
leave block H
enter block H
text 'Sub Heading'
leave block H
enter block P
text 'hello '
enter span EM
text 'world'
leave span EM
leave block P
leave block DOC
In summary, it's possible. I'm not sure if I'm proud of this or horrified by it. I think a long-term solution will require refactoring the callback trampoline generator into a separate nqp op that can be exposed to Raku as a nativewrap style operation.

How to print an object, type in nqp

How to print an object in NQP ? (For debugging purposes)
It is easy in Raku:
say that is calling gist in its short loop code
dd The tiny Data Dumper as shown in this post
class Toto { has $.member = 42; }
class Titi { has $.member = 41; has $.toto = Toto.new }
my $ti = Titi.new;
say $ti;
# Titi.new(member => 41, toto => Toto.new(member => 42))
dd $ti;
# Titi $ti = Titi.new(member => 41, toto => Toto.new(member => 42))
It seems more complicated in NQP
class Toto { has $!member; sub create() {$!member := 42}};
class Titi { has $!member; has $!toto; sub create() {$!member := 41; $!toto := Toto.new; $!toto.create; }}
my $ti := Titi.new;
say($ti);
Cannot stringify this object of type P6opaque (Titi)
Of course, no .gist method, the code calls nqp::encode which finally expects a string.
Reducing the problem to an MRE:
class foo {}
say(foo.new); # Cannot stringify ...
Simplifying the solution:
class foo { method Str () { 'foo' } }
say(foo.new); # foo
In summary, add a Str method.
This sounds simple but there's a whole lot of behind-the-scenes stuff to consider/explain.
nqp vs raku
The above solution is the same technique raku uses; when a value is expected by a routine/operation to be a string, but isn't, the language behavior is to attempt to coerce to a string. Specifically, see if there's a Str method that can be called on the value, and if so, call it.
In this case NQP's NQPMu, which is way more barebones than raku's Mu, doesn't provide any default Str method. So a solution is to manually add one.
More generally, NQP is a pretty hostile language unless you know raku fairly well and have gone thru A course on Rakudo and NQP internals.
And once you're up to speed on the material in that course, I recommend you consider the IRC channels #raku-dev and/or #moarvm as your first port of call rather than SO (unless your goal is specifically to increase SO coverage of nqp/moarvm).
Debugging the compiler code
As you will have seen, the NQP code you linked calls .say on a filehandle.
That then calls this method.
That method's body is $str ~ "\n". That code will attempt to coerce $str to a string (just as it would in raku). That's what'll be generating the "Cannot stringify" error.
A search for "Cannot stringify" in the NQP repo only matched some Java code. And I bet you're not running Rakudo on the JVM. That means the error message must be coming from MoarVM.
The same search in the MoarVM repo yields this line in coerce.c in MoarVM.
Looking backwards in the routine containing that line we see this bit:
/* Check if there is a Str method. */
MVMROOT(tc, obj, {
strmeth = MVM_6model_find_method_cache_only(tc, obj,
tc->instance->str_consts.Str);
});
This shows the backend, written in C, looking for and invoking a "method" called Str. (It's relying on an internal API (6model) that all three layers of the compiler (raku, nqp, and backends) adhere to.)
Customizing the Str method
You'll need to customize the Str method as appropriate. For example, to print the class's name if it's a type object, and the value of its $!bar attribute otherwise:
class foo {
has $!bar;
method Str () { self ?? nqp::coerce_is($!bar) !! self.HOW.name(self) }
}
say(foo.new(bar=>42)); # 42
Despite the method name, the nqp say routine is not expecting a raku Str but rather an nqp native string (which ends up being a MoarVM native string on the MoarVM backend). Hence the need for nqp::coerce_is (which I found by browsing the nqp ops doc).
self.HOW.name(self) is another example of the way nqp just doesn't have the niceties that raku has. You could write the same code in raku but the idiomatic way to write it in raku is self.^name.
Currently, what I have is a list and hash discriminator. It does not work on object.
sub print_something ($value, :$indent = 0, :$no-indent=0) {
if nqp::ishash($value) {
print_hash($value, :$indent);
} elsif nqp::islist($value) {
print_array($value, :$indent);
} else {
if $no-indent {
say($value);
} else {
say_indent($indent, $value);
}
}
}
Where
sub print_indent ($int, $string) {
my $res := '';
my $i := 0;
while $i < $int {
$res := $res ~ ' ';
$i := $i + 1;
}
$res := $res ~ $string;
print($res);
}
sub print_array (#array, :$indent = 0) {
my $iter := nqp::iterator(#array);
say_indent($indent, '[');
while $iter {
print_value(nqp::shift($iter), :indent($indent+1));
}
say_indent($indent, ']');
}
sub print_hash (%hash, :$indent = 0) {
my $iter := nqp::iterator(%hash);
say_indent($indent, '{');
while $iter {
my $pair := nqp::shift($iter);
my $key := nqp::iterkey_s($pair);
my $value := nqp::iterval($pair);
print_indent($indent + 1, $key ~ ' => ');
print_value($value, :indent($indent+1), :no-indent(1));
}
say_indent($indent, '}');
}

NativeCall. How to get a string as a parameter of a C function

There is a C function which returns some string to a provided pointer:
void snmp_error(netsnmp_session *sess, int *clib_errorno,
int *snmp_errorno, char **errstring);
The Perl6 version is:
sub snmp_error(Snmp-session, int32 is rw, int32 is rw, Str is rw) is native("netsnmp") { * };
snmp_error($sess, my int32 $errno, my int32 $liberr, my Str $errstr);
say $errno, " ", $liberr, " ", $errstr;
It returns correct ints but not a string:
0 -3 (Str)
Is it a just a bug or something is wrong here?
perl6 -v
This is Rakudo version 2016.12 built on MoarVM version 2016.12
implementing Perl 6.c.
The same is on
This is Rakudo version 2017.09 built on MoarVM version 2017.09.1
implementing Perl 6.c.
When I wrestled with the same problem I translated this:
gboolean notify_get_server_info (char **ret_name,
char **ret_vendor,
char **ret_version,
char **ret_spec_version);
into this:
sub notify_get_server_info(Pointer[Str] $name is rw,
Pointer[Str] $vendor is rw,
Pointer[Str] $version is rw,
Pointer[Str] $spec_version is rw --> int32)
is native(LIB) { * }
which works for me.
I think it is a bug (or rather more likely just not fully implemented yet).
See the answers here for some work-arounds:
Passing pointer to pointer in Perl 6 Nativecall
The method of Fernando Santagata works as intended:
sub snmp_error(Snmp-session, int32 is rw, int32 is rw, Pointer[Str] is rw) is native("netsnmp") { * };
my $e = Pointer[Str].new;
snmp_error($sess, my int32 $errno, my int32 $liberr, $e);
say "syserr=$errno liberr=$liberr error=", $e.deref;

Why does a Perl 6 Str do the Positional role, and how can I change []?

I'm playing around with a positional interface for strings. I'm aware of How can I slice a string like Python does in Perl 6?, but I was curious if I could make this thing work just for giggles.
I came up with this example. Reading positions is fine, but I don't know how to set up the multi to handle an assignment:
multi postcircumfix:<[ ]> ( Str:D $s, Int:D $n --> Str ) {
$s.substr: $n, 1
}
multi postcircumfix:<[ ]> ( Str:D $s, Range:D $r --> Str ) {
$s.substr: $r.min, $r.max - $r.min + 1
}
multi postcircumfix:<[ ]> ( Str:D $s, List:D $i --> List ) {
map( { $s.substr: $_, 1 }, #$i ).list
}
multi postcircumfix:<[ ]> ( Str:D $s, Int:D $n, *#a --> Str ) is rw {
put "Calling rw version";
}
my $string = 'The quick, purple butterfly';
{ # Works
my $single = $string[0];
say $single;
}
{ # Works
my $substring = $string[5..9];
say $substring;
}
{ # Works
my $substring = $string[1,3,5,7];
say $substring;
}
{ # NOPE!
$string[2] = 'Perl';
say $string;
}
The last one doesn't work:
T
uick,
(h u c)
Index out of range. Is: 2, should be in 0..0
in block <unit> at substring.p6 line 36
Actually thrown at:
in block <unit> at substring.p6 line 36
I didn't think it would work, though. I don't know what signature or traits it should have to do what I want to do.
Why does the [] operator work on a Str?
$ perl6
> "some string"[0]
some string
The docs mostly imply that the [] works on things that do the Positional roles and that those things are in list like things. From the [] docs in operators:
Universal interface for positional access to zero or more elements of a #container, a.k.a. "array indexing operator".
But a Str surprisingly does the necessary role even though it's not an #container (as far as I know):
> "some string".does( 'Positional' )
True
Is there a way to test that something is an #container?
Is there a way to get something to list all of its roles?
Now, knowing that a string can respond to the [], how can I figure out what signature will match that? I want to know the right signature to use to define my own version to write to this string through [].
One way to achieve this, is by augmenting the Str class, since you really only need to override the AT-POS method (which Str normally inherits from Any):
use MONKEY;
augment class Str {
method AT-POS($a) {
self.substr($a,1);
}
}
say "abcde"[3]; # d
say "abcde"[^3]; # (a b c)
More information can be found here: https://docs.raku.org/language/subscripts#Methods_to_implement_for_positional_subscripting
To make your rw version work correctly, you first need to make the Str which might get mutated also rw, and it needs to return something which in turn is also rw. For the specific case of strings, you could simply do:
multi postcircumfix:<[ ]> ( Str:D $s is rw, Int:D $i --> Str ) is rw {
return $s.substr-rw: $i, 1;
}
Quite often, you'll want an rw subroutine to return an instance of Proxy:
multi postcircumfix:<[ ]> ( Str:D $s is rw, Int:D $i --> Str ) is rw {
Proxy.new: FETCH => sub { $s.substr: $i },
STORE => sub -> $newval { $s.substr-rw( $i, 1 ) = $newval }
}
Although I haven't yet seen production code which uses it, there is also a return-rw operator, which you'll occasionally need instead of return.
sub identity( $x is rw ) is rw { return-rw $x }
identity( my $y ) = 42; # Works, $y is 42.
sub identity-fail( $x is rw ) is rw { return $x }
identity-fail( my $z ) = 42; # Fails: "Cannot assign to a readonly variable or a value"
If a function reaches the end without executing a return, return-rw or throwing an exception, the value of the last statement is returned, and (at present), this behaves as if it were preceded return-rw.
sub identity2( $x is rw ) is rw { $x }
identity2( my $w ) = 42; # Works, $w is 42.
There's a module that aims to let you do this:
https://github.com/zoffixznet/perl6-Pythonic-Str
However:
This module does not provide Str.AT-POS or make Str type do Positional or Iterable roles. The latter causes all sorts of fallout with core and non-core code due to inherent assumptions that Str type does not do those roles. What this means in plain English is you can only index your strings with [...] postcircumfix operator and can't willy-nilly treat them as lists of characters—simply call .comb if you need that.`

Fortran decimal and thousand separator

Is there a way to change the period decimal separator for a comma?.
Also, how can I make the output numbers have a thousand separator?. This could be a comma, a period, a space ...
Use the Argument DECIMAL='COMMA' when opening a file
open(100,file=logfile,status='unknown',DECIMAL='COMMA')
This will change the decimal to comma
You can write a C++ function which will convert the number in a string in you current locale for you.
#include <string>
#include <iomanip>
#include <sstream>
class SpaceSeparator: public std::numpunct<char>
{
public:
SpaceSeparator(std::size_t refs): std::numpunct<char>(refs) {}
protected:
char do_thousands_sep() const { return ' '; }
char do_decimal_point() const { return ','; }
std::string do_grouping() const { return "\03"; }
};
extern "C" {
void convert(char* str, double f, int len) {
std::string s;
std::stringstream out;
SpaceSeparator facet(1); //1 - don't delete when done
std::locale prev = out.imbue(std::locale(std::locale(), &facet));
out << std::setprecision(15) << f;
s = out.str();
std::copy(s.begin(), s.end(), str);
int i;
for (i=s.size();i<len;i++){
str[i] = ' ';
}
}
}
call from Fortran:
use iso_c_binding
interface
subroutine convert(str, f, l) bind(C,name="convert")
import
character(c_char) :: str(*)
real(c_double), value :: f
integer(c_int), value :: l
end subroutine
end interface
character(len=100,kind=c_char) :: ch
call convert(ch, 123456.123_c_double, len(ch, kind=c_int))
print *,ch
end
On my machine it prints 123 456,123:
> gfortran locale.cc locale.f90 -lstdc++
> ./a.out
123 456,123
Disclaimer: I am not a C++ programmer and he solution can be slow. Maybe the brute force approach in Fortran is better.
I used this answer as a base: https://stackoverflow.com/a/2648663/721644
a quick and dirty fortran based approach:
implicit none
write(*,*) commadelim(123456.789)
write(*,*) commadelim(23456.789)
write(*,*) commadelim(3456.789)
write(*,*) commadelim(-123456.789)
write(*,*) commadelim(-23456.789)
write(*,*) commadelim(-3456.789)
contains
function commadelim(v)
implicit none
real v
integer dp,p,z0,i
character(len=50) :: commadelim
write(commadelim,'(f0.12)') abs(v)
dp = index(commadelim,'.')
commadelim(dp:dp) = ','
z0 = 2 - mod(dp+1,3)
do i = 1, (dp+z0-1)/3-1
p = 4*i-z0
commadelim = commadelim(:p)//'.'//commadelim(p+1:)
enddo
if (v<0) commadelim = '-'//commadelim
end function
end