File Coverage

blib/lib/FFI/Platypus/Lang/Pascal.pm
Criterion Covered Total %
statement 16 55 29.0
branch 0 16 0.0
condition n/a
subroutine 6 9 66.6
pod 2 2 100.0
total 24 82 29.2


line stmt bran cond sub pod time code
1             package FFI::Platypus::Lang::Pascal;
2              
3 3     3   19134 use strict;
  3         6  
  3         116  
4 3     3   15 use warnings;
  3         3  
  3         96  
5 3     3   15 use Carp qw( croak );
  3         4  
  3         244  
6 3     3   1396 use FFI::Platypus;
  3         11842  
  3         125  
7 3     3   1631 use FFI::ExtractSymbols;
  3         12949  
  3         1779  
8              
9             our $VERSION = '0.04';
10              
11             =head1 NAME
12              
13             FFI::Platypus::Lang::Pascal - Documentation and tools for using Platypus with
14             the Free Pascal programming language
15              
16             =head1 SYNOPSIS
17              
18             Free Pascal:
19              
20             { compile and link with: fpc mylib.pas }
21            
22             Library MyLib;
23            
24             Function Add(A: Integer; B: Integer): Integer; Cdecl;
25             Begin
26             Add := A + B;
27             End;
28            
29             Exports
30             Add;
31            
32             End.
33              
34             Perl:
35              
36             use FFI::Platypus;
37            
38             my $ffi = FFI::Platypus->new;
39             $ffi->lang('Pascal');
40             $ffi->lib('./libmylib.so');
41            
42             $ffi->attach(
43             Add => ['Integer','Integer'] => 'Integer'
44             );
45            
46             print Add(1,2), "\n";
47              
48             =head1 DESCRIPTION
49              
50             This modules provides native types and demangling for the Free Pascal
51             Programming language when used with L.
52              
53             This module provides these types (case sensitive):
54              
55             =over 4
56              
57             =item Byte
58              
59             =item ShortInt
60              
61             =item SmallInt
62              
63             =item Word
64              
65             =item Integer
66              
67             This is an alias for SmallInt (which is appropriate for Free Pascal's default mode)
68              
69             =item Cardinal
70              
71             =item LongInt
72              
73             =item LongWord
74              
75             =item Int64
76              
77             =item QWord
78              
79             =item Boolean
80              
81             =item ByteBool
82              
83             =item WordBool
84              
85             =item LongBool
86              
87             =item Single
88              
89             =item Double
90              
91             =back
92              
93             The following types are not (yet) supported:
94              
95             =over 4
96              
97             =item Extended
98              
99             =item Comp
100              
101             =item Currency
102              
103             =item ShortString
104              
105             =back
106              
107             This module also has some support for demangled functions and overloading, if
108             you are using a dynamic library constructed from units via C.
109              
110             You may also use L to bundle Free Pascal code with
111             your distribution.
112              
113             =head1 CAVEATS
114              
115             I've been experimenting with Free Pascal 2.6.0 while working on this module.
116              
117             =head2 name mangling
118              
119             If you compile one or more Pascal Units and link them using C,
120             they symbols in the resulting dynamic library will include mangled Pascal
121             names. This module has at least some support for such names.
122              
123             For example, suppose you had this Pascal Unit:
124              
125             Unit Add;
126            
127             Interface
128            
129             Function Add( A: SmallInt; B: SmallInt) : SmallInt; Cdecl;
130             Function Add( A: Real; B: Real) : Real; Cdecl;
131            
132             Implementation
133            
134             Function Add( A: SmallInt; B: SmallInt) : SmallInt; Cdecl;
135             Begin
136             Add := A + B;
137             End;
138            
139             Function Add( A: real; B: real) : real; Cdecl;
140             Begin
141             Add := A + B;
142             End;
143            
144             End.
145              
146             On Linux, you could compile and link this into a shared object with these
147             commands:
148              
149             fpc add.pas
150             gcc -o add.so -shared add.o
151              
152             And you could then use it from Perl:
153              
154             use FFI::Platypus;
155            
156             my $ffi = FFI::Platypus->new;
157             $ffi->lang('Pascal');
158             $ffi->lib('./add.so');
159            
160             $ffi->attach(
161             ['Add.Add(SmallInt,SmallInt):SmallInt' => 'Add'] => ['SmallInt','SmallInt'] => 'SmallInt'
162             );
163            
164             print Add(1,2), "\n";
165              
166             When attaching the function you have to specify the argument and return types
167             because the C function is overloaded and is ambiguous without it. If there
168             were just one Add function, then you could attach it like this:
169              
170             $ffi->attach('Add' => ['SmallInt','SmallInt'] => 'SmallInt');
171              
172             The downside to using a shared library constructed from Pascal Units in this
173             way is that the resulting dynamic library does not include the Pascal
174             standard library so very simple capabilities such as IO and ShortString
175             are not available. It is recommended instead to use a Pascal Library
176             (possibly linked with one or more Pascal Units), as inthe L
177             at the top.
178              
179             =head1 METHODS
180              
181             Generally you will not use this class directly, instead interacting with
182             the L instance. However, the public methods used by
183             Platypus are documented here.
184              
185             =head2 native_type_map
186              
187             my $hashref = FFI::Platypus::Lang::Pascal->native_type_map;
188              
189             This returns a hash reference containing the native aliases for the
190             Free Pascal programming languages. That is the keys are native C++
191             types and the values are libffi native types.
192              
193             Types are in camel case. For example use C, not C
194             or C.
195              
196             =cut
197              
198             sub native_type_map
199             {
200             {
201             # Integer Types
202 18     18 1 213 'Byte' => 'uint8',
203             'ShortInt' => 'sint8',
204             'SmallInt' => 'sin16',
205             'Word' => 'uint16',
206             'Integer' => 'sint16', # sint32 in Delphi or ObjFPC mode
207             'Cardinal' => 'uint32',
208             'LongInt' => 'sint32',
209             'LongWord' => 'uint32',
210             'Int64' => 'sint64',
211             'QWord' => 'uint64',
212              
213             # Boolean Types
214             'Boolean' => 'sint8',
215             'ByteBool' => 'sint8',
216             'WordBool' => 'sint16',
217             'LongBool' => 'sint32',
218            
219             # Floating Point Types
220             # http://www.freepascal.org/docs-html/ref/refsu6.html#x28-310003.1.2
221             # Real => either 'float' or 'double'
222             'Single' => 'float',
223             'Double' => 'double',
224             # Extended (size = 10
225             # Comp
226             # Currency
227             },
228             }
229              
230             =head2 mangler
231              
232             my $mangler = FFI::Platypus::Lang::Pascal->mangler($ffi->libs);
233             # prints ADD_ADD$SMALLINT$SMALLINT$$SMALLINT
234             print $mangler->("add(smallint,smallint):smallint");
235              
236             Returns a subroutine reference that will "mangle" C++ names.
237              
238             =cut
239              
240             sub mangler
241             {
242 0     0 1   my($class, @libs) = @_;
243            
244 0           my %mangle;
245            
246 0           foreach my $libpath (@libs)
247             {
248             extract_symbols($libpath,
249             export => sub {
250 0     0     my($symbol1, $symbol2) = @_;
251 0 0         return if $symbol1 =~ /^THREADVARLIST_/;
252 0 0         return unless $symbol1 =~ /^[A-Z0-9_]+(\$[A-Z0-9_]+)*(\$\$[A-Z0-9_]+)?$/;
253 0           my $symbol = $symbol1;
254 0           my $ret = '';
255 0 0         $ret = $1 if $symbol =~ s/\$\$([A-Z_]+)$//;
256 0           my($name, @args) = split /\$/, $symbol;
257 0           $symbol = "${name}(" . join(',', @args) . ')';
258 0 0         $symbol .= ":$ret" if $ret;
259 0           push @{ $mangle{$name} }, [ $symbol, $symbol1 ];
  0            
260             },
261 0           );
262             }
263              
264             sub {
265 0     0     my $symbol = $_[0];
266              
267 0 0         if($symbol =~ /^(.+)\((.*)\)$/)
    0          
268             {
269 0           my $name = uc $1;
270 0           my @args = map { uc $_ } split ',', $2;
  0            
271 0           $name =~ s{\.}{_};
272 0           return join '$', $name, @args;
273             }
274             elsif($symbol =~ /^(.+)\((.*)\):(.*)$/)
275             {
276 0           my $name = uc $1;
277 0           my @args = map { uc $_ } split ',', $2;
  0            
278 0           my $ret = uc $3;
279 0           $name =~ s{\.}{_};
280 0           return join '$', $name, @args, "\$$ret";
281             }
282            
283 0           my $name = uc $symbol;
284 0           $name =~ s/\./_/;
285              
286 0 0         if($mangle{$name})
287             {
288 0 0         if(@{ $mangle{$name} } == 1)
  0            
289             {
290 0           return $mangle{$name}->[0]->[1];
291             }
292             else
293             {
294 0           croak(
295             "$symbol is ambiguous. Please specify one of: " .
296 0           join(', ', map { $_->[0] } @{ $mangle{$name} })
  0            
297             );
298             }
299             }
300 0           $symbol;
301 0           };
302             }
303              
304             1;
305              
306             =head1 EXAMPLES
307              
308             See the above L or the C directory that came with
309             this distribution.
310              
311             =head1 SUPPORT
312              
313             If something does not work as advertised, or the way that you think it
314             should, or if you have a feature request, please open an issue on this
315             project's GitHub issue tracker:
316              
317             L
318              
319             This project's GitHub issue tracker listed above is not Write-Only. If
320             you want to contribute then feel free to browse through the existing
321             issues and see if there is something you feel you might be good at and
322             take a whack at the problem. I frequently open issues myself that I
323             hope will be accomplished by someone in the future but do not have time
324             to immediately implement myself.
325              
326             Another good area to help out in is documentation. I try to make sure
327             that there is good document coverage, that is there should be
328             documentation describing all the public features and warnings about
329             common pitfalls, but an outsider's or alternate view point on such
330             things would be welcome; if you see something confusing or lacks
331             sufficient detail I encourage documentation only pull requests to
332             improve things.
333              
334             =head1 CONTRIBUTING
335              
336             If you have implemented a new feature or fixed a bug then you may make a
337             pull reequest on this project's GitHub repository:
338              
339             L
340              
341             =head1 SEE ALSO
342              
343             =over 4
344              
345             =item L
346              
347             The Core Platypus documentation.
348              
349             =item L
350              
351             Bundle Free Pascal with your FFI / Perl extension.
352              
353             =back
354              
355             =head1 AUTHOR
356              
357             Graham Ollis Eplicease@cpan.orgE
358              
359             =head1 COPYRIGHT AND LICENSE
360              
361             This software is copyright (c) 2015 by Graham Ollis.
362              
363             This is free software; you can redistribute it and/or modify it under
364             the same terms as the Perl 5 programming language system itself.
365              
366             =cut
367