Perl Win32::API - problem passing arrays to and from a DLL function - perl

Question

System environment: 64 bit Windows 7 Ultimate; Active State Perl revision 5 version 24 subversion 3; Build 2404 [404865] compiled Dec 11 2017 11:09:26.
I’m trying to write a perl script that calls the function declared as:
extern "C" POLYFITGSL_API int PolyFit(int numPts, const double* xVals, const double* yVals, int fitOrder, double* coef, double* fitVals, double* rSquared);
The first four parameters are inputs to PolyFit and the last three are outputs.
With pointers allocated in a C program, it is called in this form:
coef = (double*)malloc((fitOrder + 1) * sizeof(double));
estYVals = (double*)malloc(n * sizeof(double));
rSquared = (double*)malloc(sizeof(double));
resFit = PolyFit(n, xVals, yVals, fitOrder, coef, estYVals, rSquared);
The DLL exports :DSL Viewer display
Attempts using the parameter list option have not been successful. Further, https://metacpan.org/pod/Win32::API#1 recommends importing by prototype. However I don’t know how to write it and can’t find an example.
Using the parameter list option in the code fragment below, except for the two integers, all are defined as pointers, and for the outputs the referenced arrays and the final float have been pre-defined and populated with zeros.
# This assumes that the integers are 4 bytes wide and all others are 8:
$returnbuf = " " x 48;
$parmsbuf = " " x 48;
my $PolyFit = Win32::API::More->new('D:/prjct/model/code/SRS1/binaries/PolyFitGSL','PolyFit','PNP','N');
die $! unless defined $PolyFit;
# no error is produced here
$parmsbuf = pack('iNNiNNN', $numvals, $xValsptr, $yValsptr, $fitorder, $coeffsptr, $fitValsptr, $rSquaredptr);
# display the parameters
#outref = unpack('iNNiNNN', $parmsbuf);
print ("The unpacked calling buffer: #outref \n");
$returncode = $PolyFit ->Call($parmsbuf, 3, $returnbuf);
# the return value is 52
$error = Win32::GetLastError();
if ($error) {print("function call failed: $^E \n")};
#returnvals = unpack('iNNiNNN', $returnbuf);
print ("Return values: #returnvals \n");
On execution, this produces:
The unpacked calling buffer: 600 58497768 58498512 3 58497816 58497840 58489400
Return values: 538976288 538976288 538976288 538976288 538976288 538976288 538976288
The return value of the call is 52 under all conditions tested.
The output arrays and scalar referenced by $coeffsptr, $fitValsptr, and $rSquaredptr remain in their initialized state.
The input buffer’s values look right to me and the pointer values look like reasonable locations in perl’s address space.
No execution errors are detected but the returned values clearly aren’t valid. I’m making mistakes here but it’s not obvious to me how to resolve them.
There is disagreement between authorities on the parameter type identifiers. https://metacpan.org/pod/Win32::API#1 says that a double float is specified with a D but the pack function rejects it as an invalid type.
I’m relying on this source for specifying the sizes of the variables the GSL PolyFit function is expecting: https://www.ibm.com/support/knowledgecenter/en/SSFKSJ_9.0.0/com.ibm.mq.ref.dev.doc/q104610_.htm
If I should be importing by prototype instead, an example of how to write the import and call statements would be of great value. I’m not a developer, I’m just trying to get some science done and a fast polynomial fitting routine is critical. The GSL PolyFit function can fit a third degree polynomial to 600 data points in about 350 microseconds on this 3.5 GHz, 7 year old computer.
Thanks very much for helping;

Answer 1

Lots of problems.
PNP is obviously wrong for a function with 7 arguments.
Similarly, what's up with ->Call($parmsbuf, 3, $returnbuf)?
N is not the correct type of the return value.
Win32::API uses the stdcall calling convention by default, but the function appears to use the cdecl calling convention.
You can use the following: (Notes follow)
use feature qw( state );
use Config qw( %Config );
use Win32::API qw( );
use constant PTR_SIZE => $Config{ptrsize};
use constant PTR_PACK_FORMAT =>
PTR_SIZE == 8 ? 'Q'
: PTR_SIZE == 4 ? 'L'
: die("Unrecognized ptrsize\n");
use constant PTR_WIN32API_TYPE =>
PTR_SIZE == 8 ? 'DWORD64'
: PTR_SIZE == 4 ? 'DWORD32'
: die("Unrecognized ptrsize\n");
Win32::API::Type->typedef('uintptr_t' => PTR_WIN32API_TYPE);
my $dll = 'D:/prjct/model/code/SRS1/binaries/PolyFitGSL';
sub get_buffer_addr { unpack(PTR_PACK_FORMAT, pack('P', $_[0])) }
sub poly_fit {
my ($vals, $fit_order) = #_;
state $PolyFit;
if (!$PolyFit) {
my $adjusted_proto = '
int __cdecl PolyFit(
int numPts,
uintptr_t xVals,
uintptr_t yVals,
int fitOrder,
uintptr_t coef,
uintptr_t fitVals,
uintptr_t rSquared
)
';
$PolyFit = Win32::API::More->new($dll, $adjusted_proto)
or die("Can't link to PolyFit: $^E\n");
}
my $n = #$vals;
my $x_vals = pack("d$n", map $_->[0], #$vals);
my $y_vals = pack("d$n", map $_->[1], #$vals);
my $coef = pack('d'.( $fit_order + 1 ), ( 0 )x( $fit_order + 1 ));
my $fit_vals = pack("d$n", ( 0 )x( $n ));
my $r_squared = pack('d', 0);
my $rv = $PolyFit->Call(
$n,
get_buffer_addr($x_vals),
get_buffer_addr($y_vals),
$fit_order,
get_buffer_addr($coef),
get_buffer_addr($fit_vals),
get_buffer_addr($r_squared),
);
# I'm assuming the return value indicates whether the call was successful or not?
return if !$rv;
return (
[ unpack('d'.( $fit_order + 1 ), $coef) ],
[ unpack("d$n", $fit_vals) ],
[ unpack('d', $r_squared) ],
);
}
my ($coef, $fit_vals, $r_squared) = poly_fit(
[ [ $x1, $y1 ], [ $x2, $y2 ], [ $x3, $y3 ], ... ],
$fit_order,
)
or die("Error");
Or, if you prefer to use parallel arrays for the inputs,
sub poly_fit {
my ($x_vals, $y_vals, $fit_order) = #_;
#$x_vals == #$y_vals
or croak("Mismatch in the number of X vals and Y vals");
...
my $n = #$x_vals;
my $x_vals = pack("d$n", #$x_vals);
my $y_vals = pack("d$n", #$y_vals);
...
}
my ($coef, $fit_vals, $r_squared) = poly_fit(
[ $x1, $x2, $x3, ... ],
[ $y1, $y2, $y3, ... ],
$fit_order,
)
or die("Error");
Notes
When I wrote the above code, I thought specifying a calling convention other than __stdcall required switching to the prototype syntax of Win32:API. But I was mistaken. I could have used the following:
use constant PTR_WIN32API_TYPE =>
PTR_SIZE == 8 ? 'Q'
: PTR_SIZE == 4 ? 'N'
: die("Unrecognized ptrsize\n");
$PolyFit = Win32::API::More->new(
$dll, 'PolyFit', 'PPiPPP' =~ s/P/PTR_WIN32API_TYPE/ger, 'i', '__cdecl')
Win32::API's prototype parser is very lame. When it sees const double* xVals, it sees const foo! And double* xVals is no better cause it just sees double foo;.
We could use LPDOUBLE instead of double*, but that doesn't buy us much. Regardless of whether the prototype syntax is used or not, Win32::API expects us to provide a single number, not an array.
So we handle the pointers ourselves. By telling Win32::API that the pointer parameters are integers of the appropriate size (DWORD32 or DWORD64 depending on the whether we're using 32-bit or 64-bit pointers), we can pass a pointer without any interpretation by Win32::API.
What follows is my entire test.
a.h
#ifndef A_H
#define A_H
#ifdef __cplusplus
extern "C" {
#endif
#ifdef POLYFITGSL_EXPORTS
#define POLYFITGSL_API __declspec(dllexport)
#else
#define POLYFITGSL_API __declspec(dllimport)
#endif
POLYFITGSL_API int PolyFit(int numPts, const double* xVals, const double* yVals, int fitOrder, double* coef, double* fitVals, double* rSquared);
#ifdef __cplusplus
}
#endif
#endif // A_H
a.c
#include <stdio.h>
#include "a.h"
POLYFITGSL_API int PolyFit(int numPts, const double* xVals, const double* yVals, int fitOrder, double* coef, double* fitVals, double* rSquared) {
// %I64u is MS-specific and shoulnd't be hardcoded.
printf("[C] sizeof(int): %I64u\n", sizeof(int));
printf("[C] sizeof(double*): %I64u\n", sizeof(double*));
printf("[C] numPts: %d\n", numPts);
printf("[C] xVals: %p\n", (void*)xVals);
printf("[C] yVals: %p\n", (void*)yVals);
printf("[C] fitOrder: %d\n", fitOrder);
printf("[C] coef: %p\n", (void*)coef);
printf("[C] fitVals: %p\n", (void*)fitVals);
printf("[C] rSquared: %p\n", (void*)rSquared);
for (int i=0; i<numPts; ++i) {
printf("[C] xVals[%d]: %f\n", i, xVals[i]);
printf("[C] yVals[%d]: %f\n", i, yVals[i]);
}
for (int i=0; i<fitOrder+1; ++i)
coef[i] = (i+1)/10.0;
for (int i=0; i<numPts; ++i)
fitVals[i] = (i+1)/100.0;
*rSquared = 3.14;
return 1;
}
a.pl
#!perl
use 5.014;
use warnings;
use Config qw( %Config );
use Data::Dumper qw( Dumper );
use Devel::Peek qw( Dump );
use Win32::API qw( );
use constant PTR_SIZE => $Config{ptrsize};
use constant PTR_PACK_FORMAT =>
PTR_SIZE == 8 ? 'Q'
: PTR_SIZE == 4 ? 'L'
: die("Unrecognized ptrsize\n");
use constant PTR_WIN32API_TYPE =>
PTR_SIZE == 8 ? 'DWORD64'
: PTR_SIZE == 4 ? 'DWORD32'
: die("Unrecognized ptrsize\n");
Win32::API::Type->typedef('uintptr_t' => PTR_WIN32API_TYPE);
my $dll = $0 =~ s/\.pl\z/.dll/r;
sub get_buffer_addr { unpack(PTR_PACK_FORMAT, pack('P', $_[0])) }
sub poly_fit {
my ($vals, $fit_order) = #_;
state $PolyFit;
if (!$PolyFit) {
my $adjusted_proto = '
int __cdecl PolyFit(
int numPts,
uintptr_t xVals,
uintptr_t yVals,
int fitOrder,
uintptr_t coef,
uintptr_t fitVals,
uintptr_t rSquared
)
';
$PolyFit = Win32::API::More->new($dll, $adjusted_proto)
or die("Can't link to PolyFit: $^E\n");
}
my $n = #$vals;
my $x_vals = pack("d$n", map $_->[0], #$vals);
my $y_vals = pack("d$n", map $_->[1], #$vals);
my $coef = pack('d'.( $fit_order + 1 ), ( 0 )x( $fit_order + 1 ));
my $fit_vals = pack("d$n", ( 0 )x( $n ));
my $r_squared = pack('d', 0);
printf("[Perl] sizeof(double*): %u\n", PTR_SIZE);
printf("[Perl] numPts: %d\n", $n);
printf("[Perl] xVals: %016X\n", get_buffer_addr($x_vals));
printf("[Perl] yVals: %016X\n", get_buffer_addr($y_vals));
printf("[Perl] fitOrder: %d\n", $fit_order);
printf("[Perl] coef: %016X\n", get_buffer_addr($coef));
printf("[Perl] fitVals: %016X\n", get_buffer_addr($fit_vals));
printf("[Perl] rSquared: %016X\n", get_buffer_addr($r_squared));
Dump($coef);
my $rv = $PolyFit->Call(
$n,
get_buffer_addr($x_vals),
get_buffer_addr($y_vals),
$fit_order,
get_buffer_addr($coef),
get_buffer_addr($fit_vals),
get_buffer_addr($r_squared),
);
Dump($coef);
# I'm assuming the return value indicates whether the call was successful or not?
return if !$rv;
return (
[ unpack('d'.( $fit_order + 1 ), $coef) ],
[ unpack("d$n", $fit_vals) ],
[ unpack('d', $r_squared) ],
);
}
my $fit_order = 4;
my ($coef, $fit_vals, $r_squared) = poly_fit(
[ [ 14.5, 24.5 ], [ 15.5, 25.5 ], [ 15.5, 25.5 ] ],
$fit_order,
)
or die("Error");
print(Dumper($coef, $fit_vals, $r_squared));
a.bat
(This is using mingw installed by Strawberry Perl.)
#echo off
gcc -Wall -Wextra -pedantic -c -DPOLYFITGSL_EXPORTS a.c & gcc -shared -o a.dll a.o -Wl,--out-implib,liba.a & perl a.pl