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

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;

Will look at it in a few hours. In the meantime, can you confirm that POLYFITGSL_API includes __stdcall — ikegami
– ikegami, Commented Sep 23, 2020 at 22:37
I believe it is not. Here is the declaration in the header file: — oakprairie
– oakprairie, Commented Sep 24, 2020 at 0:46
I meant for this to be included in comment: PolyFitGSL.h - #ifdef POLYFITGSL_EXPORTS #define POLYFITGSL_API __declspec(dllexport) #else #define POLYFITGSL_API __declspec(dllimport) #endif — oakprairie
– oakprairie, Commented Sep 24, 2020 at 0:48
$xValptr and $yValptr are constructed by creating two arrays, loading them with zeros and then creating pointers to them: my $xValsptr = \@xVals; my $yValsptr = \@yVals; — oakprairie
– oakprairie, Commented Sep 24, 2020 at 0:52

ikegami · Accepted Answer · 2020-10-19 07:03:24Z

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

What I had wasn't close to working. Updated with a tested version that works.
Thanks for the extraordinary contribution. The parallel arrays version matches the intended use. In a test script, I populate input X and Y arrays: ```` my @XVals = (1,2,3,4,5,6,7,8,9,10); my @YVals = (12.36,12.32,12.31,12.37,12.44,12.44,12.5,12.46,12.48,12.51); and call poly_fit in this form: my ($coef, $fitVals, $r_squared) = poly_fit( \@XVals, \@YVals, $fitorder, ) ```` However, execution fails at the attempt to create PolyFit, with no error code I've been able to trap.

Collectives™ on Stack Overflow

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

1 Answer 1

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related