line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package PDL::CallExt; |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
@EXPORT_OK = qw( callext callext_cc ); |
5
|
|
|
|
|
|
|
%EXPORT_TAGS = (Func=>[@EXPORT_OK]); |
6
|
|
|
|
|
|
|
@EXPORT = @EXPORT_OK; |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
607
|
use Config; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
51
|
|
9
|
1
|
|
|
1
|
|
6
|
use PDL::Core; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
6
|
|
10
|
1
|
|
|
1
|
|
8
|
use PDL::Exporter; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
7
|
|
11
|
1
|
|
|
1
|
|
5
|
use DynaLoader; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
32
|
|
12
|
1
|
|
|
1
|
|
7
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
784
|
|
13
|
|
|
|
|
|
|
@ISA = qw( PDL::Exporter DynaLoader ); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
bootstrap PDL::CallExt; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
PDL::CallExt - call functions in external shared libraries |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 SYNOPSIS |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
use PDL::CallExt; |
24
|
|
|
|
|
|
|
callext('file.so', 'foofunc', $x, $y); # pass piddles to foofunc() |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
% perl -MPDL::CallExt -e callext_cc file.c |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 DESCRIPTION |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
callext() loads in a shareable object (i.e. compiled code) using |
31
|
|
|
|
|
|
|
Perl's dynamic loader, calls the named function and passes a list of |
32
|
|
|
|
|
|
|
piddle arguments to it. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
It provides a reasonably portable way of doing this, including |
35
|
|
|
|
|
|
|
compiling the code with the right flags, though it requires simple |
36
|
|
|
|
|
|
|
perl and C wrapper routines to be written. You may prefer to use PP, |
37
|
|
|
|
|
|
|
which is much more portable. See L. You should definitely use |
38
|
|
|
|
|
|
|
the latter for a 'proper' PDL module, or if you run in to the |
39
|
|
|
|
|
|
|
limitations of this module. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head1 API |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
callext_cc() allows one to compile the shared objects using Perl's knowledge |
44
|
|
|
|
|
|
|
of compiler flags. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
The named function (e.g. 'foofunc') must take a list of piddle structures as |
47
|
|
|
|
|
|
|
arguments, there is now way of doing portable general argument construction |
48
|
|
|
|
|
|
|
hence this limitation. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
In detail the code in the original file.c would look like this: |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
#include "pdlsimple.h" /* Declare simple piddle structs - note this .h file |
53
|
|
|
|
|
|
|
contains NO perl/PDL dependencies so can be used |
54
|
|
|
|
|
|
|
standalone */ |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
int foofunc(int nargs, pdlsimple **args); /* foofunc prototype */ |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
i.e. foofunc() takes an array of pointers to pdlsimple structs. The use is |
60
|
|
|
|
|
|
|
similar to that of C in UNIX C applications. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
pdlsimple.h defines a simple N-dimensional data structure which looks like this: |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
struct pdlsimple { |
65
|
|
|
|
|
|
|
int datatype; /* whether byte/int/float etc. */ |
66
|
|
|
|
|
|
|
void *data; /* Generic pointer to the data block */ |
67
|
|
|
|
|
|
|
int nvals; /* Number of data values */ |
68
|
|
|
|
|
|
|
PDL_Long *dims; /* Array of data dimensions */ |
69
|
|
|
|
|
|
|
int ndims; /* Number of data dimensions */ |
70
|
|
|
|
|
|
|
}; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
(PDL_Long is always a 4 byte int and is defined in pdlsimple.h) |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
This is a simplification of the internal representation of piddles in PDL which is |
75
|
|
|
|
|
|
|
more complicated because of threading, dataflow, etc. It will usually be found |
76
|
|
|
|
|
|
|
somewhere like /usr/local/lib/perl5/site_perl/PDL/pdlsimple.h |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
Thus to actually use this to call real functions one would need to write a wrapper. |
79
|
|
|
|
|
|
|
e.g. to call a 2D image processing routine: |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
void myimage_processer(double* image, int nx, int ny); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
int foofunc(int nargs, pdlsimple **args) { |
84
|
|
|
|
|
|
|
pdlsimple* image = pdlsimple[0]; |
85
|
|
|
|
|
|
|
myimage_processer( image->data, *(image->dims), *(image->dims+1) ); |
86
|
|
|
|
|
|
|
... |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Obviously a real wrapper would include more error and argument checking. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
This might be compiled (e.g. Linux): |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
cc -shared -o mycode.so mycode.c |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
In general Perl knows how to do this, so you should be able to get |
96
|
|
|
|
|
|
|
away with: |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
perl -MPDL::CallExt -e callext_cc file.c |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
callext_cc() is a function defined in PDL::CallExt to generate the |
101
|
|
|
|
|
|
|
correct compilation flags for shared objects. |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
If their are problems you will need to refer to you C compiler manual to find |
104
|
|
|
|
|
|
|
out how to generate shared libraries. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
See t/callext.t in the distribution for a working example. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
It is up to the caller to ensure datatypes of piddles are correct - if not |
109
|
|
|
|
|
|
|
peculiar results or SEGVs will result. |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head1 FUNCTIONS |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head2 callext |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=for ref |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Call a function in an external library using Perl dynamic loading |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=for usage |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
callext('file.so', 'foofunc', $x, $y); # pass piddles to foofunc() |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
The file must be compiled with dynamic loading options |
125
|
|
|
|
|
|
|
(see C). See the module docs C |
126
|
|
|
|
|
|
|
for a description of the API. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head2 callext_cc |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=for ref |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Compile external C code for dynamic loading |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=for usage |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Usage: |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
% perl -MPDL::CallExt -e callext_cc file.c -o file.so |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
This works portably because when Perl has built in knowledge of how to do |
141
|
|
|
|
|
|
|
dynamic loading on the system on which it was installed. |
142
|
|
|
|
|
|
|
See the module docs C for a description of |
143
|
|
|
|
|
|
|
the API. |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=cut |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub callext{ |
148
|
1
|
50
|
|
1
|
1
|
21
|
die "Usage: callext(\$file,\$symbol, \@pdl_args)" if scalar(@_)<2; |
149
|
1
|
|
|
|
|
5
|
my($file,$symbol, @pdl_args) = @_; |
150
|
|
|
|
|
|
|
|
151
|
1
|
|
|
|
|
264
|
my $libref = DynaLoader::dl_load_file($file); |
152
|
1
|
50
|
|
|
|
10
|
my $err = DynaLoader::dl_error(); barf $err if !defined $libref; |
|
1
|
|
|
|
|
6
|
|
153
|
1
|
|
|
|
|
9
|
my $symref = DynaLoader::dl_find_symbol($libref, $symbol); |
154
|
1
|
50
|
|
|
|
5
|
$err = DynaLoader::dl_error(); barf $err if !defined $symref; |
|
1
|
|
|
|
|
12
|
|
155
|
|
|
|
|
|
|
|
156
|
1
|
|
|
|
|
45
|
_callext_int($symref, @pdl_args); |
157
|
1
|
|
|
|
|
5
|
1;} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# Compile external C program correctly |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# |
162
|
|
|
|
|
|
|
# callext_cc |
163
|
|
|
|
|
|
|
# |
164
|
|
|
|
|
|
|
# The old version of this routine was taking unstructured arguments and |
165
|
|
|
|
|
|
|
# happily passed this though the C compiler. Unfortunately, on platforms |
166
|
|
|
|
|
|
|
# like HP-UX, we need to make separate cc and ld runs in order to create the |
167
|
|
|
|
|
|
|
# shared objects. |
168
|
|
|
|
|
|
|
# |
169
|
|
|
|
|
|
|
# The signature of the function was therefore changed starting at PDL 2.0. |
170
|
|
|
|
|
|
|
# It is now: |
171
|
|
|
|
|
|
|
# |
172
|
|
|
|
|
|
|
# ($src, $ccflags, $ldflags, $output) |
173
|
|
|
|
|
|
|
# |
174
|
|
|
|
|
|
|
# In its simplest invocation, it can be just $src, and the output will be |
175
|
|
|
|
|
|
|
# derived from the source file. Otherwise, $ccflags add extra C flags, $ldflags |
176
|
|
|
|
|
|
|
# adds extra ld flags, and $output specifies the final target output file name. |
177
|
|
|
|
|
|
|
# If left blank, it will be in the same directory where $src lied. |
178
|
|
|
|
|
|
|
# |
179
|
|
|
|
|
|
|
sub callext_cc { |
180
|
1
|
50
|
|
1
|
1
|
13
|
my @args = @_>0 ? @_ : @ARGV; |
181
|
1
|
|
|
|
|
4
|
my ($src, $ccflags, $ldflags, $output) = @args; |
182
|
1
|
|
|
|
|
2
|
my $cc_obj; |
183
|
1
|
|
|
|
|
37
|
($cc_obj = $src) =~ s/\.c$/$Config{_o}/; |
184
|
1
|
|
|
|
|
4
|
my $ld_obj = $output; |
185
|
1
|
50
|
|
|
|
6
|
($ld_obj = $cc_obj) =~ s/\.o$/\.$Config{dlext}/ unless defined $output; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# Output flags for compiler depend on os. |
188
|
|
|
|
|
|
|
# -o on cc and gcc, or /Fo" " on MS Visual Studio |
189
|
|
|
|
|
|
|
# Need a start and end string |
190
|
1
|
50
|
|
|
|
10
|
my $do = ( $Config{cc} eq 'cl' ? '/Fo"' : '-o '); |
191
|
1
|
50
|
|
|
|
9
|
my $eo = ( $^O =~ /MSWin/i ? '"' : '' ); |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# Compiler command |
194
|
|
|
|
|
|
|
# Placing $ccflags *before* installsitearch/PDL/Core enables us to include |
195
|
|
|
|
|
|
|
# the blib 'pdlsimple.h' during 'make test'. |
196
|
1
|
|
|
|
|
4
|
my $cc_cmd = join(' ', map { $Config{$_} } qw(cc ccflags cccdlflags)) . |
|
3
|
|
|
|
|
83
|
|
197
|
|
|
|
|
|
|
qq{ $ccflags "-I$Config{installsitearch}/PDL/Core" -c $src $do$cc_obj$eo}; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# The linker output flag is -o on cc and gcc, and -out: on MS Visual Studio |
200
|
1
|
50
|
|
|
|
10
|
my $o = ( $Config{cc} eq 'cl' ? '-out:' : '-o '); |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# Setup the LD command. Do not want the env var on Windows |
203
|
1
|
50
|
|
|
|
11
|
my $ld_cmd = ( $^O =~ /MSWin|android/i ? ' ' : 'LD_RUN_PATH="" '); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
my $libs = $^O =~ /MSWin/i ? |
206
|
|
|
|
|
|
|
$Config{libs} : |
207
|
1
|
50
|
|
|
|
6
|
''; # used to be $Config{libs} but that bombs |
208
|
|
|
|
|
|
|
# on recent debian platforms |
209
|
|
|
|
|
|
|
$ld_cmd .= |
210
|
1
|
|
|
|
|
4
|
join(' ', map { $Config{$_} } qw(ld lddlflags)) . |
|
2
|
|
|
|
|
104
|
|
211
|
|
|
|
|
|
|
" $libs $ldflags $o$ld_obj $cc_obj"; |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# Run the command in two steps so that we can check status |
214
|
|
|
|
|
|
|
# of each and also so that we dont have to rely on ';' command |
215
|
|
|
|
|
|
|
# separator |
216
|
|
|
|
|
|
|
|
217
|
1
|
50
|
|
|
|
68188
|
system $cc_cmd and croak "Error compiling $src ($cc_cmd)"; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
# Fix up ActiveState-built perl. Is this a reliable fix ? |
220
|
1
|
50
|
|
|
|
206
|
$ld_cmd =~ s/\-nodefaultlib//g if $Config{cc} eq 'cl'; |
221
|
|
|
|
|
|
|
|
222
|
1
|
50
|
|
|
|
34411
|
system $ld_cmd and croak "Error linking $cc_obj ($ld_cmd)"; |
223
|
1
|
|
|
|
|
141
|
return 1; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=head1 AUTHORS |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Copyright (C) Karl Glazebrook 1997. |
229
|
|
|
|
|
|
|
All rights reserved. There is no warranty. You are allowed |
230
|
|
|
|
|
|
|
to redistribute this software / documentation under certain |
231
|
|
|
|
|
|
|
conditions. For details, see the file COPYING in the PDL |
232
|
|
|
|
|
|
|
distribution. If this file is separated from the PDL distribution, |
233
|
|
|
|
|
|
|
the copyright notice should be included in the file. |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=cut |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# Exit with OK status |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
1; |
241
|
|
|
|
|
|
|
|