File Coverage

blib/lib/PDL/CallExt.pm
Criterion Covered Total %
statement 44 44 100.0
branch 13 26 50.0
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 66 79 83.5


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   398 use Config;
  1         2  
  1         35  
9 1     1   4 use PDL::Core;
  1         2  
  1         4  
10 1     1   7 use PDL::Exporter;
  1         1  
  1         6  
11 1     1   5 use DynaLoader;
  1         2  
  1         25  
12 1     1   6 use Carp;
  1         2  
  1         565  
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 6 die "Usage: callext(\$file,\$symbol, \@pdl_args)" if scalar(@_)<2;
149 1         9 my($file,$symbol, @pdl_args) = @_;
150              
151 1         145 my $libref = DynaLoader::dl_load_file($file);
152 1 50       10 my $err = DynaLoader::dl_error(); barf $err if !defined $libref;
  1         9  
153 1         8 my $symref = DynaLoader::dl_find_symbol($libref, $symbol);
154 1 50       12 $err = DynaLoader::dl_error(); barf $err if !defined $symref;
  1         4  
155              
156 1         32 _callext_int($symref, @pdl_args);
157 1         4 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 10 my @args = @_>0 ? @_ : @ARGV;
181 1         4 my ($src, $ccflags, $ldflags, $output) = @args;
182 1         2 my $cc_obj;
183 1         29 ($cc_obj = $src) =~ s/\.c$/$Config{_o}/;
184 1         4 my $ld_obj = $output;
185 1 50       5 ($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       8 my $do = ( $Config{cc} eq 'cl' ? '/Fo"' : '-o ');
191 1 50       6 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         3 my $cc_cmd = join(' ', map { $Config{$_} } qw(cc ccflags cccdlflags)) .
  3         64  
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       8 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       6 my $ld_cmd = ( $^O =~ /MSWin|android/i ? ' ' : 'LD_RUN_PATH="" ');
204              
205             my $libs = $^O =~ /MSWin/i ?
206             $Config{libs} :
207 1 50       4 ''; # used to be $Config{libs} but that bombs
208             # on recent debian platforms
209             $ld_cmd .=
210 1         3 join(' ', map { $Config{$_} } qw(ld lddlflags)) .
  2         82  
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       54263 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       143 $ld_cmd =~ s/\-nodefaultlib//g if $Config{cc} eq 'cl';
221              
222 1 50       28510 system $ld_cmd and croak "Error linking $cc_obj ($ld_cmd)";
223 1         101 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