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