xref: /openbsd-src/gnu/usr.bin/perl/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c) 
1package ExtUtils::Mksymlists;
2
3use 5.006;
4use strict qw[ subs refs ];
5# no strict 'vars';  # until filehandles are exempted
6
7use Carp;
8use Exporter;
9use Config;
10
11our @ISA = qw(Exporter);
12our @EXPORT = qw(&Mksymlists);
13our $VERSION = '6.98_01';
14
15sub Mksymlists {
16    my(%spec) = @_;
17    my($osname) = $^O;
18
19    croak("Insufficient information specified to Mksymlists")
20        unless ( $spec{NAME} or
21                 ($spec{FILE} and ($spec{DL_FUNCS} or $spec{FUNCLIST})) );
22
23    $spec{DL_VARS} = [] unless $spec{DL_VARS};
24    ($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE};
25    $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
26    $spec{DL_FUNCS} = { $spec{NAME} => [] }
27        unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or
28                 @{$spec{FUNCLIST}});
29    if (defined $spec{DL_FUNCS}) {
30        foreach my $package (sort keys %{$spec{DL_FUNCS}}) {
31            my($packprefix,$bootseen);
32            ($packprefix = $package) =~ s/\W/_/g;
33            foreach my $sym (@{$spec{DL_FUNCS}->{$package}}) {
34                if ($sym =~ /^boot_/) {
35                    push(@{$spec{FUNCLIST}},$sym);
36                    $bootseen++;
37                }
38                else {
39                    push(@{$spec{FUNCLIST}},"XS_${packprefix}_$sym");
40                }
41            }
42            push(@{$spec{FUNCLIST}},"boot_$packprefix") unless $bootseen;
43        }
44    }
45
46#    We'll need this if we ever add any OS which uses mod2fname
47#    not as pseudo-builtin.
48#    require DynaLoader;
49    if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) {
50        $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]);
51    }
52
53    if    ($osname eq 'aix') { _write_aix(\%spec); }
54    elsif ($osname eq 'MacOS'){ _write_aix(\%spec) }
55    elsif ($osname eq 'VMS') { _write_vms(\%spec) }
56    elsif ($osname eq 'os2') { _write_os2(\%spec) }
57    elsif ($osname eq 'MSWin32') { _write_win32(\%spec) }
58    else {
59        croak("Don't know how to create linker option file for $osname\n");
60    }
61}
62
63
64sub _write_aix {
65    my($data) = @_;
66
67    rename "$data->{FILE}.exp", "$data->{FILE}.exp_old";
68
69    open( my $exp, ">", "$data->{FILE}.exp")
70        or croak("Can't create $data->{FILE}.exp: $!\n");
71    print $exp join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
72    print $exp join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
73    close $exp;
74}
75
76
77sub _write_os2 {
78    my($data) = @_;
79    require Config;
80    my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : "");
81
82    if (not $data->{DLBASE}) {
83        ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
84        $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
85    }
86    my $distname = $data->{DISTNAME} || $data->{NAME};
87    $distname = "Distribution $distname";
88    my $patchlevel = " pl$Config{perl_patchlevel}" || '';
89    my $comment = sprintf "Perl (v%s%s%s) module %s",
90      $Config::Config{version}, $threaded, $patchlevel, $data->{NAME};
91    chomp $comment;
92    if ($data->{INSTALLDIRS} and $data->{INSTALLDIRS} eq 'perl') {
93        $distname = 'perl5-porters@perl.org';
94        $comment = "Core $comment";
95    }
96    $comment = "$comment (Perl-config: $Config{config_args})";
97    $comment = substr($comment, 0, 200) . "...)" if length $comment > 203;
98    rename "$data->{FILE}.def", "$data->{FILE}_def.old";
99
100    open(my $def, ">", "$data->{FILE}.def")
101        or croak("Can't create $data->{FILE}.def: $!\n");
102    print $def "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n";
103    print $def "DESCRIPTION '\@#$distname:$data->{VERSION}#\@ $comment'\n";
104    print $def "CODE LOADONCALL\n";
105    print $def "DATA LOADONCALL NONSHARED MULTIPLE\n";
106    print $def "EXPORTS\n  ";
107    print $def join("\n  ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
108    print $def join("\n  ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
109    _print_imports($def, $data);
110    close $def;
111}
112
113sub _print_imports {
114    my ($def, $data)= @_;
115    my $imports= $data->{IMPORTS}
116        or return;
117    if ( keys %$imports ) {
118        print $def "IMPORTS\n";
119        foreach my $name (sort keys %$imports) {
120            print $def "  $name=$imports->{$name}\n";
121        }
122    }
123}
124
125sub _write_win32 {
126    my($data) = @_;
127
128    require Config;
129    if (not $data->{DLBASE}) {
130        ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
131        $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
132    }
133    rename "$data->{FILE}.def", "$data->{FILE}_def.old";
134
135    open( my $def, ">", "$data->{FILE}.def" )
136        or croak("Can't create $data->{FILE}.def: $!\n");
137    # put library name in quotes (it could be a keyword, like 'Alias')
138    if ($Config::Config{'cc'} !~ /^gcc/i) {
139        print $def "LIBRARY \"$data->{DLBASE}\"\n";
140    }
141    print $def "EXPORTS\n  ";
142    my @syms;
143    # Export public symbols both with and without underscores to
144    # ensure compatibility between DLLs from different compilers
145    # NOTE: DynaLoader itself only uses the names without underscores,
146    # so this is only to cover the case when the extension DLL may be
147    # linked to directly from C. GSAR 97-07-10
148    if ($Config::Config{'cc'} =~ /^bcc/i) {
149        for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
150            push @syms, "_$_", "$_ = _$_";
151        }
152    }
153    else {
154        for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
155            push @syms, "$_", "_$_ = $_";
156        }
157    }
158    print $def join("\n  ",@syms, "\n") if @syms;
159    _print_imports($def, $data);
160    close $def;
161}
162
163
164sub _write_vms {
165    my($data) = @_;
166
167    require Config; # a reminder for once we do $^O
168    require ExtUtils::XSSymSet;
169
170    my($isvax) = $Config::Config{'archname'} =~ /VAX/i;
171    my($set) = new ExtUtils::XSSymSet;
172
173    rename "$data->{FILE}.opt", "$data->{FILE}.opt_old";
174
175    open(my $opt,">", "$data->{FILE}.opt")
176        or croak("Can't create $data->{FILE}.opt: $!\n");
177
178    # Options file declaring universal symbols
179    # Used when linking shareable image for dynamic extension,
180    # or when linking PerlShr into which we've added this package
181    # as a static extension
182    # We don't do anything to preserve order, so we won't relax
183    # the GSMATCH criteria for a dynamic extension
184
185    print $opt "case_sensitive=yes\n"
186        if $Config::Config{d_vms_case_sensitive_symbols};
187
188    foreach my $sym (@{$data->{FUNCLIST}}) {
189        my $safe = $set->addsym($sym);
190        if ($isvax) { print $opt "UNIVERSAL=$safe\n" }
191        else        { print $opt "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; }
192    }
193
194    foreach my $sym (@{$data->{DL_VARS}}) {
195        my $safe = $set->addsym($sym);
196        print $opt "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
197        if ($isvax) { print $opt "UNIVERSAL=$safe\n" }
198        else        { print $opt "SYMBOL_VECTOR=($safe=DATA)\n"; }
199    }
200
201    close $opt;
202}
203
2041;
205
206__END__
207
208=head1 NAME
209
210ExtUtils::Mksymlists - write linker options files for dynamic extension
211
212=head1 SYNOPSIS
213
214    use ExtUtils::Mksymlists;
215    Mksymlists(  NAME     => $name ,
216                 DL_VARS  => [ $var1, $var2, $var3 ],
217                 DL_FUNCS => { $pkg1 => [ $func1, $func2 ],
218                               $pkg2 => [ $func3 ] );
219
220=head1 DESCRIPTION
221
222C<ExtUtils::Mksymlists> produces files used by the linker under some OSs
223during the creation of shared libraries for dynamic extensions.  It is
224normally called from a MakeMaker-generated Makefile when the extension
225is built.  The linker option file is generated by calling the function
226C<Mksymlists>, which is exported by default from C<ExtUtils::Mksymlists>.
227It takes one argument, a list of key-value pairs, in which the following
228keys are recognized:
229
230=over 4
231
232=item DLBASE
233
234This item specifies the name by which the linker knows the
235extension, which may be different from the name of the
236extension itself (for instance, some linkers add an '_' to the
237name of the extension).  If it is not specified, it is derived
238from the NAME attribute.  It is presently used only by OS2 and Win32.
239
240=item DL_FUNCS
241
242This is identical to the DL_FUNCS attribute available via MakeMaker,
243from which it is usually taken.  Its value is a reference to an
244associative array, in which each key is the name of a package, and
245each value is an a reference to an array of function names which
246should be exported by the extension.  For instance, one might say
247C<DL_FUNCS =E<gt> { Homer::Iliad =E<gt> [ qw(trojans greeks) ],
248Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>.  The
249function names should be identical to those in the XSUB code;
250C<Mksymlists> will alter the names written to the linker option
251file to match the changes made by F<xsubpp>.  In addition, if
252none of the functions in a list begin with the string B<boot_>,
253C<Mksymlists> will add a bootstrap function for that package,
254just as xsubpp does.  (If a B<boot_E<lt>pkgE<gt>> function is
255present in the list, it is passed through unchanged.)  If
256DL_FUNCS is not specified, it defaults to the bootstrap
257function for the extension specified in NAME.
258
259=item DL_VARS
260
261This is identical to the DL_VARS attribute available via MakeMaker,
262and, like DL_FUNCS, it is usually specified via MakeMaker.  Its
263value is a reference to an array of variable names which should
264be exported by the extension.
265
266=item FILE
267
268This key can be used to specify the name of the linker option file
269(minus the OS-specific extension), if for some reason you do not
270want to use the default value, which is the last word of the NAME
271attribute (I<e.g.> for C<Tk::Canvas>, FILE defaults to C<Canvas>).
272
273=item FUNCLIST
274
275This provides an alternate means to specify function names to be
276exported from the extension.  Its value is a reference to an
277array of function names to be exported by the extension.  These
278names are passed through unaltered to the linker options file.
279Specifying a value for the FUNCLIST attribute suppresses automatic
280generation of the bootstrap function for the package. To still create
281the bootstrap name you have to specify the package name in the
282DL_FUNCS hash:
283
284    Mksymlists(  NAME     => $name ,
285		 FUNCLIST => [ $func1, $func2 ],
286                 DL_FUNCS => { $pkg => [] } );
287
288
289=item IMPORTS
290
291This attribute is used to specify names to be imported into the
292extension. It is currently only used by OS/2 and Win32.
293
294=item NAME
295
296This gives the name of the extension (I<e.g.> C<Tk::Canvas>) for which
297the linker option file will be produced.
298
299=back
300
301When calling C<Mksymlists>, one should always specify the NAME
302attribute.  In most cases, this is all that's necessary.  In
303the case of unusual extensions, however, the other attributes
304can be used to provide additional information to the linker.
305
306=head1 AUTHOR
307
308Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>>
309
310=head1 REVISION
311
312Last revised 14-Feb-1996, for Perl 5.002.
313