[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Mksymlists.pm

package ExtUtils::Mksymlists;
use strict qw[ subs refs ];
# no strict 'vars';  # until filehandles are exempted

use Carp;
use Exporter;
use vars qw( @ISA @EXPORT $VERSION );
@ISA = 'Exporter';
@EXPORT = '&Mksymlists';
$VERSION = substr q$Revision: 1.16 $, 10;

sub Mksymlists {
    my(%spec) = @_;
    my($osname) = $^O;

    croak("Insufficient information specified to Mksymlists")
        unless ( $spec{NAME} or
                 ($spec{FILE} and ($spec{DL_FUNCS} or $spec{FUNCLIST})) );

    $spec{DL_VARS} = [] unless $spec{DL_VARS};
    ($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE};
    $spec{DL_FUNCS} = { $spec{NAME} => [] }
        unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or
                 $spec{FUNCLIST});
    $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
    if (defined $spec{DL_FUNCS}) {
        my($package);
        foreach $package (keys %{$spec{DL_FUNCS}}) {
            my($packprefix,$sym,$bootseen);
            ($packprefix = $package) =~ s/\W/_/g;
            foreach $sym (@{$spec{DL_FUNCS}->{$package}}) {
                if ($sym =~ /^boot_/) {
                    push(@{$spec{FUNCLIST}},$sym);
                    $bootseen++;
                }
                else { push(@{$spec{FUNCLIST}},"XS_${packprefix}_$sym"); }
            }
            push(@{$spec{FUNCLIST}},"boot_$packprefix") unless $bootseen;
        }
    }

#    We'll need this if we ever add any OS which uses mod2fname
#    not as pseudo-builtin.
#    require DynaLoader;
    if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) {
        $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]);
    }

    if    ($osname eq 'aix') { _write_aix(\%spec); }
    elsif ($osname eq 'VMS') { _write_vms(\%spec) }
    elsif ($osname eq 'os2') { _write_os2(\%spec) }
    elsif ($osname eq 'MSWin32') { _write_win32(\%spec) }
    else { croak("Don't know how to create linker option file for $osname\n"); }
}


sub _write_aix {
    my($data) = @_;

    rename "$data->{FILE}.exp", "$data->{FILE}.exp_old";

    open(EXP,">$data->{FILE}.exp")
        or croak("Can't create $data->{FILE}.exp: $!\n");
    print EXP join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
    print EXP join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
    close EXP;
}


sub _write_os2 {
    my($data) = @_;

    if (not $data->{DLBASE}) {
        ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
        $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
    }
    rename "$data->{FILE}.def", "$data->{FILE}_def.old";

    open(DEF,">$data->{FILE}.def")
        or croak("Can't create $data->{FILE}.def: $!\n");
    print DEF "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n";
    print DEF "CODE LOADONCALL\n";
    print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
    print DEF "EXPORTS\n  ";
    print DEF join("\n  ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
    print DEF join("\n  ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
    if (%{$data->{IMPORTS}}) {
        print DEF "IMPORTS\n";
my ($name, $exp);
while (($name, $exp)= each %{$data->{IMPORTS}}) {
  print DEF "  $name=$exp\n";
}
    }
    close DEF;
}

sub _write_win32 {
    my($data) = @_;

    require Config;
    if (not $data->{DLBASE}) {
        ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
        $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
    }
    rename "$data->{FILE}.def", "$data->{FILE}_def.old";

    open(DEF,">$data->{FILE}.def")
        or croak("Can't create $data->{FILE}.def: $!\n");
    # put library name in quotes (it could be a keyword, like 'Alias')
    if ($Config::Config{'cc'} !~ /^gcc/i) {
      print DEF "LIBRARY \"$data->{DLBASE}\"\n";
      if ($Config{'ccflags'} !~ /PERL_OBJECT/i) {
        print DEF "CODE LOADONCALL\n";
        print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
      }
    }
    print DEF "EXPORTS\n  ";
    my @syms;
    # Export public symbols both with and without underscores to
    # ensure compatibility between DLLs from different compilers
    # NOTE: DynaLoader itself only uses the names without underscores,
    # so this is only to cover the case when the extension DLL may be
    # linked to directly from C. GSAR 97-07-10
    if ($Config::Config{'cc'} =~ /^bcc/i) {
	for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
	    push @syms, "_$_", "$_ = _$_";
	}
    }
    else {
	for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
	    push @syms, "$_", "_$_ = $_";
	}
    }
    print DEF join("\n  ",@syms, "\n") if @syms;
    if (%{$data->{IMPORTS}}) {
        print DEF "IMPORTS\n";
        my ($name, $exp);
        while (($name, $exp)= each %{$data->{IMPORTS}}) {
            print DEF "  $name=$exp\n";
        }
    }
    close DEF;
}


sub _write_vms {
    my($data) = @_;

    require Config; # a reminder for once we do $^O
    require ExtUtils::XSSymSet;

    my($isvax) = $Config::Config{'arch'} =~ /VAX/i;
    my($set) = new ExtUtils::XSSymSet;
    my($sym);

    rename "$data->{FILE}.opt", "$data->{FILE}.opt_old";

    open(OPT,">$data->{FILE}.opt")
        or croak("Can't create $data->{FILE}.opt: $!\n");

    # Options file declaring universal symbols
    # Used when linking shareable image for dynamic extension,
    # or when linking PerlShr into which we've added this package
    # as a static extension
    # We don't do anything to preserve order, so we won't relax
    # the GSMATCH criteria for a dynamic extension

    foreach $sym (@{$data->{FUNCLIST}}) {
        my $safe = $set->addsym($sym);
        if ($isvax) { print OPT "UNIVERSAL=$safe\n" }
        else        { print OPT "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; }
    }
    foreach $sym (@{$data->{DL_VARS}}) {
        my $safe = $set->addsym($sym);
        print OPT "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
        if ($isvax) { print OPT "UNIVERSAL=$safe\n" }
        else        { print OPT "SYMBOL_VECTOR=($safe=DATA)\n"; }
    }
    close OPT;

    # Options file specifying RTLs to which this extension must be linked.
    # Eventually, the list of libraries will be supplied by a working
    # extliblist routine.
    open OPT,'>rtls.opt';
    print OPT "PerlShr/Share\n";
    foreach $rtl (split(/\s+/,$Config::Config{'libs'})) { print OPT "$rtl\n"; }
    close OPT;
}

1;

__END__

=head1 NAME

ExtUtils::Mksymlists - write linker options files for dynamic extension

=head1 SYNOPSIS

    use ExtUtils::Mksymlists;
    Mksymlists({ NAME     => $name ,
                 DL_VARS  => [ $var1, $var2, $var3 ],
                 DL_FUNCS => { $pkg1 => [ $func1, $func2 ],
                               $pkg2 => [ $func3 ] });

=head1 DESCRIPTION

C<ExtUtils::Mksymlists> produces files used by the linker under some OSs
during the creation of shared libraries for dynamic extensions.  It is
normally called from a MakeMaker-generated Makefile when the extension
is built.  The linker option file is generated by calling the function
C<Mksymlists>, which is exported by default from C<ExtUtils::Mksymlists>.
It takes one argument, a list of key-value pairs, in which the following
keys are recognized:

=over

=item NAME

This gives the name of the extension (I<e.g.> Tk::Canvas) for which
the linker option file will be produced.

=item DL_FUNCS

This is identical to the DL_FUNCS attribute available via MakeMaker,
from which it is usually taken.  Its value is a reference to an
associative array, in which each key is the name of a package, and
each value is an a reference to an array of function names which
should be exported by the extension.  For instance, one might say
C<DL_FUNCS =E<gt> { Homer::Iliad   =E<gt> [ qw(trojans greeks) ],
Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>.  The
function names should be identical to those in the XSUB code;
C<Mksymlists> will alter the names written to the linker option
file to match the changes made by F<xsubpp>.  In addition, if
none of the functions in a list begin with the string B<boot_>,
C<Mksymlists> will add a bootstrap function for that package,
just as xsubpp does.  (If a B<boot_E<lt>pkgE<gt>> function is
present in the list, it is passed through unchanged.)  If
DL_FUNCS is not specified, it defaults to the bootstrap
function for the extension specified in NAME.

=item DL_VARS

This is identical to the DL_VARS attribute available via MakeMaker,
and, like DL_FUNCS, it is usually specified via MakeMaker.  Its
value is a reference to an array of variable names which should
be exported by the extension.

=item FILE

This key can be used to specify the name of the linker option file
(minus the OS-specific extension), if for some reason you do not
want to use the default value, which is the last word of the NAME
attribute (I<e.g.> for Tk::Canvas, FILE defaults to 'Canvas').

=item FUNCLIST

This provides an alternate means to specify function names to be
exported from the extension.  Its value is a reference to an
array of function names to be exported by the extension.  These
names are passed through unaltered to the linker options file.

=item DLBASE

This item specifies the name by which the linker knows the
extension, which may be different from the name of the
extension itself (for instance, some linkers add an '_' to the
name of the extension).  If it is not specified, it is derived
from the NAME attribute.  It is presently used only by OS2.

=back

When calling C<Mksymlists>, one should always specify the NAME
attribute.  In most cases, this is all that's necessary.  In
the case of unusual extensions, however, the other attributes
can be used to provide additional information to the linker.

=head1 AUTHOR

Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>>

=head1 REVISION

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