This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid loading .bs files twice when using XSLoader
[perl5.git] / dist / XSLoader / XSLoader_pm.PL
CommitLineData
11fd7d05 1use strict;
9cf41c4d 2use Config;
adedc077
BF
3# We require DynaLoader to make sure that mod2fname is loaded
4eval { require DynaLoader };
9cf41c4d 5
11fd7d05 61 while unlink "XSLoader.pm";
1ae6ead9 7open OUT, '>', 'XSLoader.pm' or die $!;
9cf41c4d 8print OUT <<'EOT';
35e4400b 9# Generated from XSLoader_pm.PL (resolved %Config::Config value)
f24427cc 10# This file is unique for every OS
9cf41c4d
GS
11
12package XSLoader;
13
fc9d6b91 14$VERSION = "0.28";
11fd7d05
RGS
15
16#use strict;
9cf41c4d 17
daef35db
NC
18package DynaLoader;
19
20EOT
21
22# dlutils.c before 5.006 has this:
23#
24# #ifdef DEBUGGING
25# dl_debug = SvIV( perl_get_sv("DynaLoader::dl_debug", 0x04) );
26# #endif
27#
28# where 0x04 is GV_ADDWARN, which causes a warning to be issued by the call
29# into XS below, if DynaLoader.pm hasn't been loaded.
30# It was changed to 0 in the commit(s) that added XSLoader to the core
31# (9cf41c4d23a47c8b and its parent 9426adcd48655815)
32# Hence to backport XSLoader to work silently with earlier DynaLoaders we need
33# to ensure that the variable exists:
34
35print OUT <<'EOT' if $] < 5.006;
36
9cf41c4d 37# enable debug/trace messages from DynaLoader perl code
daef35db 38$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
9cf41c4d 39
daef35db 40EOT
b4cea227 41
daef35db 42print OUT <<'EOT';
b4cea227
GS
43# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
44# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB
9cf41c4d 45boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
b4cea227 46 !defined(&dl_error);
9cf41c4d
GS
47package XSLoader;
48
9cf41c4d
GS
49sub load {
50 package DynaLoader;
51
30837b2a
GK
52 my ($caller, $modlibname) = caller();
53 my $module = $caller;
9e8c31cc 54
1d2b7ec5 55 if (@_) {
e6ea8c3b 56 $module = $_[0];
1d2b7ec5 57 } else {
e6ea8c3b 58 $_[0] = $module;
1d2b7ec5 59 }
9cf41c4d
GS
60
61 # work with static linking too
73bf7552
AT
62 my $boots = "$module\::bootstrap";
63 goto &$boots if defined &$boots;
9cf41c4d 64
6e0eede9 65 goto \&XSLoader::bootstrap_inherit unless $module and defined &dl_load_file;
9cf41c4d
GS
66
67 my @modparts = split(/::/,$module);
68 my $modfname = $modparts[-1];
69
70EOT
71
4821216b
BF
72# defined &DynaLoader::mod2fname catches most cases, except when
73# cross-compiling to a system that defines mod2fname. Using
74# $Config{d_libname_unique} is a best attempt at catching those cases.
75print OUT <<'EOT' if defined &DynaLoader::mod2fname || $Config{d_libname_unique};
9cf41c4d
GS
76 # Some systems have restrictions on files names for DLL's etc.
77 # mod2fname returns appropriate file base name (typically truncated)
78 # It may also edit @modparts if required.
4821216b 79 $modfname = &DynaLoader::mod2fname(\@modparts) if defined &DynaLoader::mod2fname;
9cf41c4d
GS
80
81EOT
82
9d419b5f
IZ
83print OUT <<'EOT' if $^O eq 'os2';
84
85 # os2 static build can dynaload, but cannot dynaload Perl modules...
86 die 'Dynaloaded Perl modules are not available in this build of Perl' if $OS2::is_static;
87
88EOT
b0d07b4e 89
9cf41c4d
GS
90print OUT <<'EOT';
91 my $modpname = join('/',@modparts);
30837b2a 92 my $c = () = split(/::/,$caller,-1);
e6ea8c3b 93 $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
a651dcdf
FC
94EOT
95
96my $to_print = <<'EOT';
08e3451d 97 # Does this look like a relative path?
a651dcdf
FC
98 if ($modlibname !~ m{regexp}) {
99EOT
100
101$to_print =~ s~regexp~
102 $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'amigaos'
103 ? '^(?:[A-Za-z]:)?[\\\/]' # Optional drive letter
104 : '^/'
105~e;
106
107print OUT $to_print, <<'EOT';
08e3451d
FC
108 # Someone may have a #line directive that changes the file name, or
109 # may be calling XSLoader::load from inside a string eval. We cer-
110 # tainly do not want to go loading some code that is not in @INC,
111 # as it could be untrusted.
112 #
113 # We could just fall back to DynaLoader here, but then the rest of
114 # this function would go untested in the perl core, since all @INC
115 # paths are relative during testing. That would be a time bomb
116 # waiting to happen, since bugs could be introduced into the code.
117 #
118 # So look through @INC to see if $modlibname is in it. A rela-
119 # tive $modlibname is not a common occurrence, so this block is
120 # not hot code.
121 FOUND: {
122 for (@INC) {
123 if ($_ eq $modlibname) {
124 last FOUND;
125 }
126 }
127 # Not found. Fall back to DynaLoader.
128 goto \&XSLoader::bootstrap_inherit;
129 }
130 }
f4b4ed7b
NC
131EOT
132
133my $dl_dlext = quotemeta($Config::Config{'dlext'});
134
135print OUT <<"EOT";
136 my \$file = "\$modlibname/auto/\$modpname/\$modfname.$dl_dlext";
137EOT
138
139print OUT <<'EOT';
9cf41c4d
GS
140
141# print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;
142
143 my $bs = $file;
144 $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
145
73bf7552 146 if (-s $bs) { # only read file if it's not empty
80a65c70 147# print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug;
fc9d6b91 148 # This calls DynaLoader::bootstrap, which loads the .bs file
4c7a0d98 149 goto \&XSLoader::bootstrap_inherit;
73bf7552
AT
150 }
151
4c7a0d98 152 goto \&XSLoader::bootstrap_inherit if not -f $file;
9cf41c4d
GS
153
154 my $bootname = "boot_$module";
155 $bootname =~ s/\W/_/g;
11fd7d05 156 @DynaLoader::dl_require_symbols = ($bootname);
9cf41c4d 157
588cafc8
DM
158 my $boot_symbol_ref;
159
68d3ba50
VK
160EOT
161
588cafc8 162 if ($^O eq 'darwin') {
c35721ed
RU
163 my $extra_arg = ', 1 ' if $DynaLoader::VERSION ge '1.37';
164print OUT <<"EOT";
165 if (\$boot_symbol_ref = dl_find_symbol( 0, \$bootname $extra_arg)) {
166 goto boot; #extension library has already been loaded, e.g. darwin
167 }
68d3ba50 168EOT
588cafc8
DM
169 }
170
68d3ba50 171print OUT <<'EOT';
9cf41c4d
GS
172 # Many dynamic extension loading problems will appear to come from
173 # this section of code: XYZ failed at line 123 of DynaLoader.pm.
174 # Often these errors are actually occurring in the initialisation
175 # C code of the extension XS file. Perl reports the error as being
176 # in this perl code simply because this was the last perl code
177 # it executed.
178
179 my $libref = dl_load_file($file, 0) or do {
11fd7d05
RGS
180 require Carp;
181 Carp::croak("Can't load '$file' for module $module: " . dl_error());
9cf41c4d 182 };
11fd7d05 183 push(@DynaLoader::dl_librefs,$libref); # record loaded object
9cf41c4d 184
f24427cc
DD
185EOT
186my $dlsrc = $Config{dlsrc};
187if ($dlsrc eq 'dl_freemint.xs' || $dlsrc eq 'dl_dld.xs') {
188 print OUT <<'EOT';
9cf41c4d
GS
189 my @unresolved = dl_undef_symbols();
190 if (@unresolved) {
11fd7d05
RGS
191 require Carp;
192 Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
9cf41c4d
GS
193 }
194
f24427cc
DD
195EOT
196}
197
198print OUT <<'EOT';
588cafc8 199 $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
11fd7d05
RGS
200 require Carp;
201 Carp::croak("Can't find '$bootname' symbol in $file\n");
9cf41c4d
GS
202 };
203
11fd7d05 204 push(@DynaLoader::dl_modules, $module); # record loaded module
9cf41c4d 205
588cafc8 206 boot:
73bf7552 207 my $xs = dl_install_xsub($boots, $boot_symbol_ref, $file);
588cafc8 208
9cf41c4d 209 # See comment block above
89166d32 210 push(@DynaLoader::dl_shared_objects, $file); # record files loaded
9cf41c4d 211 return &$xs(@_);
6e0eede9
NC
212}
213EOT
214
e6ea8c3b 215# Can't test with DynaLoader->can('bootstrap_inherit') when building in the
6e0eede9 216# core, as XSLoader gets built before DynaLoader.
9cf41c4d 217
6e0eede9
NC
218if ($] >= 5.006) {
219 print OUT <<'EOT';
220
221sub bootstrap_inherit {
222 require DynaLoader;
223 goto \&DynaLoader::bootstrap_inherit;
11fd7d05
RGS
224}
225
6e0eede9
NC
226EOT
227} else {
228 print OUT <<'EOT';
229
11fd7d05 230sub bootstrap_inherit {
6e0eede9 231 # Versions of DynaLoader prior to 5.6.0 don't have bootstrap_inherit.
11fd7d05
RGS
232 package DynaLoader;
233
234 my $module = $_[0];
235 local *DynaLoader::isa = *{"$module\::ISA"};
236 local @DynaLoader::isa = (@DynaLoader::isa, 'DynaLoader');
237 # Cannot goto due to delocalization. Will report errors on a wrong line?
9cf41c4d 238 require DynaLoader;
11fd7d05 239 DynaLoader::bootstrap(@_);
9cf41c4d
GS
240}
241
6e0eede9
NC
242EOT
243}
244
245print OUT <<'EOT';
9e8c31cc
MS
2461;
247
11fd7d05 248
9cf41c4d
GS
249__END__
250
251=head1 NAME
252
253XSLoader - Dynamically load C libraries into Perl code
254
11fd7d05
RGS
255=head1 VERSION
256
6f2c9cc3 257Version 0.24
11fd7d05 258
9cf41c4d
GS
259=head1 SYNOPSIS
260
261 package YourPackage;
1d2b7ec5 262 require XSLoader;
9cf41c4d 263
1d2b7ec5 264 XSLoader::load();
9cf41c4d
GS
265
266=head1 DESCRIPTION
267
268This module defines a standard I<simplified> interface to the dynamic
269linking mechanisms available on many platforms. Its primary purpose is
270to implement cheap automatic dynamic loading of Perl modules.
271
4406dda9 272For a more complicated interface, see L<DynaLoader>. Many (most)
11fd7d05
RGS
273features of C<DynaLoader> are not implemented in C<XSLoader>, like for
274example the C<dl_load_flags>, not honored by C<XSLoader>.
9cf41c4d 275
d7f44de2
IZ
276=head2 Migration from C<DynaLoader>
277
278A typical module using L<DynaLoader|DynaLoader> starts like this:
279
280 package YourPackage;
281 require DynaLoader;
282
283 our @ISA = qw( OnePackage OtherPackage DynaLoader );
284 our $VERSION = '0.01';
285 bootstrap YourPackage $VERSION;
286
287Change this to
288
289 package YourPackage;
290 use XSLoader;
291
292 our @ISA = qw( OnePackage OtherPackage );
293 our $VERSION = '0.01';
294 XSLoader::load 'YourPackage', $VERSION;
295
296In other words: replace C<require DynaLoader> by C<use XSLoader>, remove
11fd7d05 297C<DynaLoader> from C<@ISA>, change C<bootstrap> by C<XSLoader::load>. Do not
d7f44de2 298forget to quote the name of your package on the C<XSLoader::load> line,
9c6b46e2 299and add comma (C<,>) before the arguments (C<$VERSION> above).
d7f44de2 300
11fd7d05
RGS
301Of course, if C<@ISA> contained only C<DynaLoader>, there is no need to have
302the C<@ISA> assignment at all; moreover, if instead of C<our> one uses the
303more backward-compatible
d7f44de2
IZ
304
305 use vars qw($VERSION @ISA);
306
11fd7d05 307one can remove this reference to C<@ISA> together with the C<@ISA> assignment.
d7f44de2 308
11fd7d05 309If no C<$VERSION> was specified on the C<bootstrap> line, the last line becomes
d7f44de2
IZ
310
311 XSLoader::load 'YourPackage';
312
681a49bf 313If the call to C<load> is from C<YourPackage>, then that can be further
1d2b7ec5
NC
314simplified to
315
316 XSLoader::load();
317
318as C<load> will use C<caller> to determine the package.
319
d7f44de2
IZ
320=head2 Backward compatible boilerplate
321
322If you want to have your cake and eat it too, you need a more complicated
323boilerplate.
324
325 package YourPackage;
326 use vars qw($VERSION @ISA);
327
328 @ISA = qw( OnePackage OtherPackage );
329 $VERSION = '0.01';
330 eval {
331 require XSLoader;
332 XSLoader::load('YourPackage', $VERSION);
333 1;
334 } or do {
335 require DynaLoader;
336 push @ISA, 'DynaLoader';
337 bootstrap YourPackage $VERSION;
338 };
339
11fd7d05 340The parentheses about C<XSLoader::load()> arguments are needed since we replaced
d7f44de2 341C<use XSLoader> by C<require>, so the compiler does not know that a function
11fd7d05 342C<XSLoader::load()> is present.
d7f44de2
IZ
343
344This boilerplate uses the low-overhead C<XSLoader> if present; if used with
681a49bf 345an antique Perl which has no C<XSLoader>, it falls back to using C<DynaLoader>.
d7f44de2
IZ
346
347=head1 Order of initialization: early load()
348
349I<Skip this section if the XSUB functions are supposed to be called from other
350modules only; read it only if you call your XSUBs from the code in your module,
351or have a C<BOOT:> section in your XS file (see L<perlxs/"The BOOT: Keyword">).
4406dda9 352What is described here is equally applicable to the L<DynaLoader|DynaLoader>
d7f44de2
IZ
353interface.>
354
355A sufficiently complicated module using XS would have both Perl code (defined
356in F<YourPackage.pm>) and XS code (defined in F<YourPackage.xs>). If this
357Perl code makes calls into this XS code, and/or this XS code makes calls to
358the Perl code, one should be careful with the order of initialization.
359
3a1b0858
NC
360The call to C<XSLoader::load()> (or C<bootstrap()>) calls the module's
361bootstrap code. For modules build by F<xsubpp> (nearly all modules) this
362has three side effects:
d7f44de2
IZ
363
364=over
365
366=item *
367
3a1b0858
NC
368A sanity check is done to ensure that the versions of the F<.pm> and the
369(compiled) F<.xs> parts are compatible. If C<$VERSION> was specified, this
370is used for the check. If not specified, it defaults to
371C<$XS_VERSION // $VERSION> (in the module's namespace)
d7f44de2
IZ
372
373=item *
374
3a1b0858 375the XSUBs are made accessible from Perl
d7f44de2
IZ
376
377=item *
378
4406dda9 379if a C<BOOT:> section was present in the F<.xs> file, the code there is called.
d7f44de2
IZ
380
381=back
382
4406dda9 383Consequently, if the code in the F<.pm> file makes calls to these XSUBs, it is
d7f44de2
IZ
384convenient to have XSUBs installed before the Perl code is defined; for
385example, this makes prototypes for XSUBs visible to this Perl code.
386Alternatively, if the C<BOOT:> section makes calls to Perl functions (or
4406dda9 387uses Perl variables) defined in the F<.pm> file, they must be defined prior to
11fd7d05 388the call to C<XSLoader::load()> (or C<bootstrap()>).
d7f44de2
IZ
389
390The first situation being much more frequent, it makes sense to rewrite the
391boilerplate as
392
393 package YourPackage;
394 use XSLoader;
395 use vars qw($VERSION @ISA);
396
397 BEGIN {
398 @ISA = qw( OnePackage OtherPackage );
399 $VERSION = '0.01';
400
401 # Put Perl code used in the BOOT: section here
402
403 XSLoader::load 'YourPackage', $VERSION;
404 }
405
406 # Put Perl code making calls into XSUBs here
407
408=head2 The most hairy case
409
410If the interdependence of your C<BOOT:> section and Perl code is
411more complicated than this (e.g., the C<BOOT:> section makes calls to Perl
412functions which make calls to XSUBs with prototypes), get rid of the C<BOOT:>
11fd7d05 413section altogether. Replace it with a function C<onBOOT()>, and call it like
d7f44de2
IZ
414this:
415
416 package YourPackage;
417 use XSLoader;
418 use vars qw($VERSION @ISA);
419
420 BEGIN {
421 @ISA = qw( OnePackage OtherPackage );
422 $VERSION = '0.01';
423 XSLoader::load 'YourPackage', $VERSION;
424 }
425
426 # Put Perl code used in onBOOT() function here; calls to XSUBs are
427 # prototype-checked.
428
429 onBOOT;
430
431 # Put Perl initialization code assuming that XS is initialized here
432
11fd7d05
RGS
433
434=head1 DIAGNOSTICS
435
150e77ce 436=over
11fd7d05 437
150e77ce 438=item C<Can't find '%s' symbol in %s>
11fd7d05
RGS
439
440B<(F)> The bootstrap symbol could not be found in the extension module.
441
150e77ce 442=item C<Can't load '%s' for module %s: %s>
11fd7d05
RGS
443
444B<(F)> The loading or initialisation of the extension module failed.
445The detailed error follows.
446
150e77ce 447=item C<Undefined symbols present after loading %s: %s>
11fd7d05
RGS
448
449B<(W)> As the message says, some symbols stay undefined although the
450extension module was correctly loaded and initialised. The list of undefined
451symbols follows.
452
11fd7d05
RGS
453=back
454
d7f44de2
IZ
455=head1 LIMITATIONS
456
457To reduce the overhead as much as possible, only one possible location
458is checked to find the extension DLL (this location is where C<make install>
459would put the DLL). If not found, the search for the DLL is transparently
11fd7d05 460delegated to C<DynaLoader>, which looks for the DLL along the C<@INC> list.
d7f44de2 461
11fd7d05 462In particular, this is applicable to the structure of C<@INC> used for testing
4406dda9
RGS
463not-yet-installed extensions. This means that running uninstalled extensions
464may have much more overhead than running the same extensions after
d7f44de2
IZ
465C<make install>.
466
11fd7d05 467
e6ea8c3b
CBW
468=head1 KNOWN BUGS
469
470The new simpler way to call C<XSLoader::load()> with no arguments at all
471does not work on Perl 5.8.4 and 5.8.5.
472
473
11fd7d05
RGS
474=head1 BUGS
475
9c6b46e2 476Please report any bugs or feature requests via the perlbug(1) utility.
11fd7d05
RGS
477
478
479=head1 SEE ALSO
480
481L<DynaLoader>
482
483
9c6b46e2 484=head1 AUTHORS
9cf41c4d 485
11fd7d05
RGS
486Ilya Zakharevich originally extracted C<XSLoader> from C<DynaLoader>.
487
488CPAN version is currently maintained by SE<eacute>bastien Aperghis-Tramoni
150e77ce 489E<lt>sebastien@aperghis.netE<gt>.
11fd7d05 490
150e77ce 491Previous maintainer was Michael G Schwern <schwern@pobox.com>.
11fd7d05
RGS
492
493
73bf7552
AT
494=head1 COPYRIGHT & LICENSE
495
e6ea8c3b 496Copyright (C) 1990-2011 by Larry Wall and others.
11fd7d05
RGS
497
498This program is free software; you can redistribute it and/or modify
499it under the same terms as Perl itself.
9cf41c4d
GS
500
501=cut
502EOT
503
504close OUT or die $!;