[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.13 $, 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) = @_;

    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}\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_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';
ff0cee69	10	$VERSION = substr q$Revision: 1.13 $, 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
	100	if (not $data->{DLBASE}) {
	101	($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
	102	$data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
	103	}
	104	rename "$data->{FILE}.def", "$data->{FILE}_def.old";
	105
	106	open(DEF,">$data->{FILE}.def")
	107	or croak("Can't create $data->{FILE}.def: $!\n");
	108	print DEF "LIBRARY $data->{DLBASE}\n";
	109	print DEF "CODE LOADONCALL\n";
	110	print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
	111	print DEF "EXPORTS\n ";
	112	print DEF join("\n ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
	113	print DEF join("\n ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
	114	if (%{$data->{IMPORTS}}) {
	115	print DEF "IMPORTS\n";
	116	my ($name, $exp);
	117	while (($name, $exp)= each %{$data->{IMPORTS}}) {
	118	print DEF " $name=$exp\n";
	119	}
	120	}
	121	close DEF;
	122	}
	123
c07a80fd	124
	125	sub _write_vms {
	126	my($data) = @_;
a6e61155	127
f1387719	128	require Config; # a reminder for once we do $^O
ff0cee69	129	require ExtUtils::XSSymSet;
a6e61155	130
a6e61155	131	my($isvax) = $Config::Config{'arch'} =~ /VAX/i;
ff0cee69	132	my($set) = new ExtUtils::XSSymSet;
c07a80fd	133	my($sym);
	134
	135	rename "$data->{FILE}.opt", "$data->{FILE}.opt_old";
	136
	137	open(OPT,">$data->{FILE}.opt")
	138	or croak("Can't create $data->{FILE}.opt: $!\n");
	139
	140	# Options file declaring universal symbols
	141	# Used when linking shareable image for dynamic extension,
	142	# or when linking PerlShr into which we've added this package
	143	# as a static extension
	144	# We don't do anything to preserve order, so we won't relax
	145	# the GSMATCH criteria for a dynamic extension
	146
	147	foreach $sym (@{$data->{FUNCLIST}}) {
ff0cee69	148	my $safe = $set->addsym($sym);
	149	if ($isvax) { print OPT "UNIVERSAL=$safe\n" }
	150	else { print OPT "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; }
c07a80fd	151	}
c07a80fd	152	foreach $sym (@{$data->{DL_VARS}}) {
ff0cee69	153	my $safe = $set->addsym($sym);
c07a80fd	154	print OPT "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
ff0cee69	155	if ($isvax) { print OPT "UNIVERSAL=$safe\n" }
ff0cee69	156	else { print OPT "SYMBOL_VECTOR=($safe=DATA)\n"; }
c07a80fd	157	}
	158	close OPT;
	159
	160	# Options file specifying RTLs to which this extension must be linked.
	161	# Eventually, the list of libraries will be supplied by a working
	162	# extliblist routine.
	163	open OPT,'>rtls.opt';
	164	print OPT "PerlShr/Share\n";
a6e61155	165	foreach $rtl (split(/\s+/,$Config::Config{'libs'})) { print OPT "$rtl\n"; }
c07a80fd	166	close OPT;
	167	}
	168
	169	1;
	170
	171	__END__
	172
	173	=head1 NAME
	174
	175	ExtUtils::Mksymlists - write linker options files for dynamic extension
	176
	177	=head1 SYNOPSIS
	178
	179	use ExtUtils::Mksymlists;
	180	Mksymlists({ NAME => $name ,
	181	DL_VARS => [ $var1, $var2, $var3 ],
	182	DL_FUNCS => { $pkg1 => [ $func1, $func2 ],
	183	$pkg2 => [ $func3 ] });
	184
	185	=head1 DESCRIPTION
	186
	187	C<ExtUtils::Mksymlists> produces files used by the linker under some OSs
1fef88e7	188	during the creation of shared libraries for dynamic extensions. It is
c07a80fd	189	normally called from a MakeMaker-generated Makefile when the extension
	190	is built. The linker option file is generated by calling the function
	191	C<Mksymlists>, which is exported by default from C<ExtUtils::Mksymlists>.
	192	It takes one argument, a list of key-value pairs, in which the following
	193	keys are recognized:
	194
2ae324a7	195	=over
2ae324a7	196
c07a80fd	197	=item NAME
	198
	199	This gives the name of the extension (I<e.g.> Tk::Canvas) for which
	200	the linker option file will be produced.
	201
	202	=item DL_FUNCS
	203
	204	This is identical to the DL_FUNCS attribute available via MakeMaker,
	205	from which it is usually taken. Its value is a reference to an
	206	associative array, in which each key is the name of a package, and
	207	each value is an a reference to an array of function names which
	208	should be exported by the extension. For instance, one might say
a5f75d66	209	C<DL_FUNCS =E<gt> { Homer::Iliad =E<gt> [ qw(trojans greeks) ],
a5f75d66	210	Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>. The
c07a80fd	211	function names should be identical to those in the XSUB code;
	212	C<Mksymlists> will alter the names written to the linker option
	213	file to match the changes made by F<xsubpp>. In addition, if
	214	none of the functions in a list begin with the string B<boot_>,
	215	C<Mksymlists> will add a bootstrap function for that package,
	216	just as xsubpp does. (If a B<boot_E<lt>pkgE<gt>> function is
	217	present in the list, it is passed through unchanged.) If
	218	DL_FUNCS is not specified, it defaults to the bootstrap
	219	function for the extension specified in NAME.
	220
	221	=item DL_VARS
	222
	223	This is identical to the DL_VARS attribute available via MakeMaker,
	224	and, like DL_FUNCS, it is usually specified via MakeMaker. Its
	225	value is a reference to an array of variable names which should
	226	be exported by the extension.
	227
	228	=item FILE
	229
	230	This key can be used to specify the name of the linker option file
	231	(minus the OS-specific extension), if for some reason you do not
	232	want to use the default value, which is the last word of the NAME
	233	attribute (I<e.g.> for Tk::Canvas, FILE defaults to 'Canvas').
	234
	235	=item FUNCLIST
	236
	237	This provides an alternate means to specify function names to be
	238	exported from the extension. Its value is a reference to an
	239	array of function names to be exported by the extension. These
	240	names are passed through unaltered to the linker options file.
	241
	242	=item DLBASE
	243
	244	This item specifies the name by which the linker knows the
	245	extension, which may be different from the name of the
	246	extension itself (for instance, some linkers add an '_' to the
	247	name of the extension). If it is not specified, it is derived
	248	from the NAME attribute. It is presently used only by OS2.
	249
2ae324a7	250	=back
2ae324a7	251
c07a80fd	252	When calling C<Mksymlists>, one should always specify the NAME
	253	attribute. In most cases, this is all that's necessary. In
	254	the case of unusual extensions, however, the other attributes
	255	can be used to provide additional information to the linker.
	256
	257	=head1 AUTHOR
	258
	259	Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>>
	260
	261	=head1 REVISION
	262
a5f75d66	263	Last revised 14-Feb-1996, for Perl 5.002.