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;
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
I'm following this example but I'm not sure what I missed. Specifically, I have this struct in MATLAB:
a = struct; a.one = 1.0; a.two = 2.0; a.three = 3.0; a.four = 4.0;
And this is my test code in MEX ---
First, I wanted to make sure that I'm passing in the right thing, so I did this check:
int nfields = mxGetNumberOfFields(prhs[0]);
mexPrintf("nfields =%i \n\n", nfields);
And it does yield 4, since I have four fields.
However, when I tried to extract the value in field three:
tmp = mxGetField(prhs[0], 0, "three");
mexPrintf("data =%f \n\n", (double *)mxGetData(tmp) );
It returns data =1.000000. I'm not sure what I did wrong. My logic is that I want to get the first element (hence index is 0) of the field three, so I expected data =3.00000.
Can I get a pointer or a hint?
EDITED
Ok, since you didn't provide your full code but you are working on a test, let's try to make a new one from scratch.
On Matlab side, use the following code:
a.one = 1;
a.two = 2;
a.three = 3;
a.four = 4;
read_struct(a);
Now, create and compile the MEX read_struct function as follows:
#include "mex.h"
void read_struct(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
if (nrhs != 1)
mexErrMsgTxt("One input argument required.");
/* Let's check if the input is a struct... */
if (!mxIsStruct(prhs[0]))
mexErrMsgTxt("The input must be a structure.");
int ne = mxGetNumberOfElements(prhs[0]);
int nf = mxGetNumberOfFields(prhs[0]);
mexPrintf("The structure contains %i elements and %i fields.\n", ne, nf);
mwIndex i;
mwIndex j;
mxArray *mxValue;
double *value;
for (i = 0; i < nf; ++i)
{
for (j = 0; j < ne; ++j)
{
mxValue = mxGetFieldByNumber(prhs[0], j, i);
value = mxGetPr(mxValue);
mexPrintf("Field %s(%d) = %.1f\n", mxGetFieldNameByNumber(prhs[0],i), j, value[0]);
}
}
return;
}
Does this correctly prints your structure?
I've checked other similar posts but I think I just need a second set of eyes. This file is for the lex Unix utility.
I created a makefile and this is the error I receive:
gcc -g -c lex.yy.c
cxref.l:57: error: expected ‘;’, ‘,’ or ‘)’ before numeric constant
make: *** [lex.yy.o] Error 1
Line 57 is just inside the void inserID() function near the top.
Here is the code:
%{
#include <stdio.h>
#include <string.h>
char identifier[1000][82];
char linesFound[100][100];
void insertId(char*, int);
int i = 0;
int lineNum = 1;
%}
%x comment
%s str
%%
"/*" BEGIN(comment);
<comment>[^*\n]* /* eat anything that's not a '*' */
<comment>"*"+[^*/\n]* /* eat up '*'s not followed by '/'s */
<comment>\n ++lineNum;
<comment>"*"+"/" BEGIN(INITIAL);
"\n" ++lineNum;
auto ;
break ;
case ;
char ;
continue ;
default ;
do ;
double ;
else ;
extern ;
float ;
for ;
goto ;
if ;
int ;
long ;
register ;
return ;
short ;
sizeof ;
static ;
struct ;
switch ;
typedef ;
union ;
unsigned ;
void ;
while ;
[*]?[a-zA-Z][a-zA-Z0-9_]* insertId(yytext, lineNum);
[^a-zA-Z0-9_]+ ;
[0-9]+ ;
%%
void insertId(char* str, int nLine)
{
char num[2];
sprintf ( num, "%d", nLine);
int iter;
for(iter = 0; iter <= i; iter++)
{
if ( strcmp(identifier[iter], str) == 0 )
{
strcat( linesFound[iter], ", " );
strcat( linesFound[iter], num );
return;
}
}
strcpy( identifier[i], str );
strcat( identifier[i], ": " );
strcpy( linesFound[i], num );
i++;
}
Your problem is:
%s str
There is a reason that it's normal to write condition names in CAPS: it makes them look like macros, which is exactly what they are.
So
void insertId(char* str, int nLine)
get macro expanded to something like:
void insertId(char* 2, int nLine)
and the compiler complains that 2 is not really expected at that point in the declaration.
I built a Perl Inline::C module, but there is some oddity with the sorting. Does anyone know why it would sort like this? Why is the 4.0e-5 is not first?
my $ref = [ 5.0e-5,4.2e-5,4.3e-5,4.4e-5,4.4e-5,4.2e-5,4.2e-5,4.0e-5];
use Inline C => <<'END_OF_C_CODE';
void test(SV* sv, ...) {
I32 i;
I32 arrayLen;
AV* data;
float retval;
SV** pvalue;
Inline_Stack_Vars;
data = SvUV(Inline_Stack_Item(0));
/* Determine the length of the array */
arrayLen = av_len(data);
// sort
sortsv(AvARRAY(data),arrayLen+1,Perl_sv_cmp_locale);
for (i = 0; i < arrayLen+1; i++) {
pvalue = av_fetch(data,i,0); /* fetch the scalar located at i .*/
retval = SvNV(*pvalue); /* dereference the scalar into a number. */
printf("%f \n",newSVnv(retval));
}
}
END_OF_C_CODE
test($ref);
0.000042
0.000042
0.000042
0.000043
0.000044
0.000044
0.000040
0.000050
Because you are sorting lexically, Try this code:
#!/usr/bin/perl
use strict;
use warnings;
my $ref = [ 5.0e-5,4.2e-5,4.3e-5,4.4e-5,4.4e-5,4.2e-5,4.2e-5,4.0e-5];
print "Perl with cmp\n";
for my $val (sort #$ref) {
printf "%f \n", $val;
}
print "Perl with <=>\n";
for my $val (sort { $a <=> $b } #$ref) {
printf "%f \n", $val;
}
print "C\n";
test($ref);
use Inline C => <<'END_OF_C_CODE';
void test(SV* sv, ...) {
I32 i;
I32 arrayLen;
AV* data;
float retval;
SV** pvalue;
Inline_Stack_Vars;
data = SvUV(Inline_Stack_Item(0));
/* Determine the length of the array */
arrayLen = av_len(data);
// sort
sortsv(AvARRAY(data),av_len(data)+1,Perl_sv_cmp_locale);
arrayLen = av_len(data);
for (i = 0; i < arrayLen+1; i++) {
pvalue = av_fetch(data,i,0); /* fetch the scalar located at i .*/
retval = SvNV(*pvalue); /* dereference the scalar into a number. */
printf("%f \n",newSVnv(retval));
}
}
END_OF_C_CODE
Of course, lexically 0.00040 is smaller than 0.00042 as well, but you aren't comparing 0.00040 to 0.00042; you are comparing the number 0.00040 converted to a string with the number 0.00042 converted to a string. When a number gets too large or small, Perl's stringifying logic resorts to using scientific notation. So you are sorting the set of strings
"4.2e-05", "4.2e-05", "4.2e-05", "4.3e-05", "4.4e-05", "4.4e-05", "4e-05", "5e-05"
which are properly sorted. Perl happily turns those strings back into their numbers when you ask it to with the %f format in printf. You could stringify the numbers yourself, but since you have stated you want this to be faster, that would be a mistake. You should not to be trying to optimize the program before you know where it slow (premature optimization is the root of all evil*). Write your code then run Devel::NYTProf against it to find where it is slow. If necessary, rewrite those portions in XS or Inline::C (I prefer XS). You will find that you get more speed out of choosing the right data structure than micro-optimizations like this.
* Knuth, Donald. Structured Programming with go to Statements, ACM Journal Computing Surveys, Vol 6, No. 4, Dec. 1974. p.268.
Perl_sv_cmp_locale is your sorting function which I suspect is lexical comparison. Look for numeric sorting one or write your own.
Have an answer with help from the people over at http://www.perlmonks.org/?node_id=761015
I ran some profiling (DProf) and it's a 4x improvement in speed
Total Elapsed Time = 0.543205 Seconds
User+System Time = 0.585454 Seconds
Exclusive Times
%Time ExclSec CumulS #Calls sec/call Csec/c Name
100. 0.590 0.490 100000 0.0000 0.0000 test_inline_c_pkg::percent2
Total Elapsed Time = 2.151647 Seconds
User+System Time = 1.991647 Seconds
Exclusive Times
%Time ExclSec CumulS #Calls sec/call Csec/c Name
104. 2.080 1.930 100000 0.0000 0.0000 main::percent2
Here is the code
use Inline C => <<'END_OF_C_CODE';
#define SvSIOK(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) == SVf_IOK)
#define SvNSIV(sv) (SvNOK(sv) ? SvNVX(sv) : (SvSIOK(sv) ? SvIVX(sv) : sv_2nv(sv)))
static I32 S_sv_ncmp(pTHX_ SV *a, SV *b) {
const NV nv1 = SvNSIV(a);
const NV nv2 = SvNSIV(b);
return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
}
void test(SV* sv, ...) {
I32 i;
I32 arrayLen;
AV* data;
float retval;
SV** pvalue;
Inline_Stack_Vars;
data = SvUV(Inline_Stack_Item(0));
/* Determine the length of the array */
arrayLen = av_len(data);
/* sort descending (send numerical sort function S_sv_ncmp) */
sortsv(AvARRAY(data),arrayLen+1, S_sv_ncmp);
for (i = 0; i < arrayLen+1; i++) {
pvalue = av_fetch(data,i,0); /* fetch the scalar located at i .*/
retval = SvNV(*pvalue); /* dereference the scalar into a number. */
printf("%f \n",newSVnv(retval));
}
}
END_OF_C_CODE