Блог

Системная среда: 64-разрядная Windows 7 Ultimate; Активное состояние Perl редакция 5 версия 24 subversion 3; Сборка 2404 [404865] скомпилирована 11 декабря 2017 11:09:26.

Я пытаюсь написать сценарий perl, который вызывает функцию, объявленную как:

 extern "C" POLYFITGSL_API int PolyFit(int numPts, const double* xVals, const double* yVals, int fitOrder, double* coef, double* fitVals, double* rSquared);
  

Первые четыре параметра являются входными данными для PolyFit, а последние три являются выходными данными.

С указателями, выделенными в программе на C, она вызывается в такой форме:

  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);
  

DLL экспортирует: отображение DSL Viewer

Попытки использования опции списка параметров не увенчались успехом. Далее, https://metacpan.org/pod/Win32::API#1 рекомендуется импортировать по прототипу. Однако я не знаю, как это написать, и не могу найти пример.

Используя параметр списка параметров в приведенном ниже фрагменте кода, за исключением двух целых чисел, все они определяются как указатели, а для выходных данных массивы, на которые ссылаются, и конечное число с плавающей точкой были предварительно определены и заполнены нулями.

 # 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");
  

При выполнении это приводит к:
Распакованный вызывающий буфер: 600 58497768 58498512 3 58497816 58497840 58489400

Возвращаемые значения: 538976288 538976288 538976288 538976288 538976288 538976288 538976288 538976288 538976288 538976288 538976288 538976288 538976288

Возвращаемое значение вызова равно 52 при всех проверенных условиях.

Выходные массивы и скаляры, на которые ссылаются $coeffsptr, $fitValsptr и $ rSquaredptr, остаются в их инициализированном состоянии.

Значения входного буфера выглядят правильно для меня, а значения указателей выглядят как разумные местоположения в адресном пространстве perl.

Ошибок выполнения не обнаружено, но возвращаемые значения явно недействительны. Я делаю ошибки здесь, но для меня не очевидно, как их устранить.

Между авторитетными лицами существуют разногласия по идентификаторам типов параметров. https://metacpan.org/pod/Win32::API#1 говорит, что двойное значение с плавающей точкой указано с помощью D, но функция pack отклоняет его как недопустимый тип.

Я полагаюсь на этот источник для указания размеров переменных, которые ожидает функция GSL PolyFit: https://www.ibm.com/support/knowledgecenter/en/SSFKSJ_9.0.0/com.ibm.mq.ref.dev.doc/q104610_.htm

Если вместо этого я должен импортировать по прототипу, пример того, как писать операторы import и call, будет иметь большое значение. Я не разработчик, я просто пытаюсь разобраться в науке, и очень важна процедура быстрой подгонки полиномов. Функция GSL PolyFit может подогнать полином третьей степени к 600 точкам данных примерно за 350 микросекунд на этом компьютере с частотой 3,5 ГГц, 7-летней давности.

Большое спасибо за помощь;

Много проблем.

• PNP очевидно, что это неправильно для функции с 7 аргументами.
• Аналогично, что случилось ->Call($parmsbuf, 3, $returnbuf) ?
• N неверный тип возвращаемого значения.
• Win32 :: API использует stdcall соглашение о вызовах по умолчанию, но функция, похоже, использует cdecl соглашение о вызовах.

Вы можете использовать следующее: (Примечания следуют)

 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 ptrsizen");

use constant PTR_WIN32API_TYPE =>
     PTR_SIZE == 8 ? 'DWORD64'
   : PTR_SIZE == 4 ? 'DWORD32'
   : die("Unrecognized ptrsizen");
   
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: $^En");
   }

   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");
  

Или, если вы предпочитаете использовать параллельные массивы для входных данных,

 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");
  

Примечания

Когда я писал приведенный выше код, я думал, что указание соглашения о вызовах, отличного от __stdcall требуемого переключения на синтаксис прототипа Win32: API. Но я ошибся. Я мог бы использовать следующее:

 use constant PTR_WIN32API_TYPE =>
     PTR_SIZE == 8 ? 'Q'
   : PTR_SIZE == 4 ? 'N'
   : die("Unrecognized ptrsizen");

$PolyFit = Win32::API::More->new(
   $dll, 'PolyFit', 'PPiPPP' =~ s/P/PTR_WIN32API_TYPE/ger, 'i', '__cdecl')
  

Анализатор прототипов Win32 :: API очень хромает. Когда он видит const double* xVals , он видит const foo ! И double* xVals не лучше, потому что он просто видит double foo; .

Мы могли бы использовать LPDOUBLE вместо double* , но это не дает нам много. Независимо от того, используется синтаксис прототипа или нет, Win32 :: API ожидает, что мы предоставим одно число, а не массив.

Поэтому мы сами обрабатываем указатели. Сообщая Win32 ::API, что параметры указателя являются целыми числами соответствующего размера ( DWORD32 или DWORD64 в зависимости от того, используем ли мы 32-разрядные или 64-разрядные указатели), мы можем передать указатель без какой-либо интерпретации Win32 :: API.

Далее следует весь мой тест.

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):     %I64un", sizeof(int));
   printf("[C] sizeof(double*): %I64un", sizeof(double*));

   printf("[C] numPts:   %dn", numPts);
   printf("[C] xVals:    %pn", (void*)xVals);
   printf("[C] yVals:    %pn", (void*)yVals);
   printf("[C] fitOrder: %dn", fitOrder);

   printf("[C] coef:     %pn", (void*)coef);
   printf("[C] fitVals:  %pn", (void*)fitVals);
   printf("[C] rSquared: %pn", (void*)rSquared);


   for (int i=0; i<numPts;   i) {
      printf("[C] xVals[%d]: %fn", i, xVals[i]);
      printf("[C] yVals[%d]: %fn", 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 ptrsizen");

use constant PTR_WIN32API_TYPE =>
     PTR_SIZE == 8 ? 'DWORD64'
   : PTR_SIZE == 4 ? 'DWORD32'
   : die("Unrecognized ptrsizen");
   
Win32::API::Type->typedef('uintptr_t' => PTR_WIN32API_TYPE);


my $dll = $0 =~ s/.plz/.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: $^En");
   }

   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*): %un", PTR_SIZE);

   printf("[Perl] numPts:   %dn",    $n);
   printf("[Perl] xVals:    6Xn", get_buffer_addr($x_vals));
   printf("[Perl] yVals:    6Xn", get_buffer_addr($y_vals));
   printf("[Perl] fitOrder: %dn",    $fit_order);

   printf("[Perl] coef:     6Xn", get_buffer_addr($coef));
   printf("[Perl] fitVals:  6Xn", get_buffer_addr($fit_vals));
   printf("[Perl] rSquared: 6Xn", 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

(Для этого используется mingw, установленный Strawberry Perl.)

 @echo off
gcc -Wall -Wextra -pedantic -c -DPOLYFITGSL_EXPORTS a.c amp; gcc -shared -o a.dll a.o -Wl,--out-implib,liba.a amp; perl a.pl