diff options
Diffstat (limited to 'contrib/perl5/ext/DynaLoader')
22 files changed, 0 insertions, 4278 deletions
diff --git a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL deleted file mode 100644 index 266c9d0..0000000 --- a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL +++ /dev/null @@ -1,894 +0,0 @@ -use Config; - -sub to_string { - my ($value) = @_; - $value =~ s/\\/\\\\/g; - $value =~ s/'/\\'/g; - return "'$value'"; -} - -unlink "DynaLoader.pm" if -f "DynaLoader.pm"; -open OUT, ">DynaLoader.pm" or die $!; -print OUT <<'EOT'; - -# Generated from DynaLoader.pm.PL - -package DynaLoader; - -# And Gandalf said: 'Many folk like to know beforehand what is to -# be set on the table; but those who have laboured to prepare the -# feast like to keep their secret; for wonder makes the words of -# praise louder.' - -# (Quote from Tolkien suggested by Anno Siegel.) -# -# See pod text at end of file for documentation. -# See also ext/DynaLoader/README in source tree for other information. -# -# Tim.Bunce@ig.co.uk, August 1994 - -use vars qw($VERSION *AUTOLOAD); - -$VERSION = 1.04; # avoid typo warning - -require AutoLoader; -*AUTOLOAD = \&AutoLoader::AUTOLOAD; - -use Config; - -# The following require can't be removed during maintenance -# releases, sadly, because of the risk of buggy code that does -# require Carp; Carp::croak "..."; without brackets dying -# if Carp hasn't been loaded in earlier compile time. :-( -# We'll let those bugs get found on the development track. -require Carp if $] < 5.00450; - -# enable debug/trace messages from DynaLoader perl code -$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; - -# -# Flags to alter dl_load_file behaviour. Assigned bits: -# 0x01 make symbols available for linking later dl_load_file's. -# (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL)) -# (ignored under VMS; effect is built-in to image linking) -# -# This is called as a class method $module->dl_load_flags. The -# definition here will be inherited and result on "default" loading -# behaviour unless a sub-class of DynaLoader defines its own version. -# - -sub dl_load_flags { 0x00 } - -# ($dl_dlext, $dlsrc) -# = @Config::Config{'dlext', 'dlsrc'}; -EOT - -print OUT " (\$dl_dlext, \$dlsrc) = (", - to_string($Config::Config{'dlext'}), ",", - to_string($Config::Config{'dlsrc'}), ")\n;" ; - -print OUT <<'EOT'; - -# Some systems need special handling to expand file specifications -# (VMS support by Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>) -# See dl_expandspec() for more details. Should be harmless but -# inefficient to define on systems that don't need it. -$Is_VMS = $^O eq 'VMS'; -$do_expand = $Is_VMS; -$Is_MacOS = $^O eq 'MacOS'; - -@dl_require_symbols = (); # names of symbols we need -@dl_resolve_using = (); # names of files to link with -@dl_library_path = (); # path to look for files -@dl_librefs = (); # things we have loaded -@dl_modules = (); # Modules we have loaded - -# This is a fix to support DLD's unfortunate desire to relink -lc -@dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs"; - -EOT - -my $cfg_dl_library_path = <<'EOT'; -push(@dl_library_path, split(' ', $Config::Config{libpth})); -EOT - -sub dquoted_comma_list { - join(", ", map {qq("$_")} @_); -} - -if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { - eval $cfg_dl_library_path; - if (!$ENV{PERL_BUILD_EXPAND_ENV_VARS}) { - my $dl_library_path = dquoted_comma_list(@dl_library_path); - print OUT <<EOT; -# The below \@dl_library_path has been expanded (%Config) in Perl build time. - -\@dl_library_path = ($dl_library_path); - -EOT - } -} -else { - print OUT <<EOT; -# Initialise \@dl_library_path with the 'standard' library path -# for this platform as determined by Configure. - -$cfg_dl_library_path - -EOT -} - -my $ldlibpthname; -my $ldlibpthname_defined; -my $pthsep; - -if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { - $ldlibpthname = $Config::Config{ldlibpthname}; - $ldlibpthname_defined = defined $Config::Config{ldlibpthname} ? 1 : 0; - $pthsep = $Config::Config{path_sep}; -} -else { - $ldlibpthname = q($Config::Config{ldlibpthname}); - $ldlibpthname_defined = q(defined $Config::Config{ldlibpthname}); - $pthsep = q($Config::Config{path_sep}); - print OUT <<EOT; -my \$ldlibpthname = $ldlibpthname; -my \$ldlibpthname_defined = $ldlibpthname_defined; -my \$pthsep = $pthsep; - -EOT -} - -my $env_dl_library_path = <<'EOT'; -if ($ldlibpthname_defined && - exists $ENV{$ldlibpthname}) { - push(@dl_library_path, split(/$pthsep/, $ENV{$ldlibpthname})); -} - -# E.g. HP-UX supports both its native SHLIB_PATH *and* LD_LIBRARY_PATH. - -if ($ldlibpthname_defined && - $ldlibpthname ne 'LD_LIBRARY_PATH' && - exists $ENV{LD_LIBRARY_PATH}) { - push(@dl_library_path, split(/$pthsep/, $ENV{LD_LIBRARY_PATH})); -} -EOT - -if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS} && $ENV{PERL_BUILD_EXPAND_ENV_VARS}) { - eval $env_dl_library_path; -} -else { - print OUT <<EOT; -# Add to \@dl_library_path any extra directories we can gather from environment -# during runtime. - -$env_dl_library_path - -EOT -} - -if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS} && $ENV{PERL_BUILD_EXPAND_ENV_VARS}) { - my $dl_library_path = dquoted_comma_list(@dl_library_path); - print OUT <<EOT; -# The below \@dl_library_path has been expanded (%Config, %ENV) -# in Perl build time. - -\@dl_library_path = ($dl_library_path); - -EOT -} - -print OUT <<'EOT'; -# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. -# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB -boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && - !defined(&dl_error); - -if ($dl_debug) { - print STDERR "DynaLoader.pm loaded (@INC, @dl_library_path)\n"; - print STDERR "DynaLoader not linked into this perl\n" - unless defined(&boot_DynaLoader); -} - -1; # End of main code - - -sub croak { require Carp; Carp::croak(@_) } - -sub bootstrap_inherit { - my $module = $_[0]; - local *isa = *{"$module\::ISA"}; - local @isa = (@isa, 'DynaLoader'); - # Cannot goto due to delocalization. Will report errors on a wrong line? - bootstrap(@_); -} - -# The bootstrap function cannot be autoloaded (without complications) -# so we define it here: - -sub bootstrap { - # use local vars to enable $module.bs script to edit values - local(@args) = @_; - local($module) = $args[0]; - local(@dirs, $file); - - unless ($module) { - require Carp; - Carp::confess("Usage: DynaLoader::bootstrap(module)"); - } - - # A common error on platforms which don't support dynamic loading. - # Since it's fatal and potentially confusing we give a detailed message. - croak("Can't load module $module, dynamic loading not available in this perl.\n". - " (You may need to build a new perl executable which either supports\n". - " dynamic loading or has the $module module statically linked into it.)\n") - unless defined(&dl_load_file); - - my @modparts = split(/::/,$module); - my $modfname = $modparts[-1]; - - # Some systems have restrictions on files names for DLL's etc. - # mod2fname returns appropriate file base name (typically truncated) - # It may also edit @modparts if required. - $modfname = &mod2fname(\@modparts) if defined &mod2fname; - - my $modpname = join(($Is_MacOS ? ':' : '/'),@modparts); - - print STDERR "DynaLoader::bootstrap for $module ", - ($Is_MacOS - ? "(:auto:$modpname:$modfname.$dl_dlext)\n" : - "(auto/$modpname/$modfname.$dl_dlext)\n") - if $dl_debug; - - foreach (@INC) { - chop($_ = VMS::Filespec::unixpath($_)) if $Is_VMS; - my $dir; - if ($Is_MacOS) { - chop $_ if /:$/; - $dir = "$_:auto:$modpname"; - } else { - $dir = "$_/auto/$modpname"; - } - next unless -d $dir; # skip over uninteresting directories - - # check for common cases to avoid autoload of dl_findfile - my $try = $Is_MacOS ? "$dir:$modfname.$dl_dlext" : "$dir/$modfname.$dl_dlext"; - last if $file = ($do_expand) ? dl_expandspec($try) : (-f $try && $try); - - # no luck here, save dir for possible later dl_findfile search - push @dirs, $dir; - } - # last resort, let dl_findfile have a go in all known locations - $file = dl_findfile(map("-L$_",@dirs,@INC), $modfname) unless $file; - - croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)") - unless $file; # wording similar to error from 'require' - - $file = uc($file) if $Is_VMS && $Config::Config{d_vms_case_sensitive_symbols}; - my $bootname = "boot_$module"; - $bootname =~ s/\W/_/g; - @dl_require_symbols = ($bootname); - - # Execute optional '.bootstrap' perl script for this module. - # The .bs file can be used to configure @dl_resolve_using etc to - # match the needs of the individual module on this architecture. - my $bs = $file; - $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library - if (-s $bs) { # only read file if it's not empty - print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug; - eval { do $bs; }; - warn "$bs: $@\n" if $@; - } - - # Many dynamic extension loading problems will appear to come from - # this section of code: XYZ failed at line 123 of DynaLoader.pm. - # Often these errors are actually occurring in the initialisation - # C code of the extension XS file. Perl reports the error as being - # in this perl code simply because this was the last perl code - # it executed. - - my $libref = dl_load_file($file, $module->dl_load_flags) or - croak("Can't load '$file' for module $module: ".dl_error()); - - push(@dl_librefs,$libref); # record loaded object - - my @unresolved = dl_undef_symbols(); - if (@unresolved) { - require Carp; - Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); - } - - my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or - croak("Can't find '$bootname' symbol in $file\n"); - - my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); - - push(@dl_modules, $module); # record loaded module - - # See comment block above - &$xs(@args); -} - - -#sub _check_file { # private utility to handle dl_expandspec vs -f tests -# my($file) = @_; -# return $file if (!$do_expand && -f $file); # the common case -# return $file if ( $do_expand && ($file=dl_expandspec($file))); -# return undef; -#} - - -# Let autosplit and the autoloader deal with these functions: -__END__ - - -sub dl_findfile { - # Read ext/DynaLoader/DynaLoader.doc for detailed information. - # This function does not automatically consider the architecture - # or the perl library auto directories. - my (@args) = @_; - my (@dirs, $dir); # which directories to search - my (@found); # full paths to real files we have found -EOT - -print OUT ' my $dl_ext= ' . to_string($Config::Config{'dlext'}) . - "; # \$Config::Config{'dlext'} suffix for perl extensions\n"; -print OUT ' my $dl_so = ' . to_string($Config::Config{'so'}) . - "; # \$Config::Config{'so'} suffix for shared libraries\n"; - -print OUT <<'EOT'; - - print STDERR "dl_findfile(@args)\n" if $dl_debug; - - # accumulate directories but process files as they appear - arg: foreach(@args) { - # Special fast case: full filepath requires no search - if ($Is_VMS && m%[:>/\]]% && -f $_) { - push(@found,dl_expandspec(VMS::Filespec::vmsify($_))); - last arg unless wantarray; - next; - } - elsif ($Is_MacOS) { - if (m/:/ && -f $_) { - push(@found,$_); - last arg unless wantarray; - } - } - elsif (m:/: && -f $_ && !$do_expand) { - push(@found,$_); - last arg unless wantarray; - next; - } - - # Deal with directories first: - # Using a -L prefix is the preferred option (faster and more robust) - if (m:^-L:) { s/^-L//; push(@dirs, $_); next; } - - if ($Is_MacOS) { - # Otherwise we try to try to spot directories by a heuristic - # (this is a more complicated issue than it first appears) - if (m/:/ && -d $_) { push(@dirs, $_); next; } - # Only files should get this far... - my(@names, $name); # what filenames to look for - s/^-l//; - push(@names, $_); - foreach $dir (@dirs, @dl_library_path) { - next unless -d $dir; - $dir =~ s/^([^:]+)$/:$1/; - $dir =~ s/:$//; - foreach $name (@names) { - my($file) = "$dir:$name"; - print STDERR " checking in $dir for $name\n" if $dl_debug; - if (-f $file) { - push(@found, $file); - next arg; # no need to look any further - } - } - } - next; - } - - # Otherwise we try to try to spot directories by a heuristic - # (this is a more complicated issue than it first appears) - if (m:/: && -d $_) { push(@dirs, $_); next; } - - # VMS: we may be using native VMS directory syntax instead of - # Unix emulation, so check this as well - if ($Is_VMS && /[:>\]]/ && -d $_) { push(@dirs, $_); next; } - - # Only files should get this far... - my(@names, $name); # what filenames to look for - if (m:-l: ) { # convert -lname to appropriate library name - s/-l//; - push(@names,"lib$_.$dl_so"); - push(@names,"lib$_.a"); - } else { # Umm, a bare name. Try various alternatives: - # these should be ordered with the most likely first - push(@names,"$_.$dl_ext") unless m/\.$dl_ext$/o; - push(@names,"$_.$dl_so") unless m/\.$dl_so$/o; - push(@names,"lib$_.$dl_so") unless m:/:; - push(@names,"$_.a") if !m/\.a$/ and $dlsrc eq "dl_dld.xs"; - push(@names, $_); - } - foreach $dir (@dirs, @dl_library_path) { - next unless -d $dir; - chop($dir = VMS::Filespec::unixpath($dir)) if $Is_VMS; - foreach $name (@names) { - my($file) = "$dir/$name"; - print STDERR " checking in $dir for $name\n" if $dl_debug; - $file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file); - #$file = _check_file($file); - if ($file) { - push(@found, $file); - next arg; # no need to look any further - } - } - } - } - if ($dl_debug) { - foreach(@dirs) { - print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_; - } - print STDERR "dl_findfile found: @found\n"; - } - return $found[0] unless wantarray; - @found; -} - - -sub dl_expandspec { - my($spec) = @_; - # Optional function invoked if DynaLoader.pm sets $do_expand. - # Most systems do not require or use this function. - # Some systems may implement it in the dl_*.xs file in which case - # this autoload version will not be called but is harmless. - - # This function is designed to deal with systems which treat some - # 'filenames' in a special way. For example VMS 'Logical Names' - # (something like unix environment variables - but different). - # This function should recognise such names and expand them into - # full file paths. - # Must return undef if $spec is invalid or file does not exist. - - my $file = $spec; # default output to input - - if ($Is_VMS) { # dl_expandspec should be defined in dl_vms.xs - require Carp; - Carp::croak("dl_expandspec: should be defined in XS file!\n"); - } else { - return undef unless -f $file; - } - print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug; - $file; -} - -sub dl_find_symbol_anywhere -{ - my $sym = shift; - my $libref; - foreach $libref (@dl_librefs) { - my $symref = dl_find_symbol($libref,$sym); - return $symref if $symref; - } - return undef; -} - -=head1 NAME - -DynaLoader - Dynamically load C libraries into Perl code - -dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_unload_file(), dl_find_symbol(), dl_find_symbol_anywhere(), dl_undef_symbols(), dl_install_xsub(), dl_load_flags(), bootstrap() - routines used by DynaLoader modules - -=head1 SYNOPSIS - - package YourPackage; - require DynaLoader; - @ISA = qw(... DynaLoader ...); - bootstrap YourPackage; - - # optional method for 'global' loading - sub dl_load_flags { 0x01 } - - -=head1 DESCRIPTION - -This document defines a standard generic interface to the dynamic -linking mechanisms available on many platforms. Its primary purpose is -to implement automatic dynamic loading of Perl modules. - -This document serves as both a specification for anyone wishing to -implement the DynaLoader for a new platform and as a guide for -anyone wishing to use the DynaLoader directly in an application. - -The DynaLoader is designed to be a very simple high-level -interface that is sufficiently general to cover the requirements -of SunOS, HP-UX, NeXT, Linux, VMS and other platforms. - -It is also hoped that the interface will cover the needs of OS/2, NT -etc and also allow pseudo-dynamic linking (using C<ld -A> at runtime). - -It must be stressed that the DynaLoader, by itself, is practically -useless for accessing non-Perl libraries because it provides almost no -Perl-to-C 'glue'. There is, for example, no mechanism for calling a C -library function or supplying arguments. A C::DynaLib module -is available from CPAN sites which performs that function for some -common system types. - -DynaLoader Interface Summary - - @dl_library_path - @dl_resolve_using - @dl_require_symbols - $dl_debug - @dl_librefs - @dl_modules - Implemented in: - bootstrap($modulename) Perl - @filepaths = dl_findfile(@names) Perl - $flags = $modulename->dl_load_flags Perl - $symref = dl_find_symbol_anywhere($symbol) Perl - - $libref = dl_load_file($filename, $flags) C - $status = dl_unload_file($libref) C - $symref = dl_find_symbol($libref, $symbol) C - @symbols = dl_undef_symbols() C - dl_install_xsub($name, $symref [, $filename]) C - $message = dl_error C - -=over 4 - -=item @dl_library_path - -The standard/default list of directories in which dl_findfile() will -search for libraries etc. Directories are searched in order: -$dl_library_path[0], [1], ... etc - -@dl_library_path is initialised to hold the list of 'normal' directories -(F</usr/lib>, etc) determined by B<Configure> (C<$Config{'libpth'}>). This should -ensure portability across a wide range of platforms. - -@dl_library_path should also be initialised with any other directories -that can be determined from the environment at runtime (such as -LD_LIBRARY_PATH for SunOS). - -After initialisation @dl_library_path can be manipulated by an -application using push and unshift before calling dl_findfile(). -Unshift can be used to add directories to the front of the search order -either to save search time or to override libraries with the same name -in the 'normal' directories. - -The load function that dl_load_file() calls may require an absolute -pathname. The dl_findfile() function and @dl_library_path can be -used to search for and return the absolute pathname for the -library/object that you wish to load. - -=item @dl_resolve_using - -A list of additional libraries or other shared objects which can be -used to resolve any undefined symbols that might be generated by a -later call to load_file(). - -This is only required on some platforms which do not handle dependent -libraries automatically. For example the Socket Perl extension -library (F<auto/Socket/Socket.so>) contains references to many socket -functions which need to be resolved when it's loaded. Most platforms -will automatically know where to find the 'dependent' library (e.g., -F</usr/lib/libsocket.so>). A few platforms need to be told the -location of the dependent library explicitly. Use @dl_resolve_using -for this. - -Example usage: - - @dl_resolve_using = dl_findfile('-lsocket'); - -=item @dl_require_symbols - -A list of one or more symbol names that are in the library/object file -to be dynamically loaded. This is only required on some platforms. - -=item @dl_librefs - -An array of the handles returned by successful calls to dl_load_file(), -made by bootstrap, in the order in which they were loaded. -Can be used with dl_find_symbol() to look for a symbol in any of -the loaded files. - -=item @dl_modules - -An array of module (package) names that have been bootstrap'ed. - -=item dl_error() - -Syntax: - - $message = dl_error(); - -Error message text from the last failed DynaLoader function. Note -that, similar to errno in unix, a successful function call does not -reset this message. - -Implementations should detect the error as soon as it occurs in any of -the other functions and save the corresponding message for later -retrieval. This will avoid problems on some platforms (such as SunOS) -where the error message is very temporary (e.g., dlerror()). - -=item $dl_debug - -Internal debugging messages are enabled when $dl_debug is set true. -Currently setting $dl_debug only affects the Perl side of the -DynaLoader. These messages should help an application developer to -resolve any DynaLoader usage problems. - -$dl_debug is set to C<$ENV{'PERL_DL_DEBUG'}> if defined. - -For the DynaLoader developer/porter there is a similar debugging -variable added to the C code (see dlutils.c) and enabled if Perl was -built with the B<-DDEBUGGING> flag. This can also be set via the -PERL_DL_DEBUG environment variable. Set to 1 for minimal information or -higher for more. - -=item dl_findfile() - -Syntax: - - @filepaths = dl_findfile(@names) - -Determine the full paths (including file suffix) of one or more -loadable files given their generic names and optionally one or more -directories. Searches directories in @dl_library_path by default and -returns an empty list if no files were found. - -Names can be specified in a variety of platform independent forms. Any -names in the form B<-lname> are converted into F<libname.*>, where F<.*> is -an appropriate suffix for the platform. - -If a name does not already have a suitable prefix and/or suffix then -the corresponding file will be searched for by trying combinations of -prefix and suffix appropriate to the platform: "$name.o", "lib$name.*" -and "$name". - -If any directories are included in @names they are searched before -@dl_library_path. Directories may be specified as B<-Ldir>. Any other -names are treated as filenames to be searched for. - -Using arguments of the form C<-Ldir> and C<-lname> is recommended. - -Example: - - @dl_resolve_using = dl_findfile(qw(-L/usr/5lib -lposix)); - - -=item dl_expandspec() - -Syntax: - - $filepath = dl_expandspec($spec) - -Some unusual systems, such as VMS, require special filename handling in -order to deal with symbolic names for files (i.e., VMS's Logical Names). - -To support these systems a dl_expandspec() function can be implemented -either in the F<dl_*.xs> file or code can be added to the autoloadable -dl_expandspec() function in F<DynaLoader.pm>. See F<DynaLoader.pm> for -more information. - -=item dl_load_file() - -Syntax: - - $libref = dl_load_file($filename, $flags) - -Dynamically load $filename, which must be the path to a shared object -or library. An opaque 'library reference' is returned as a handle for -the loaded object. Returns undef on error. - -The $flags argument to alters dl_load_file behaviour. -Assigned bits: - - 0x01 make symbols available for linking later dl_load_file's. - (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL)) - (ignored under VMS; this is a normal part of image linking) - -(On systems that provide a handle for the loaded object such as SunOS -and HPUX, $libref will be that handle. On other systems $libref will -typically be $filename or a pointer to a buffer containing $filename. -The application should not examine or alter $libref in any way.) - -This is the function that does the real work. It should use the -current values of @dl_require_symbols and @dl_resolve_using if required. - - SunOS: dlopen($filename) - HP-UX: shl_load($filename) - Linux: dld_create_reference(@dl_require_symbols); dld_link($filename) - NeXT: rld_load($filename, @dl_resolve_using) - VMS: lib$find_image_symbol($filename,$dl_require_symbols[0]) - -(The dlopen() function is also used by Solaris and some versions of -Linux, and is a common choice when providing a "wrapper" on other -mechanisms as is done in the OS/2 port.) - -=item dl_unload_file() - -Syntax: - - $status = dl_unload_file($libref) - -Dynamically unload $libref, which must be an opaque 'library reference' as -returned from dl_load_file. Returns one on success and zero on failure. - -This function is optional and may not necessarily be provided on all platforms. -If it is defined, it is called automatically when the interpreter exits for -every shared object or library loaded by DynaLoader::bootstrap. All such -library references are stored in @dl_librefs by DynaLoader::Bootstrap as it -loads the libraries. The files are unloaded in last-in, first-out order. - -This unloading is usually necessary when embedding a shared-object perl (e.g. -one configured with -Duseshrplib) within a larger application, and the perl -interpreter is created and destroyed several times within the lifetime of the -application. In this case it is possible that the system dynamic linker will -unload and then subsequently reload the shared libperl without relocating any -references to it from any files DynaLoaded by the previous incarnation of the -interpreter. As a result, any shared objects opened by DynaLoader may point to -a now invalid 'ghost' of the libperl shared object, causing apparently random -memory corruption and crashes. This behaviour is most commonly seen when using -Apache and mod_perl built with the APXS mechanism. - - SunOS: dlclose($libref) - HP-UX: ??? - Linux: ??? - NeXT: ??? - VMS: ??? - -(The dlclose() function is also used by Solaris and some versions of -Linux, and is a common choice when providing a "wrapper" on other -mechanisms as is done in the OS/2 port.) - -=item dl_loadflags() - -Syntax: - - $flags = dl_loadflags $modulename; - -Designed to be a method call, and to be overridden by a derived class -(i.e. a class which has DynaLoader in its @ISA). The definition in -DynaLoader itself returns 0, which produces standard behavior from -dl_load_file(). - -=item dl_find_symbol() - -Syntax: - - $symref = dl_find_symbol($libref, $symbol) - -Return the address of the symbol $symbol or C<undef> if not found. If the -target system has separate functions to search for symbols of different -types then dl_find_symbol() should search for function symbols first and -then other types. - -The exact manner in which the address is returned in $symref is not -currently defined. The only initial requirement is that $symref can -be passed to, and understood by, dl_install_xsub(). - - SunOS: dlsym($libref, $symbol) - HP-UX: shl_findsym($libref, $symbol) - Linux: dld_get_func($symbol) and/or dld_get_symbol($symbol) - NeXT: rld_lookup("_$symbol") - VMS: lib$find_image_symbol($libref,$symbol) - - -=item dl_find_symbol_anywhere() - -Syntax: - - $symref = dl_find_symbol_anywhere($symbol) - -Applies dl_find_symbol() to the members of @dl_librefs and returns -the first match found. - -=item dl_undef_symbols() - -Example - - @symbols = dl_undef_symbols() - -Return a list of symbol names which remain undefined after load_file(). -Returns C<()> if not known. Don't worry if your platform does not provide -a mechanism for this. Most do not need it and hence do not provide it, -they just return an empty list. - - -=item dl_install_xsub() - -Syntax: - - dl_install_xsub($perl_name, $symref [, $filename]) - -Create a new Perl external subroutine named $perl_name using $symref as -a pointer to the function which implements the routine. This is simply -a direct call to newXSUB(). Returns a reference to the installed -function. - -The $filename parameter is used by Perl to identify the source file for -the function if required by die(), caller() or the debugger. If -$filename is not defined then "DynaLoader" will be used. - - -=item bootstrap() - -Syntax: - -bootstrap($module) - -This is the normal entry point for automatic dynamic loading in Perl. - -It performs the following actions: - -=over 8 - -=item * - -locates an auto/$module directory by searching @INC - -=item * - -uses dl_findfile() to determine the filename to load - -=item * - -sets @dl_require_symbols to C<("boot_$module")> - -=item * - -executes an F<auto/$module/$module.bs> file if it exists -(typically used to add to @dl_resolve_using any files which -are required to load the module on the current platform) - -=item * - -calls dl_load_flags() to determine how to load the file. - -=item * - -calls dl_load_file() to load the file - -=item * - -calls dl_undef_symbols() and warns if any symbols are undefined - -=item * - -calls dl_find_symbol() for "boot_$module" - -=item * - -calls dl_install_xsub() to install it as "${module}::bootstrap" - -=item * - -calls &{"${module}::bootstrap"} to bootstrap the module (actually -it uses the function reference returned by dl_install_xsub for speed) - -=back - -=back - - -=head1 AUTHOR - -Tim Bunce, 11 August 1994. - -This interface is based on the work and comments of (in no particular -order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno -Siegel, Thomas Neumann, Paul Marquess, Charles Bailey, myself and others. - -Larry Wall designed the elegant inherited bootstrap mechanism and -implemented the first Perl 5 dynamic loader using it. - -Solaris global loading added by Nick Ing-Simmons with design/coding -assistance from Tim Bunce, January 1996. - -=cut -EOT - -close OUT or die $!; - diff --git a/contrib/perl5/ext/DynaLoader/Makefile.PL b/contrib/perl5/ext/DynaLoader/Makefile.PL deleted file mode 100644 index 83cbd77..0000000 --- a/contrib/perl5/ext/DynaLoader/Makefile.PL +++ /dev/null @@ -1,34 +0,0 @@ -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => 'DynaLoader', - LINKTYPE => 'static', - DEFINE => '-DPERL_CORE -DLIBC="$(LIBC)"', - MAN3PODS => {}, # Pods will be built by installman. - SKIP => [qw(dynamic dynamic_lib dynamic_bs)], - XSPROTOARG => '-noprototypes', # XXX remove later? - VERSION_FROM => 'DynaLoader_pm.PL', - PL_FILES => {'DynaLoader_pm.PL'=>'DynaLoader.pm', - 'XSLoader_pm.PL'=>'XSLoader.pm'}, - PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm', - 'XSLoader.pm' => '$(INST_LIBDIR)/XSLoader.pm'}, - depend => {'DynaLoader.o' => 'dlutils.c'}, - clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm ' . - 'XSLoader.pm'}, -); - -sub MY::postamble { - ' -DynaLoader.xs: $(DLSRC) - $(RM_F) $@ - $(CP) $? $@ - -# Perform very simple tests just to check for major gaffs. -# We can\'t do much more for platforms we are not executing on. -test-xs: - for i in dl_*xs; \ - do $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSUBPPARGS) $$i > /dev/null; \ - done -'; -} - diff --git a/contrib/perl5/ext/DynaLoader/README b/contrib/perl5/ext/DynaLoader/README deleted file mode 100644 index 0551cf3..0000000 --- a/contrib/perl5/ext/DynaLoader/README +++ /dev/null @@ -1,53 +0,0 @@ -Perl 5 DynaLoader - -See DynaLoader.pm for detailed specification. - -This module is very similar to the other Perl 5 modules except that -Configure selects which dl_*.xs file to use. - -After Configure has been run the Makefile.PL will generate a Makefile -which will run xsubpp on a specific dl_*.xs file and write the output -to DynaLoader.c - -After that the processing is the same as any other module. - -Note that, to be effective, the DynaLoader module must be _statically_ -linked into perl! Configure should arrange this. - -This interface is based on the work and comments of (in no particular -order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno -Siegel, Thomas Neumann, Paul Marquess, Charles Bailey and others. - -The dl_*.xs files should either be named after the dynamic linking -operating system interface used if that interface is available on more -than one type of system, e.g.: - dlopen for dlopen()/dlsym() type functions (SunOS, BSD) - dld for the GNU dld library functions (linux, ?) -or else the osname, e.g., hpux, next, vms etc. - -Both are determined by Configure and so only those specific names that -Configure knows/uses will work. - -If porting the DynaLoader to a platform that has a core dynamic linking -interface similar to an existing generic type, e.g., dlopen or dld, -please try to port the corresponding dl_*.xs file (using #ifdef's if -required). - -Otherwise, or if that proves too messy, create a new dl_*.xs file named -after your osname. Configure will give preference to a dl_$osname.xs -file if one exists. - -The file dl_dlopen.xs is a reference implementation by Paul Marquess -which is a good place to start if porting from scratch. For more complex -platforms take a look at dl_dld.xs. The dlutils.c file holds some -common definitions that are #included into the dl_*.xs files. - -After the initial implementation of a new DynaLoader dl_*.xs file you -may need to edit or create ext/MODULE/MODULE.bs files (library bootstrap -files) to reflect the needs of your platform and linking software. - -Refer to DynaLoader.pm, lib/ExtUtils/MakeMaker.pm and any existing -ext/MODULE/MODULE.bs files for more information. - -Tim Bunce. -August 1994 diff --git a/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL b/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL deleted file mode 100644 index 7657410..0000000 --- a/contrib/perl5/ext/DynaLoader/XSLoader_pm.PL +++ /dev/null @@ -1,160 +0,0 @@ -use Config; - -sub to_string { - my ($value) = @_; - $value =~ s/\\/\\\\/g; - $value =~ s/'/\\'/g; - return "'$value'"; -} - -unlink "XSLoader.pm" if -f "XSLoader.pm"; -open OUT, ">XSLoader.pm" or die $!; -print OUT <<'EOT'; -# Generated from XSLoader.pm.PL (resolved %Config::Config value) - -package XSLoader; - -# And Gandalf said: 'Many folk like to know beforehand what is to -# be set on the table; but those who have laboured to prepare the -# feast like to keep their secret; for wonder makes the words of -# praise louder.' - -# (Quote from Tolkien sugested by Anno Siegel.) -# -# See pod text at end of file for documentation. -# See also ext/DynaLoader/README in source tree for other information. -# -# Tim.Bunce@ig.co.uk, August 1994 - -$VERSION = "0.01"; # avoid typo warning - -# enable debug/trace messages from DynaLoader perl code -# $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; - -EOT - -print OUT ' my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ; - -print OUT <<'EOT'; - -package DynaLoader; - -# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. -# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB -boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && - !defined(&dl_error); -package XSLoader; - -1; # End of main code - -# The bootstrap function cannot be autoloaded (without complications) -# so we define it here: - -sub load { - package DynaLoader; - - my($module) = $_[0]; - - # work with static linking too - my $b = "$module\::bootstrap"; - goto &$b if defined &$b; - - goto retry unless $module and defined &dl_load_file; - - my @modparts = split(/::/,$module); - my $modfname = $modparts[-1]; - -EOT - -print OUT <<'EOT' if defined &DynaLoader::mod2fname; - # Some systems have restrictions on files names for DLL's etc. - # mod2fname returns appropriate file base name (typically truncated) - # It may also edit @modparts if required. - $modfname = &mod2fname(\@modparts) if defined &mod2fname; - -EOT - -print OUT <<'EOT'; - my $modpname = join('/',@modparts); - my $modlibname = (caller())[1]; - my $c = @modparts; - $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename - my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext"; - -# print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug; - - my $bs = $file; - $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library - - goto retry if not -f $file or -s $bs; - - my $bootname = "boot_$module"; - $bootname =~ s/\W/_/g; - @dl_require_symbols = ($bootname); - - # Many dynamic extension loading problems will appear to come from - # this section of code: XYZ failed at line 123 of DynaLoader.pm. - # Often these errors are actually occurring in the initialisation - # C code of the extension XS file. Perl reports the error as being - # in this perl code simply because this was the last perl code - # it executed. - - my $libref = dl_load_file($file, 0) or do { - require Carp; - Carp::croak("Can't load '$file' for module $module: " . dl_error()); - }; - push(@dl_librefs,$libref); # record loaded object - - my @unresolved = dl_undef_symbols(); - if (@unresolved) { - require Carp; - Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); - } - - my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do { - require Carp; - Carp::croak("Can't find '$bootname' symbol in $file\n"); - }; - - my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); - - push(@dl_modules, $module); # record loaded module - - # See comment block above - return &$xs(@_); - - retry: - require DynaLoader; - goto &DynaLoader::bootstrap_inherit; -} - -__END__ - -=head1 NAME - -XSLoader - Dynamically load C libraries into Perl code - -=head1 SYNOPSIS - - package YourPackage; - use XSLoader; - - XSLoader::load 'YourPackage', @args; - -=head1 DESCRIPTION - -This module defines a standard I<simplified> interface to the dynamic -linking mechanisms available on many platforms. Its primary purpose is -to implement cheap automatic dynamic loading of Perl modules. - -For more complicated interface see L<DynaLoader>. - -=head1 AUTHOR - -Ilya Zakharevich: extraction from DynaLoader. - -=cut -EOT - -close OUT or die $!; - diff --git a/contrib/perl5/ext/DynaLoader/dl_aix.xs b/contrib/perl5/ext/DynaLoader/dl_aix.xs deleted file mode 100644 index e29c0f8..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_aix.xs +++ /dev/null @@ -1,744 +0,0 @@ -/* dl_aix.xs - * - * Written: 8/31/94 by Wayne Scott (wscott@ichips.intel.com) - * - * All I did was take Jens-Uwe Mager's libdl emulation library for - * AIX and merged it with the dl_dlopen.xs file to create a dynamic library - * package that works for AIX. - * - * I did change all malloc's, free's, strdup's, calloc's to use the perl - * equilvant. I also removed some stuff we will not need. Call fini() - * on statup... It can probably be trimmed more. - */ - -#define PERLIO_NOT_STDIO 0 - -/* - * @(#)dlfcn.c 1.5 revision of 93/02/14 20:14:17 - * This is an unpublished work copyright (c) 1992 Helios Software GmbH - * 3000 Hannover 1, Germany - */ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -/* When building as a 64-bit binary on AIX, define this to get the - * correct structure definitions. Also determines the field-name - * macros and gates some logic in readEntries(). -- Steven N. Hirsch - * <hirschs@btv.ibm.com> */ -#ifdef USE_64_BIT_ALL -# define __XCOFF64__ -# define __XCOFF32__ -#endif - -#include <stdio.h> -#include <errno.h> -#include <string.h> -#include <stdlib.h> -#include <sys/types.h> -#include <sys/ldr.h> -#include <a.out.h> -#undef FREAD -#undef FWRITE -#include <ldfcn.h> - -#ifdef USE_64_BIT_ALL -# define AIX_SCNHDR SCNHDR_64 -# define AIX_LDHDR LDHDR_64 -# define AIX_LDSYM LDSYM_64 -# define AIX_LDHDRSZ LDHDRSZ_64 -#else -# define AIX_SCNHDR SCNHDR -# define AIX_LDHDR LDHDR -# define AIX_LDSYM LDSYM -# define AIX_LDHDRSZ LDHDRSZ -#endif - -/* When using Perl extensions written in C++ the longer versions - * of load() and unload() from libC and libC_r need to be used, - * otherwise statics in the extensions won't get initialized right. - * -- Stephanie Beals <bealzy@us.ibm.com> */ - -/* Older AIX C compilers cannot deal with C++ double-slash comments in - the ibmcxx and/or xlC includes. Since we only need a single file, - be more fine-grained about what's included <hirschs@btv.ibm.com> */ - -#ifdef USE_libC /* The define comes, when it comes, from hints/aix.pl. */ -# define LOAD loadAndInit -# define UNLOAD terminateAndUnload -# if defined(USE_vacpp_load_h) -# include "/usr/vacpp/include/load.h" -# elif defined(USE_ibmcxx_load_h) -# include "/usr/ibmcxx/include/load.h" -# elif defined(USE_xlC_load_h) -# include "/usr/lpp/xlC/include/load.h" -# elif defined(USE_load_h) -# include "/usr/include/load.h" -# endif -#else -# define LOAD load -# define UNLOAD unload -#endif - -/* - * AIX 4.3 does remove some useful definitions from ldfcn.h. Define - * these here to compensate for that lossage. - */ -#ifndef BEGINNING -# define BEGINNING SEEK_SET -#endif -#ifndef FSEEK -# define FSEEK(ldptr,o,p) fseek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr) +o):o,p) -#endif -#ifndef FREAD -# define FREAD(p,s,n,ldptr) fread(p,s,n,IOPTR(ldptr)) -#endif - -/* - * We simulate dlopen() et al. through a call to load. Because AIX has - * no call to find an exported symbol we read the loader section of the - * loaded module and build a list of exported symbols and their virtual - * address. - */ - -typedef struct { - char *name; /* the symbols's name */ - void *addr; /* its relocated virtual address */ -} Export, *ExportPtr; - -/* - * The void * handle returned from dlopen is actually a ModulePtr. - */ -typedef struct Module { - struct Module *next; - char *name; /* module name for refcounting */ - int refCnt; /* the number of references */ - void *entry; /* entry point from load */ - int nExports; /* the number of exports found */ - ExportPtr exports; /* the array of exports */ -} Module, *ModulePtr; - -/* - * We keep a list of all loaded modules to be able to reference count - * duplicate dlopen's. - */ -static ModulePtr modList; /* XXX threaded */ - -/* - * The last error from one of the dl* routines is kept in static - * variables here. Each error is returned only once to the caller. - */ -static char errbuf[BUFSIZ]; /* XXX threaded */ -static int errvalid; /* XXX threaded */ - -static void caterr(char *); -static int readExports(ModulePtr); -static void *findMain(void); - -static char *strerror_failed = "(strerror failed)"; -static char *strerror_r_failed = "(strerror_r failed)"; - -char *strerrorcat(char *str, int err) { - int strsiz = strlen(str); - int msgsiz; - char *msg; - -#ifdef USE_THREADS - char *buf = malloc(BUFSIZ); - - if (buf == 0) - return 0; - if (strerror_r(err, buf, BUFSIZ) == 0) - msg = buf; - else - msg = strerror_r_failed; - msgsiz = strlen(msg); - if (strsiz + msgsiz < BUFSIZ) - strcat(str, msg); - free(buf); -#else - if ((msg = strerror(err)) == 0) - msg = strerror_failed; - msgsiz = strlen(msg); /* Note msg = buf and free() above. */ - if (strsiz + msgsiz < BUFSIZ) /* Do not move this after #endif. */ - strcat(str, msg); -#endif - - return str; -} - -char *strerrorcpy(char *str, int err) { - int msgsiz; - char *msg; - -#ifdef USE_THREADS - char *buf = malloc(BUFSIZ); - - if (buf == 0) - return 0; - if (strerror_r(err, buf, BUFSIZ) == 0) - msg = buf; - else - msg = strerror_r_failed; - msgsiz = strlen(msg); - if (msgsiz < BUFSIZ) - strcpy(str, msg); - free(buf); -#else - if ((msg = strerror(err)) == 0) - msg = strerror_failed; - msgsiz = strlen(msg); /* Note msg = buf and free() above. */ - if (msgsiz < BUFSIZ) /* Do not move this after #endif. */ - strcpy(str, msg); -#endif - - return str; -} - -/* ARGSUSED */ -void *dlopen(char *path, int mode) -{ - dTHX; - register ModulePtr mp; - static void *mainModule; /* XXX threaded */ - - /* - * Upon the first call register a terminate handler that will - * close all libraries. - */ - if (mainModule == NULL) { - if ((mainModule = findMain()) == NULL) - return NULL; - } - /* - * Scan the list of modules if have the module already loaded. - */ - for (mp = modList; mp; mp = mp->next) - if (strcmp(mp->name, path) == 0) { - mp->refCnt++; - return mp; - } - Newz(1000,mp,1,Module); - if (mp == NULL) { - errvalid++; - strcpy(errbuf, "Newz: "); - strerrorcat(errbuf, errno); - return NULL; - } - - if ((mp->name = savepv(path)) == NULL) { - errvalid++; - strcpy(errbuf, "savepv: "); - strerrorcat(errbuf, errno); - safefree(mp); - return NULL; - } - - /* - * load should be declared load(const char *...). Thus we - * cast the path to a normal char *. Ugly. - */ - if ((mp->entry = (void *)LOAD((char *)path, -#ifdef L_LIBPATH_EXEC - L_LIBPATH_EXEC | -#endif - L_NOAUTODEFER, - NULL)) == NULL) { - int saverrno = errno; - - safefree(mp->name); - safefree(mp); - errvalid++; - strcpy(errbuf, "dlopen: "); - strcat(errbuf, path); - strcat(errbuf, ": "); - /* - * If AIX says the file is not executable, the error - * can be further described by querying the loader about - * the last error. - */ - if (saverrno == ENOEXEC) { - char *moreinfo[BUFSIZ/sizeof(char *)]; - if (loadquery(L_GETMESSAGES, moreinfo, sizeof(moreinfo)) == -1) - strerrorcpy(errbuf, saverrno); - else { - char **p; - for (p = moreinfo; *p; p++) - caterr(*p); - } - } else - strerrorcat(errbuf, saverrno); - return NULL; - } - mp->refCnt = 1; - mp->next = modList; - modList = mp; - /* - * Assume anonymous exports come from the module this dlopen - * is linked into, that holds true as long as dlopen and all - * of the perl core are in the same shared object. Also bind - * against the main part, in the case a perl is not the main - * part, e.g mod_perl as DSO in Apache so perl modules can - * also reference Apache symbols. - */ - if (loadbind(0, (void *)dlopen, mp->entry) == -1 || - loadbind(0, mainModule, mp->entry)) { - int saverrno = errno; - - dlclose(mp); - errvalid++; - strcpy(errbuf, "loadbind: "); - strerrorcat(errbuf, saverrno); - return NULL; - } - if (readExports(mp) == -1) { - dlclose(mp); - return NULL; - } - return mp; -} - -/* - * Attempt to decipher an AIX loader error message and append it - * to our static error message buffer. - */ -static void caterr(char *s) -{ - register char *p = s; - - while (*p >= '0' && *p <= '9') - p++; - switch(atoi(s)) { - case L_ERROR_TOOMANY: - strcat(errbuf, "too many errors"); - break; - case L_ERROR_NOLIB: - strcat(errbuf, "can't load library"); - strcat(errbuf, p); - break; - case L_ERROR_UNDEF: - strcat(errbuf, "can't find symbol"); - strcat(errbuf, p); - break; - case L_ERROR_RLDBAD: - strcat(errbuf, "bad RLD"); - strcat(errbuf, p); - break; - case L_ERROR_FORMAT: - strcat(errbuf, "bad exec format in"); - strcat(errbuf, p); - break; - case L_ERROR_ERRNO: - strerrorcat(errbuf, atoi(++p)); - break; - default: - strcat(errbuf, s); - break; - } -} - -void *dlsym(void *handle, const char *symbol) -{ - register ModulePtr mp = (ModulePtr)handle; - register ExportPtr ep; - register int i; - - /* - * Could speed up search, but I assume that one assigns - * the result to function pointers anyways. - */ - for (ep = mp->exports, i = mp->nExports; i; i--, ep++) - if (strcmp(ep->name, symbol) == 0) - return ep->addr; - errvalid++; - strcpy(errbuf, "dlsym: undefined symbol "); - strcat(errbuf, symbol); - return NULL; -} - -char *dlerror(void) -{ - if (errvalid) { - errvalid = 0; - return errbuf; - } - return NULL; -} - -int dlclose(void *handle) -{ - register ModulePtr mp = (ModulePtr)handle; - int result; - register ModulePtr mp1; - - if (--mp->refCnt > 0) - return 0; - result = UNLOAD(mp->entry); - if (result == -1) { - errvalid++; - strerrorcpy(errbuf, errno); - } - if (mp->exports) { - register ExportPtr ep; - register int i; - for (ep = mp->exports, i = mp->nExports; i; i--, ep++) - if (ep->name) - safefree(ep->name); - safefree(mp->exports); - } - if (mp == modList) - modList = mp->next; - else { - for (mp1 = modList; mp1; mp1 = mp1->next) - if (mp1->next == mp) { - mp1->next = mp->next; - break; - } - } - safefree(mp->name); - safefree(mp); - return result; -} - -/* Added by Wayne Scott - * This is needed because the ldopen system call calls - * calloc to allocated a block of date. The ldclose call calls free. - * Without this we get this system calloc and perl's free, resulting - * in a "Bad free" message. This way we always use perl's malloc. - */ -void *calloc(size_t ne, size_t sz) -{ - void *out; - - out = (void *) safemalloc(ne*sz); - memzero(out, ne*sz); - return(out); -} - -/* - * Build the export table from the XCOFF .loader section. - */ -static int readExports(ModulePtr mp) -{ - dTHX; - LDFILE *ldp = NULL; - AIX_SCNHDR sh; - AIX_LDHDR *lhp; - char *ldbuf; - AIX_LDSYM *ls; - int i; - ExportPtr ep; - - if ((ldp = ldopen(mp->name, ldp)) == NULL) { - struct ld_info *lp; - char *buf; - int size = 4*1024; - if (errno != ENOENT) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); - return -1; - } - /* - * The module might be loaded due to the LIBPATH - * environment variable. Search for the loaded - * module using L_GETINFO. - */ - if ((buf = safemalloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); - return -1; - } - while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) { - safefree(buf); - size += 4*1024; - if ((buf = safemalloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); - return -1; - } - } - if (i == -1) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); - safefree(buf); - return -1; - } - /* - * Traverse the list of loaded modules. The entry point - * returned by LOAD() does actually point to the data - * segment origin. - */ - lp = (struct ld_info *)buf; - while (lp) { - if (lp->ldinfo_dataorg == mp->entry) { - ldp = ldopen(lp->ldinfo_filename, ldp); - break; - } - if (lp->ldinfo_next == 0) - lp = NULL; - else - lp = (struct ld_info *)((char *)lp + lp->ldinfo_next); - } - safefree(buf); - if (!ldp) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); - return -1; - } - } -#ifdef USE_64_BIT_ALL - if (TYPE(ldp) != U803XTOCMAGIC) { -#else - if (TYPE(ldp) != U802TOCMAGIC) { -#endif - errvalid++; - strcpy(errbuf, "readExports: bad magic"); - while(ldclose(ldp) == FAILURE) - ; - return -1; - } - if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) { - errvalid++; - strcpy(errbuf, "readExports: cannot read loader section header"); - while(ldclose(ldp) == FAILURE) - ; - return -1; - } - /* - * We read the complete loader section in one chunk, this makes - * finding long symbol names residing in the string table easier. - */ - if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); - while(ldclose(ldp) == FAILURE) - ; - return -1; - } - if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) { - errvalid++; - strcpy(errbuf, "readExports: cannot seek to loader section"); - safefree(ldbuf); - while(ldclose(ldp) == FAILURE) - ; - return -1; - } -/* This first case is a hack, since it assumes that the 3rd parameter to - FREAD is 1. See the redefinition of FREAD above to see how this works. */ - if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) { - errvalid++; - strcpy(errbuf, "readExports: cannot read loader section"); - safefree(ldbuf); - while(ldclose(ldp) == FAILURE) - ; - return -1; - } - lhp = (AIX_LDHDR *)ldbuf; - ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ); - /* - * Count the number of exports to include in our export table. - */ - for (i = lhp->l_nsyms; i; i--, ls++) { - if (!LDR_EXPORT(*ls)) - continue; - mp->nExports++; - } - Newz(1001, mp->exports, mp->nExports, Export); - if (mp->exports == NULL) { - errvalid++; - strcpy(errbuf, "readExports: "); - strerrorcat(errbuf, errno); - safefree(ldbuf); - while(ldclose(ldp) == FAILURE) - ; - return -1; - } - /* - * Fill in the export table. All entries are relative to - * the entry point we got from load. - */ - ep = mp->exports; - ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ); - for (i = lhp->l_nsyms; i; i--, ls++) { - char *symname; - if (!LDR_EXPORT(*ls)) - continue; -#ifndef USE_64_BIT_ALL - if (ls->l_zeroes == 0) -#endif - symname = ls->l_offset+lhp->l_stoff+ldbuf; -#ifndef USE_64_BIT_ALL - else - symname = ls->l_name; -#endif - ep->name = savepv(symname); - ep->addr = (void *)((unsigned long)mp->entry + ls->l_value); - ep++; - } - safefree(ldbuf); - while(ldclose(ldp) == FAILURE) - ; - return 0; -} - -/* - * Find the main modules entry point. This is used as export pointer - * for loadbind() to be able to resolve references to the main part. - */ -static void * findMain(void) -{ - struct ld_info *lp; - char *buf; - int size = 4*1024; - int i; - void *ret; - - if ((buf = safemalloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "findMain: "); - strerrorcat(errbuf, errno); - return NULL; - } - while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) { - safefree(buf); - size += 4*1024; - if ((buf = safemalloc(size)) == NULL) { - errvalid++; - strcpy(errbuf, "findMain: "); - strerrorcat(errbuf, errno); - return NULL; - } - } - if (i == -1) { - errvalid++; - strcpy(errbuf, "findMain: "); - strerrorcat(errbuf, errno); - safefree(buf); - return NULL; - } - /* - * The first entry is the main module. The entry point - * returned by load() does actually point to the data - * segment origin. - */ - lp = (struct ld_info *)buf; - ret = lp->ldinfo_dataorg; - safefree(buf); - return ret; -} - -/* dl_dlopen.xs - * - * Platform: SunOS/Solaris, possibly others which use dlopen. - * Author: Paul Marquess (Paul.Marquess@btinternet.com) - * Created: 10th July 1994 - * - * Modified: - * 15th July 1994 - Added code to explicitly save any error messages. - * 3rd August 1994 - Upgraded to v3 spec. - * 9th August 1994 - Changed to use IV - * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging, - * basic FreeBSD support, removed ClearError - * - */ - -/* Porting notes: - - see dl_dlopen.xs - -*/ - -#include "dlutils.c" /* SaveError() etc */ - - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); -} - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - - -void * -dl_load_file(filename, flags=0) - char * filename - int flags - CODE: - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); - if (flags & 0x01) - Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); - RETVAL = dlopen(filename, 1) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL) ); - -int -dl_unload_file(libref) - void * libref - CODE: - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", libref)); - RETVAL = (dlclose(libref) == 0 ? 1 : 0); - if (!RETVAL) - SaveError(aTHX_ "%s", dlerror()) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL)); - OUTPUT: - RETVAL - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); - RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL)); - - -void -dl_undef_symbols() - PPCODE: - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_beos.xs b/contrib/perl5/ext/DynaLoader/dl_beos.xs deleted file mode 100644 index 705c8bc..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_beos.xs +++ /dev/null @@ -1,117 +0,0 @@ -/* - * dl_beos.xs, by Tom Spindler - * based on dl_dlopen.xs, by Paul Marquess - * $Id:$ - */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include <be/kernel/image.h> -#include <OS.h> -#include <stdlib.h> -#include <limits.h> - -#define dlerror() strerror(errno) - -#include "dlutils.c" /* SaveError() etc */ - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); -} - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - - -void * -dl_load_file(filename, flags=0) - char * filename - int flags - CODE: -{ image_id bogo; - char *path; - path = malloc(PATH_MAX); - if (*filename != '/') { - getcwd(path, PATH_MAX); - strcat(path, "/"); - strcat(path, filename); - } else { - strcpy(path, filename); - } - - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", path, flags)); - bogo = load_add_on(path); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (bogo < 0) { - SaveError(aTHX_ "%s", strerror(bogo)); - PerlIO_printf(Perl_debug_log, "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo)); - } else { - RETVAL = (void *) bogo; - sv_setiv( ST(0), PTR2IV(RETVAL) ); - } - free(path); -} - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - status_t retcode; - void *adr = 0; -#ifdef DLSYM_NEEDS_UNDERSCORE - symbolname = Perl_form_nocontext("_%s", symbolname); -#endif - RETVAL = NULL; - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - "dl_find_symbol(handle=%lx, symbol=%s)\n", - (unsigned long) libhandle, symbolname)); - retcode = get_image_symbol((image_id) libhandle, symbolname, - B_SYMBOL_TYPE_TEXT, (void **) &adr); - RETVAL = adr; - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - " symbolref = %lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) { - SaveError(aTHX_ "%s", strerror(retcode)) ; - PerlIO_printf(Perl_debug_log, "retcode = %p (%s)\n", retcode, strerror(retcode)); - } else - sv_setiv( ST(0), PTR2IV(RETVAL)); - - -void -dl_undef_symbols() - PPCODE: - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n", - perl_name, (unsigned long) symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_dld.xs b/contrib/perl5/ext/DynaLoader/dl_dld.xs deleted file mode 100644 index d8fad2a..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_dld.xs +++ /dev/null @@ -1,177 +0,0 @@ -/* - * Written 3/1/94, Robert Sanders <Robert.Sanders@linux.org> - * - * based upon the file "dl.c", which is - * Copyright (c) 1994, Larry Wall - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - * $Date: 1994/03/07 00:21:43 $ - * $Source: /home/rsanders/src/perl5alpha6/RCS/dld_dl.c,v $ - * $Revision: 1.4 $ - * $State: Exp $ - * - * $Log: dld_dl.c,v $ - * Removed implicit link against libc. 1994/09/14 William Setzer. - * - * Integrated other DynaLoader changes. 1994/06/08 Tim Bunce. - * - * rewrote dl_load_file, misc updates. 1994/09/03 William Setzer. - * - * Revision 1.4 1994/03/07 00:21:43 rsanders - * added min symbol count for load_libs and switched order so system libs - * are loaded after app-specified libs. - * - * Revision 1.3 1994/03/05 01:17:26 rsanders - * added path searching. - * - * Revision 1.2 1994/03/05 00:52:39 rsanders - * added package-specified libraries. - * - * Revision 1.1 1994/03/05 00:33:40 rsanders - * Initial revision - * - * - */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include <dld.h> /* GNU DLD header file */ -#include <unistd.h> - -#include "dlutils.c" /* for SaveError() etc */ - -static AV *dl_resolve_using = Nullav; -static AV *dl_require_symbols = Nullav; - -static void -dl_private_init(pTHX) -{ - int dlderr; - dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); - dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI); -#ifdef __linux__ - dlderr = dld_init("/proc/self/exe"); - if (dlderr) { -#endif - dlderr = dld_init(dld_find_executable(PL_origargv[0])); - if (dlderr) { - char *msg = dld_strerror(dlderr); - SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg); - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", LastError)); - } -#ifdef __linux__ - } -#endif -} - - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(); - - -char * -dl_load_file(filename, flags=0) - char * filename - int flags - PREINIT: - int dlderr,x,max; - GV *gv; - CODE: - RETVAL = filename; - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); - if (flags & 0x01) - Perl_croak(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); - max = AvFILL(dl_require_symbols); - for (x = 0; x <= max; x++) { - char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0)); - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_create_ref(%s)\n", sym)); - if (dlderr = dld_create_reference(sym)) { - SaveError(aTHX_ "dld_create_reference(%s): %s", sym, - dld_strerror(dlderr)); - goto haverror; - } - } - - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", filename)); - if (dlderr = dld_link(filename)) { - SaveError(aTHX_ "dld_link(%s): %s", filename, dld_strerror(dlderr)); - goto haverror; - } - - max = AvFILL(dl_resolve_using); - for (x = 0; x <= max; x++) { - char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0)); - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", sym)); - if (dlderr = dld_link(sym)) { - SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr)); - goto haverror; - } - } - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", RETVAL)); -haverror: - ST(0) = sv_newmortal() ; - if (dlderr == 0) - sv_setiv(ST(0), PTR2IV(RETVAL)); - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); - RETVAL = (void *)dld_get_func(symbolname); - /* if RETVAL==NULL we should try looking for a non-function symbol */ - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ; - else - sv_setiv(ST(0), PTR2IV(RETVAL)); - - -void -dl_undef_symbols() - PPCODE: - if (dld_undefined_sym_count) { - int x; - char **undef_syms = dld_list_undefined_sym(); - EXTEND(SP, dld_undefined_sym_count); - for (x=0; x < dld_undefined_sym_count; x++) - PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0))); - free(undef_syms); - } - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_dllload.xs b/contrib/perl5/ext/DynaLoader/dl_dllload.xs deleted file mode 100644 index fe6957a..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_dllload.xs +++ /dev/null @@ -1,189 +0,0 @@ -/* dl_dllload.xs - * - * Platform: OS/390, possibly others that use dllload(),dllfree() (VM/ESA?). - * Authors: John Goodyear && Peter Prymmer - * Created: 28 October 2000 - * Modified: - * 16 January 2001 - based loosely on dl_dlopen.xs. - */ - -/* Porting notes: - - OS/390 Dynamic Loading functions: - - dllload - ------- - dllhandle * dllload(const char *dllName) - - This function takes the name of a dynamic object file and returns - a descriptor which can be used by dlllqueryfn() and/or dllqueryvar() - later. If dllName contains a slash, it is used to locate the dll. - If not then the LIBPATH environment variable is used to - search for the requested dll (at least within the HFS). - It returns NULL on error and sets errno. - - dllfree - ------- - int dllfree(dllhandle *handle); - - dllfree() decrements the load count for the dll and frees - it if the count is 0. It returns zero on success, and - non-zero on failure. - - dllqueryfn && dllqueryvar - ------------------------- - void (* dllqueryfn(dllhandle *handle, const char *function))(); - void * dllqueryvar(dllhandle *handle, const char *symbol); - - dllqueryfn() takes the handle returned from dllload() and the name - of a function to get the address of. If the function was found - a pointer is returned, otherwise NULL is returned. - - dllqueryvar() takes the handle returned from dllload() and the name - of a symbol to get the address of. If the variable was found a - pointer is returned, otherwise NULL is returned. - - The XS dl_find_symbol() first calls dllqueryfn(). If it fails - dlqueryvar() is then called. - - strerror - -------- - char * strerror(int errno) - - Returns a null-terminated string which describes the last error - that occurred with other functions (not necessarily unique to - dll loading). - - Return Types - ============ - In this implementation the two functions, dl_load_file() && - dl_find_symbol(), return (void *). This is primarily because the - dlopen() && dlsym() style dynamic linker calls return (void *). - We suspect that casting to (void *) may be easier than teaching XS - typemaps about the (dllhandle *) type. - - Dealing with Error Messages - =========================== - In order to make the handling of dynamic linking errors as generic as - possible you should store any error messages associated with your - implementation with the StoreError function. - - In the case of OS/390 the function strerror(errno) returns the error - message associated with the last dynamic link error. As the S/390 - dynamic linker functions dllload() && dllqueryvar() both return NULL - on error every call to an S/390 dynamic link routine is coded - like this: - - RETVAL = dllload(filename) ; - if (RETVAL == NULL) - SaveError("%s",strerror(errno)) ; - - Note that SaveError() takes a printf format string. Use a "%s" as - the first parameter if the error may contain any % characters. - - Other comments within the dl_dlopen.xs file may be helpful as well. -*/ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include <dll.h> /* the dynamic linker include file for S/390 */ -#include <errno.h> /* strerror() and friends */ - -#include "dlutils.c" /* SaveError() etc */ - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); -} - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - - -void * -dl_load_file(filename, flags=0) - char * filename - int flags - PREINIT: - int mode = 0; - CODE: -{ - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); - /* add a (void *) dllload(filename) ; cast if needed */ - RETVAL = dllload(filename) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",strerror(errno)) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL)); -} - - -int -dl_unload_file(libref) - void * libref - CODE: - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref))); - /* RETVAL = (dllfree((dllhandle *)libref) == 0 ? 1 : 0); */ - RETVAL = (dllfree(libref) == 0 ? 1 : 0); - if (!RETVAL) - SaveError(aTHX_ "%s", strerror(errno)) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL)); - OUTPUT: - RETVAL - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - "dl_find_symbol(handle=%lx, symbol=%s)\n", - (unsigned long) libhandle, symbolname)); - if((RETVAL = (void*)dllqueryfn(libhandle, symbolname)) == NULL) - RETVAL = dllqueryvar(libhandle, symbolname); - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - " symbolref = %lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",strerror(errno)) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL)); - - -void -dl_undef_symbols() - PPCODE: - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n", - perl_name, (unsigned long) symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_dlopen.xs b/contrib/perl5/ext/DynaLoader/dl_dlopen.xs deleted file mode 100644 index e1b2a82..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_dlopen.xs +++ /dev/null @@ -1,259 +0,0 @@ -/* dl_dlopen.xs - * - * Platform: SunOS/Solaris, possibly others which use dlopen. - * Author: Paul Marquess (Paul.Marquess@btinternet.com) - * Created: 10th July 1994 - * - * Modified: - * 15th July 1994 - Added code to explicitly save any error messages. - * 3rd August 1994 - Upgraded to v3 spec. - * 9th August 1994 - Changed to use IV - * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging, - * basic FreeBSD support, removed ClearError - * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd - * files when the interpreter exits - * - */ - -/* Porting notes: - - - Definition of Sunos dynamic Linking functions - ============================================= - In order to make this implementation easier to understand here is a - quick definition of the SunOS Dynamic Linking functions which are - used here. - - dlopen - ------ - void * - dlopen(path, mode) - char * path; - int mode; - - This function takes the name of a dynamic object file and returns - a descriptor which can be used by dlsym later. It returns NULL on - error. - - The mode parameter must be set to 1 for Solaris 1 and to - RTLD_LAZY (==2) on Solaris 2. - - - dlclose - ------- - int - dlclose(handle) - void * handle; - - This function takes the handle returned by a previous invocation of - dlopen and closes the associated dynamic object file. It returns zero - on success, and non-zero on failure. - - - dlsym - ------ - void * - dlsym(handle, symbol) - void * handle; - char * symbol; - - Takes the handle returned from dlopen and the name of a symbol to - get the address of. If the symbol was found a pointer is - returned. It returns NULL on error. If DL_PREPEND_UNDERSCORE is - defined an underscore will be added to the start of symbol. This - is required on some platforms (freebsd). - - dlerror - ------ - char * dlerror() - - Returns a null-terminated string which describes the last error - that occurred with either dlopen or dlsym. After each call to - dlerror the error message will be reset to a null pointer. The - SaveError function is used to save the error as soon as it happens. - - - Return Types - ============ - In this implementation the two functions, dl_load_file & - dl_find_symbol, return void *. This is because the underlying SunOS - dynamic linker calls also return void *. This is not necessarily - the case for all architectures. For example, some implementation - will want to return a char * for dl_load_file. - - If void * is not appropriate for your architecture, you will have to - change the void * to whatever you require. If you are not certain of - how Perl handles C data types, I suggest you start by consulting - Dean Roerich's Perl 5 API document. Also, have a look in the typemap - file (in the ext directory) for a fairly comprehensive list of types - that are already supported. If you are completely stuck, I suggest you - post a message to perl5-porters, comp.lang.perl.misc or if you are really - desperate to me. - - Remember when you are making any changes that the return value from - dl_load_file is used as a parameter in the dl_find_symbol - function. Also the return value from find_symbol is used as a parameter - to install_xsub. - - - Dealing with Error Messages - ============================ - In order to make the handling of dynamic linking errors as generic as - possible you should store any error messages associated with your - implementation with the StoreError function. - - In the case of SunOS the function dlerror returns the error message - associated with the last dynamic link error. As the SunOS dynamic - linker functions dlopen & dlsym both return NULL on error every call - to a SunOS dynamic link routine is coded like this - - RETVAL = dlopen(filename, 1) ; - if (RETVAL == NULL) - SaveError("%s",dlerror()) ; - - Note that SaveError() takes a printf format string. Use a "%s" as - the first parameter if the error may contain any % characters. - -*/ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#ifdef I_DLFCN -#include <dlfcn.h> /* the dynamic linker include file for Sunos/Solaris */ -#else -#include <nlist.h> -#include <link.h> -#endif - -#ifndef RTLD_LAZY -# define RTLD_LAZY 1 /* Solaris 1 */ -#endif - -#ifndef HAS_DLERROR -# ifdef __NetBSD__ -# define dlerror() strerror(errno) -# else -# define dlerror() "Unknown error - dlerror() not implemented" -# endif -#endif - - -#include "dlutils.c" /* SaveError() etc */ - - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); -} - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - - -void * -dl_load_file(filename, flags=0) - char * filename - int flags - PREINIT: - int mode = RTLD_LAZY; - CODE: -{ -#if defined(DLOPEN_WONT_DO_RELATIVE_PATHS) - char pathbuf[PATH_MAX + 2]; - if (*filename != '/' && strchr(filename, '/')) { - if (getcwd(pathbuf, PATH_MAX - strlen(filename))) { - strcat(pathbuf, "/"); - strcat(pathbuf, filename); - filename = pathbuf; - } - } -#endif -#ifdef RTLD_NOW - if (dl_nonlazy) - mode = RTLD_NOW; -#endif - if (flags & 0x01) -#ifdef RTLD_GLOBAL - mode |= RTLD_GLOBAL; -#else - Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); -#endif - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); - RETVAL = dlopen(filename, mode) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL)); -} - - -int -dl_unload_file(libref) - void * libref - CODE: - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref))); - RETVAL = (dlclose(libref) == 0 ? 1 : 0); - if (!RETVAL) - SaveError(aTHX_ "%s", dlerror()) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL)); - OUTPUT: - RETVAL - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: -#ifdef DLSYM_NEEDS_UNDERSCORE - symbolname = Perl_form_nocontext("_%s", symbolname); -#endif - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - "dl_find_symbol(handle=%lx, symbol=%s)\n", - (unsigned long) libhandle, symbolname)); - RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - " symbolref = %lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL)); - - -void -dl_undef_symbols() - PPCODE: - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n", - perl_name, (unsigned long) symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_dyld.xs b/contrib/perl5/ext/DynaLoader/dl_dyld.xs deleted file mode 100644 index 688e474..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_dyld.xs +++ /dev/null @@ -1,226 +0,0 @@ -/* dl_dyld.xs - * - * Platform: Darwin (Mac OS) - * Author: Wilfredo Sanchez <wsanchez@apple.com> - * Based on: dl_next.xs by Paul Marquess - * Based on: dl_dlopen.xs by Anno Siegel - * Created: Aug 15th, 1994 - * - */ - -/* - And Gandalf said: 'Many folk like to know beforehand what is to - be set on the table; but those who have laboured to prepare the - feast like to keep their secret; for wonder makes the words of - praise louder.' -*/ - -/* Porting notes: - -dl_dyld.xs is based on dl_next.xs by Anno Siegel. - -dl_next.xs is in turn a port from dl_dlopen.xs by Paul Marquess. It -should not be used as a base for further ports though it may be used -as an example for how dl_dlopen.xs can be ported to other platforms. - -The method used here is just to supply the sun style dlopen etc. -functions in terms of NeXT's/Apple's dyld. The xs code proper is -unchanged from Paul's original. - -The port could use some streamlining. For one, error handling could -be simplified. - -This should be useable as a replacement for dl_next.xs, but it has not -been tested on NeXT platforms. - - Wilfredo Sanchez - -*/ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define DL_LOADONCEONLY - -#include "dlutils.c" /* SaveError() etc */ - -#undef environ -#undef bool -#import <mach-o/dyld.h> - -static char * dl_last_error = (char *) 0; -static AV *dl_resolve_using = Nullav; - -static char *dlerror() -{ - return dl_last_error; -} - -int dlclose(handle) /* stub only */ -void *handle; -{ - return 0; -} - -enum dyldErrorSource -{ - OFImage, -}; - -static void TranslateError - (const char *path, enum dyldErrorSource type, int number) -{ - dTHX; - char *error; - unsigned int index; - static char *OFIErrorStrings[] = - { - "%s(%d): Object Image Load Failure\n", - "%s(%d): Object Image Load Success\n", - "%s(%d): Not an recognisable object file\n", - "%s(%d): No valid architecture\n", - "%s(%d): Object image has an invalid format\n", - "%s(%d): Invalid access (permissions?)\n", - "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n", - }; -#define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0])) - - switch (type) - { - case OFImage: - index = number; - if (index > NUM_OFI_ERRORS - 1) - index = NUM_OFI_ERRORS - 1; - error = Perl_form_nocontext(OFIErrorStrings[index], path, number); - break; - - default: - error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n", - path, number, type); - break; - } - safefree(dl_last_error); - dl_last_error = savepv(error); -} - -static char *dlopen(char *path, int mode /* mode is ignored */) -{ - int dyld_result; - NSObjectFileImage ofile; - NSModule handle = NULL; - - dyld_result = NSCreateObjectFileImageFromFile(path, &ofile); - if (dyld_result != NSObjectFileImageSuccess) - TranslateError(path, OFImage, dyld_result); - else - { - // NSLinkModule will cause the run to abort on any link error's - // not very friendly but the error recovery functionality is limited. - handle = NSLinkModule(ofile, path, TRUE); - } - - return handle; -} - -void * -dlsym(handle, symbol) -void *handle; -char *symbol; -{ - void *addr; - - if (NSIsSymbolNameDefined(symbol)) - addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol)); - else - addr = NULL; - - return addr; -} - - - -/* ----- code from dl_dlopen.xs below here ----- */ - - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); -} - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - - - -void * -dl_load_file(filename, flags=0) - char * filename - int flags - PREINIT: - int mode = 1; - CODE: - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); - if (flags & 0x01) - Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); - RETVAL = dlopen(filename, mode) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL) ); - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - symbolname = Perl_form_nocontext("_%s", symbolname); - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - "dl_find_symbol(handle=%lx, symbol=%s)\n", - (unsigned long) libhandle, symbolname)); - RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - " symbolref = %lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL) ); - - -void -dl_undef_symbols() - PPCODE: - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_hpux.xs b/contrib/perl5/ext/DynaLoader/dl_hpux.xs deleted file mode 100644 index 582c047..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_hpux.xs +++ /dev/null @@ -1,159 +0,0 @@ -/* - * Author: Jeff Okamoto (okamoto@corp.hp.com) - * Version: 2.1, 1995/1/25 - */ - -/* o Added BIND_VERBOSE to dl_nonlazy condition to add names of missing - * symbols to stderr message on fatal error. - * - * o Added BIND_NONFATAL comment to default condition. - * - * Chuck Phillips (cdp@fc.hp.com) - * Version: 2.2, 1997/5/4 */ - -#ifdef __hp9000s300 -#define magic hpux_magic -#define MAGIC HPUX_MAGIC -#endif - -#include <dl.h> -#ifdef __hp9000s300 -#undef magic -#undef MAGIC -#endif - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - - -#include "dlutils.c" /* for SaveError() etc */ - -static AV *dl_resolve_using = Nullav; - - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); -} - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - - -void * -dl_load_file(filename, flags=0) - char * filename - int flags - PREINIT: - shl_t obj = NULL; - int i, max, bind_type; - CODE: - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); - if (flags & 0x01) - Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); - if (dl_nonlazy) { - bind_type = BIND_IMMEDIATE|BIND_VERBOSE; - } else { - bind_type = BIND_DEFERRED; - /* For certain libraries, like DCE, deferred binding often causes run - * time problems. Adding BIND_NONFATAL to BIND_IMMEDIATE still allows - * unresolved references in situations like this. */ - /* bind_type = BIND_IMMEDIATE|BIND_NONFATAL; */ - } - /* BIND_NOSTART removed from bind_type because it causes the shared library's */ - /* initialisers not to be run. This causes problems with all of the static objects */ - /* in the library. */ -#ifdef DEBUGGING - if (dl_debug) - bind_type |= BIND_VERBOSE; -#endif /* DEBUGGING */ - - max = AvFILL(dl_resolve_using); - for (i = 0; i <= max; i++) { - char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0)); - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s) (dependent)\n", sym)); - obj = shl_load(sym, bind_type, 0L); - if (obj == NULL) { - goto end; - } - } - - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s): ", filename)); - obj = shl_load(filename, bind_type, 0L); - - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", obj)); -end: - ST(0) = sv_newmortal() ; - if (obj == NULL) - SaveError(aTHX_ "%s",Strerror(errno)); - else - sv_setiv( ST(0), PTR2IV(obj) ); - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - shl_t obj = (shl_t) libhandle; - void *symaddr = NULL; - int status; -#ifdef __hp9000s300 - symbolname = Perl_form_nocontext("_%s", symbolname); -#endif - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - "dl_find_symbol(handle=%lx, symbol=%s)\n", - (unsigned long) libhandle, symbolname)); - - ST(0) = sv_newmortal() ; - errno = 0; - - status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref(PROCEDURE) = %x\n", symaddr)); - - if (status == -1 && errno == 0) { /* try TYPE_DATA instead */ - status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref(DATA) = %x\n", symaddr)); - } - - if (status == -1) { - SaveError(aTHX_ "%s",(errno) ? Strerror(errno) : "Symbol not found") ; - } else { - sv_setiv( ST(0), PTR2IV(symaddr) ); - } - - -void -dl_undef_symbols() - PPCODE: - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_mac.xs b/contrib/perl5/ext/DynaLoader/dl_mac.xs deleted file mode 100644 index 5f48139..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_mac.xs +++ /dev/null @@ -1,137 +0,0 @@ -/* dl_mac.xs - * - * Platform: Macintosh CFM - * Author: Matthias Neeracher <neeri@iis.ee.ethz.ch> - * Adapted from dl_dlopen.xs reference implementation by - * Paul Marquess (pmarquess@bfsec.bt.co.uk) - * $Log: dl_mac.xs,v $ - * Revision 1.3 1998/04/07 01:47:24 neeri - * MacPerl 5.2.0r4b1 - * - * Revision 1.2 1997/08/08 16:39:18 neeri - * MacPerl 5.1.4b1 + time() fix - * - * Revision 1.1 1997/04/07 20:48:23 neeri - * Synchronized with MacPerl 5.1.4a1 - * - */ - -#define MAC_CONTEXT -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include <CodeFragments.h> - - -#include "dlutils.c" /* SaveError() etc */ - -typedef CFragConnectionID ConnectionID; - -static ConnectionID ** connections; - -static void terminate(void) -{ - int size = GetHandleSize((Handle) connections) / sizeof(ConnectionID); - HLock((Handle) connections); - while (size) - CloseConnection(*connections + --size); - DisposeHandle((Handle) connections); - connections = nil; -} - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); -} - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - - -ConnectionID -dl_load_file(filename, flags=0) - char * filename - int flags - PREINIT: - OSErr err; - FSSpec spec; - ConnectionID connID; - Ptr mainAddr; - Str255 errName; - CODE: - DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename)); - err = GUSIPath2FSp(filename, &spec); - if (!err) - err = - GetDiskFragment( - &spec, 0, 0, spec.name, kLoadCFrag, &connID, &mainAddr, errName); - if (!err) { - if (!connections) { - connections = (ConnectionID **)NewHandle(0); - atexit(terminate); - } - PtrAndHand((Ptr) &connID, (Handle) connections, sizeof(ConnectionID)); - RETVAL = connID; - } else - RETVAL = (ConnectionID) 0; - DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%d\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (err) - SaveError(aTHX_ "DynaLoader error [%d, %#s]", err, errName) ; - else - sv_setiv( ST(0), (IV)RETVAL); - -void * -dl_find_symbol(connID, symbol) - ConnectionID connID - Str255 symbol - CODE: - { - OSErr err; - Ptr symAddr; - CFragSymbolClass symClass; - DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%#s)\n", - connID, symbol)); - err = FindSymbol(connID, symbol, &symAddr, &symClass); - if (err) - symAddr = (Ptr) 0; - RETVAL = (void *) symAddr; - DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref = %x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (err) - SaveError(aTHX_ "DynaLoader error [%d]!", err) ; - else - sv_setiv( ST(0), (IV)RETVAL); - } - -void -dl_undef_symbols() - PPCODE: - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_mpeix.xs b/contrib/perl5/ext/DynaLoader/dl_mpeix.xs deleted file mode 100644 index 7d27901..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_mpeix.xs +++ /dev/null @@ -1,131 +0,0 @@ -/* - * Author: Mark Klein (mklein@dis.com) - * Version: 2.1, 1996/07/25 - * Version: 2.2, 1997/09/25 Mark Bixby (markb@cccd.edu) - * Version: 2.3, 1998/11/19 Mark Bixby (markb@cccd.edu) - */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#ifdef __GNUC__ -extern void HPGETPROCPLABEL( int parms, - char * procname, - int * plabel, - int * status, - char * firstfile, - int casesensitive, - int symboltype, - int * datasize, - int position, - int searchpath, - int binding); -#else -#pragma intrinsic HPGETPROCPLABEL -#endif -#include "dlutils.c" /* for SaveError() etc */ - -typedef struct { - char filename[PATH_MAX + 3]; - } t_mpe_dld, *p_mpe_dld; - -static AV *dl_resolve_using = Nullav; - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); -} - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - -void * -dl_load_file(filename, flags=0) - char * filename - int flags - PREINIT: - char buf[PATH_MAX + 3]; - p_mpe_dld obj = NULL; - int i; - CODE: - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename, -flags)); - if (flags & 0x01) - Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s -",filename); - obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld)); - memzero(obj, sizeof(t_mpe_dld)); - if (filename[0] != '/') - { - getcwd(buf,sizeof(buf)); - sprintf(obj->filename," %s/%s ",buf,filename); - } - else - sprintf(obj->filename," %s ",filename); - - DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", obj)); - - ST(0) = sv_newmortal() ; - if (obj == NULL) - SaveError(aTHX_"%s",Strerror(errno)); - else - sv_setiv( ST(0), PTR2IV(obj) ); - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - int datalen; - p_mpe_dld obj = (p_mpe_dld) libhandle; - char symname[PATH_MAX + 3]; - void * symaddr = NULL; - int status; - DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); - ST(0) = sv_newmortal() ; - errno = 0; - - sprintf(symname, " %s ", symbolname); - HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1, - 0, &datalen, 1, 0, 0); - - DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status)); - - if (status != 0) { - SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ; - } else { - sv_setiv( ST(0), PTR2IV(symaddr) ); - } - -void -dl_undef_symbols() - PPCODE: - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_next.xs b/contrib/perl5/ext/DynaLoader/dl_next.xs deleted file mode 100644 index b8c19f2..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_next.xs +++ /dev/null @@ -1,307 +0,0 @@ -/* dl_next.xs - * - * Platform: NeXT NS 3.2 - * Author: Anno Siegel (siegel@zrz.TU-Berlin.DE) - * Based on: dl_dlopen.xs by Paul Marquess - * Created: Aug 15th, 1994 - * - */ - -/* - And Gandalf said: 'Many folk like to know beforehand what is to - be set on the table; but those who have laboured to prepare the - feast like to keep their secret; for wonder makes the words of - praise louder.' -*/ - -/* Porting notes: - -dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess. It -should not be used as a base for further ports though it may be used -as an example for how dl_dlopen.xs can be ported to other platforms. - -The method used here is just to supply the sun style dlopen etc. -functions in terms of NeXTs rld_*. The xs code proper is unchanged -from Paul's original. - -The port could use some streamlining. For one, error handling could -be simplified. - -Anno Siegel - -*/ - -#if NS_TARGET_MAJOR >= 4 -#else -/* include these before perl headers */ -#include <mach-o/rld.h> -#include <streams/streams.h> -#endif - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define DL_LOADONCEONLY - -#include "dlutils.c" /* SaveError() etc */ - - -static char * dl_last_error = (char *) 0; -static AV *dl_resolve_using = Nullav; - -static char *dlerror() -{ - return dl_last_error; -} - -int dlclose(handle) /* stub only */ -void *handle; -{ - return 0; -} - -#if NS_TARGET_MAJOR >= 4 -#import <mach-o/dyld.h> - -enum dyldErrorSource -{ - OFImage, -}; - -static void TranslateError - (const char *path, enum dyldErrorSource type, int number) -{ - dTHX; - char *error; - unsigned int index; - static char *OFIErrorStrings[] = - { - "%s(%d): Object Image Load Failure\n", - "%s(%d): Object Image Load Success\n", - "%s(%d): Not an recognisable object file\n", - "%s(%d): No valid architecture\n", - "%s(%d): Object image has an invalid format\n", - "%s(%d): Invalid access (permissions?)\n", - "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n", - }; -#define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0])) - - switch (type) - { - case OFImage: - index = number; - if (index > NUM_OFI_ERRORS - 1) - index = NUM_OFI_ERRORS - 1; - error = Perl_form_nocontext(OFIErrorStrings[index], path, number); - break; - - default: - error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n", - path, number, type); - break; - } - Safefree(dl_last_error); - dl_last_error = savepv(error); -} - -static char *dlopen(char *path, int mode /* mode is ignored */) -{ - int dyld_result; - NSObjectFileImage ofile; - NSModule handle = NULL; - - dyld_result = NSCreateObjectFileImageFromFile(path, &ofile); - if (dyld_result != NSObjectFileImageSuccess) - TranslateError(path, OFImage, dyld_result); - else - { - // NSLinkModule will cause the run to abort on any link error's - // not very friendly but the error recovery functionality is limited. - handle = NSLinkModule(ofile, path, TRUE); - } - - return handle; -} - -void * -dlsym(handle, symbol) -void *handle; -char *symbol; -{ - void *addr; - - if (NSIsSymbolNameDefined(symbol)) - addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol)); - else - addr = NULL; - - return addr; -} - -#else /* NS_TARGET_MAJOR <= 3 */ - -static NXStream *OpenError(void) -{ - return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY); -} - -static void TransferError(NXStream *s) -{ - char *buffer; - int len, maxlen; - - if ( dl_last_error ) { - Safefree(dl_last_error); - } - NXGetMemoryBuffer(s, &buffer, &len, &maxlen); - New(1097, dl_last_error, len, char); - strcpy(dl_last_error, buffer); -} - -static void CloseError(NXStream *s) -{ - if ( s ) { - NXCloseMemory( s, NX_FREEBUFFER); - } -} - -static char *dlopen(char *path, int mode /* mode is ignored */) -{ - int rld_success; - NXStream *nxerr; - I32 i, psize; - char *result; - char **p; - STRLEN n_a; - - /* Do not load what is already loaded into this process */ - if (hv_fetch(dl_loaded_files, path, strlen(path), 0)) - return path; - - nxerr = OpenError(); - psize = AvFILL(dl_resolve_using) + 3; - p = (char **) safemalloc(psize * sizeof(char*)); - p[0] = path; - for(i=1; i<psize-1; i++) { - p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), n_a); - } - p[psize-1] = 0; - rld_success = rld_load(nxerr, (struct mach_header **)0, p, - (const char *) 0); - safefree((char*) p); - if (rld_success) { - result = path; - /* prevent multiple loads of same file into same process */ - hv_store(dl_loaded_files, path, strlen(path), &PL_sv_yes, 0); - } else { - TransferError(nxerr); - result = (char*) 0; - } - CloseError(nxerr); - return result; -} - -void * -dlsym(handle, symbol) -void *handle; -char *symbol; -{ - NXStream *nxerr = OpenError(); - unsigned long symref = 0; - - if (!rld_lookup(nxerr, Perl_form_nocontext("_%s", symbol), &symref)) - TransferError(nxerr); - CloseError(nxerr); - return (void*) symref; -} - -#endif /* NS_TARGET_MAJOR >= 4 */ - - -/* ----- code from dl_dlopen.xs below here ----- */ - - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); -} - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - - - -void * -dl_load_file(filename, flags=0) - char * filename - int flags - PREINIT: - int mode = 1; - CODE: - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); - if (flags & 0x01) - Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); - RETVAL = dlopen(filename, mode) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL) ); - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: -#if NS_TARGET_MAJOR >= 4 - symbolname = Perl_form_nocontext("_%s", symbolname); -#endif - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - "dl_find_symbol(handle=%lx, symbol=%s)\n", - (unsigned long) libhandle, symbolname)); - RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - " symbolref = %lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL) ); - - -void -dl_undef_symbols() - PPCODE: - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_none.xs b/contrib/perl5/ext/DynaLoader/dl_none.xs deleted file mode 100644 index 5a193e4..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_none.xs +++ /dev/null @@ -1,19 +0,0 @@ -/* dl_none.xs - * - * Stubs for platforms that do not support dynamic linking - */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -MODULE = DynaLoader PACKAGE = DynaLoader - -char * -dl_error() - CODE: - RETVAL = "Not implemented"; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_vmesa.xs b/contrib/perl5/ext/DynaLoader/dl_vmesa.xs deleted file mode 100644 index 8595e44..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_vmesa.xs +++ /dev/null @@ -1,175 +0,0 @@ -/* dl_vmesa.xs - * - * Platform: VM/ESA, possibly others which use dllload etc. - * Author: Neale Ferguson (neale@mailbox.tabnsw.com.au) - * Created: 23rd Septemer, 1998 - * - * - */ - -/* Porting notes: - - - Definition of VM/ESA dynamic Linking functions - ============================================== - In order to make this implementation easier to understand here is a - quick definition of the VM/ESA Dynamic Linking functions which are - used here. - - dlopen - ------ - void * - dlopen(const char *path) - - This function takes the name of a dynamic object file and returns - a descriptor which can be used by dlsym later. It returns NULL on - error. - - - dllsym - ------ - void * - dlsym(void *handle, char *symbol) - - Takes the handle returned from dlopen and the name of a symbol to - get the address of. If the symbol was found a pointer is - returned. It returns NULL on error. - - dlerror - ------- - char * dlerror() - - Returns a null-terminated string which describes the last error - that occurred with the other dll functions. After each call to - dlerror the error message will be reset to a null pointer. The - SaveError function is used to save the error as soo as it happens. - - - Return Types - ============ - In this implementation the two functions, dl_load_file & - dl_find_symbol, return void *. This is because the underlying SunOS - dynamic linker calls also return void *. This is not necessarily - the case for all architectures. For example, some implementation - will want to return a char * for dl_load_file. - - If void * is not appropriate for your architecture, you will have to - change the void * to whatever you require. If you are not certain of - how Perl handles C data types, I suggest you start by consulting - Dean Roerich's Perl 5 API document. Also, have a look in the typemap - file (in the ext directory) for a fairly comprehensive list of types - that are already supported. If you are completely stuck, I suggest you - post a message to perl5-porters, comp.lang.perl.misc or if you are really - desperate to me. - - Remember when you are making any changes that the return value from - dl_load_file is used as a parameter in the dl_find_symbol - function. Also the return value from find_symbol is used as a parameter - to install_xsub. - - - Dealing with Error Messages - ============================ - In order to make the handling of dynamic linking errors as generic as - possible you should store any error messages associated with your - implementation with the StoreError function. - - In the case of VM/ESA the function dlerror returns the error message - associated with the last dynamic link error. As the VM/ESA dynamic - linker functions return NULL on error every call to a VM/ESA dynamic - dynamic link routine is coded like this - - RETVAL = dlopen(filename) ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - - Note that SaveError() takes a printf format string. Use a "%s" as - the first parameter if the error may contain and % characters. - -*/ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include <dll.h> - - -#include "dlutils.c" /* SaveError() etc */ - - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); -} - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - - -void * -dl_load_file(filename, flags=0) - char * filename - int flags - CODE: - if (flags & 0x01) - Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); - RETVAL = dlopen(filename) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL) ); - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - "dl_find_symbol(handle=%lx, symbol=%s)\n", - (unsigned long) libhandle, symbolname)); - RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2, PerlIO_printf(Perl_debug_log, - " symbolref = %lx\n", (unsigned long) RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%s",dlerror()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL) ); - - -void -dl_undef_symbols() - PPCODE: - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n", - perl_name, (unsigned long) symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_vms.xs b/contrib/perl5/ext/DynaLoader/dl_vms.xs deleted file mode 100644 index d7a1f86..0000000 --- a/contrib/perl5/ext/DynaLoader/dl_vms.xs +++ /dev/null @@ -1,367 +0,0 @@ -/* dl_vms.xs - * - * Platform: OpenVMS, VAX or AXP - * Author: Charles Bailey bailey@newman.upenn.edu - * Revised: 12-Dec-1994 - * - * Implementation Note - * This section is added as an aid to users and DynaLoader developers, in - * order to clarify the process of dynamic linking under VMS. - * dl_vms.xs uses the supported VMS dynamic linking call, which allows - * a running program to map an arbitrary file of executable code and call - * routines within that file. This is done via the VMS RTL routine - * lib$find_image_symbol, whose calling sequence is as follows: - * status = lib$find_image_symbol(imgname,symname,symval,defspec); - * where - * status = a standard VMS status value (unsigned long int) - * imgname = a fixed-length string descriptor, passed by - * reference, containing the NAME ONLY of the image - * file to be mapped. An attempt will be made to - * translate this string as a logical name, so it may - * not contain any characters which are not allowed in - * logical names. If no translation is found, imgname - * is used directly as the name of the image file. - * symname = a fixed-length string descriptor, passed by - * reference, containing the name of the routine - * to be located. - * symval = an unsigned long int, passed by reference, into - * which is written the entry point address of the - * routine whose name is specified in symname. - * defspec = a fixed-length string descriptor, passed by - * reference, containing a default file specification - * whichis used to fill in any missing parts of the - * image file specification after the imgname argument - * is processed. - * In order to accommodate the handling of the imgname argument, the routine - * dl_expandspec() is provided for use by perl code (e.g. dl_findfile) - * which wants to see what image file lib$find_image_symbol would use if - * it were passed a given file specification. The file specification passed - * to dl_expandspec() and dl_load_file() can be partial or complete, and can - * use VMS or Unix syntax; these routines perform the necessary conversions. - * In general, writers of perl extensions need only conform to the - * procedures set out in the DynaLoader documentation, and let the details - * be taken care of by the routines here and in DynaLoader.pm. If anyone - * comes across any incompatibilities, please let me know. Thanks. - * - */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include "dlutils.c" /* dl_debug, LastError; SaveError not used */ - -static AV *dl_require_symbols = Nullav; - -/* N.B.: - * dl_debug and LastError are static vars; you'll need to deal - * with them appropriately if you need context independence - */ - -#include <descrip.h> -#include <fscndef.h> -#include <lib$routines.h> -#include <rms.h> -#include <ssdef.h> -#include <starlet.h> - -#if defined(VMS_WE_ARE_CASE_SENSITIVE) -#define DL_CASE_SENSITIVE 1<<4 -#else -#define DL_CASE_SENSITIVE 0 -#endif - -typedef unsigned long int vmssts; - -struct libref { - struct dsc$descriptor_s name; - struct dsc$descriptor_s defspec; -}; - -/* Static data for dl_expand_filespec() - This is static to save - * initialization on each call; if you need context-independence, - * just make these auto variables in dl_expandspec() and dl_load_file() - */ -static char dlesa[NAM$C_MAXRSS], dlrsa[NAM$C_MAXRSS]; -static struct FAB dlfab; -static struct NAM dlnam; - -/* $PutMsg action routine - records error message in LastError */ -static vmssts -copy_errmsg(msg,unused) - struct dsc$descriptor_s * msg; - vmssts unused; -{ - if (*(msg->dsc$a_pointer) == '%') { /* first line */ - if (LastError) - strncpy((LastError = saferealloc(LastError,msg->dsc$w_length+1)), - msg->dsc$a_pointer, msg->dsc$w_length); - else - strncpy((LastError = safemalloc(msg->dsc$w_length+1)), - msg->dsc$a_pointer, msg->dsc$w_length); - LastError[msg->dsc$w_length] = '\0'; - } - else { /* continuation line */ - int errlen = strlen(LastError); - LastError = saferealloc(LastError, errlen + msg->dsc$w_length + 2); - LastError[errlen] = '\n'; LastError[errlen+1] = '\0'; - strncat(LastError, msg->dsc$a_pointer, msg->dsc$w_length); - LastError[errlen+msg->dsc$w_length+1] = '\0'; - } - return 0; -} - -/* Use $PutMsg to retrieve error message for failure status code */ -static void -dl_set_error(sts,stv) - vmssts sts; - vmssts stv; -{ - vmssts vec[3]; - dTHX; - - vec[0] = stv ? 2 : 1; - vec[1] = sts; vec[2] = stv; - _ckvmssts(sys$putmsg(vec,copy_errmsg,0,0)); -} - -static unsigned int -findsym_handler(void *sig, void *mech) -{ - dTHX; - unsigned long int myvec[8],args, *usig = (unsigned long int *) sig; - /* Be paranoid and assume signal vector passed in might be readonly */ - myvec[0] = args = usig[0] > 10 ? 9 : usig[0] - 1; - while (--args) myvec[args] = usig[args]; - _ckvmssts(sys$putmsg(myvec,copy_errmsg,0,0)); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "findsym_handler: received\n\t%s\n",LastError)); - return SS$_CONTINUE; -} - -/* wrapper for lib$find_image_symbol, so signalled errors can be saved - * for dl_error and then returned */ -static unsigned long int -my_find_image_symbol(struct dsc$descriptor_s *imgname, - struct dsc$descriptor_s *symname, - void (**entry)(), - struct dsc$descriptor_s *defspec) -{ - unsigned long int retsts; - VAXC$ESTABLISH(findsym_handler); - retsts = lib$find_image_symbol(imgname,symname,entry,defspec,DL_CASE_SENSITIVE); - return retsts; -} - - -static void -dl_private_init(pTHX) -{ - dl_generic_private_init(aTHX); - dl_require_symbols = get_av("DynaLoader::dl_require_symbols", 0x4); - /* Set up the static control blocks for dl_expand_filespec() */ - dlfab = cc$rms_fab; - dlnam = cc$rms_nam; - dlfab.fab$l_nam = &dlnam; - dlnam.nam$l_esa = dlesa; - dlnam.nam$b_ess = sizeof dlesa; - dlnam.nam$l_rsa = dlrsa; - dlnam.nam$b_rss = sizeof dlrsa; -} -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - -void -dl_expandspec(filespec) - char * filespec - CODE: - char vmsspec[NAM$C_MAXRSS], defspec[NAM$C_MAXRSS]; - size_t deflen; - vmssts sts; - - tovmsspec(filespec,vmsspec); - dlfab.fab$l_fna = vmsspec; - dlfab.fab$b_fns = strlen(vmsspec); - dlfab.fab$l_dna = 0; - dlfab.fab$b_dns = 0; - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_expand_filespec(%s):\n",vmsspec)); - /* On the first pass, just parse the specification string */ - dlnam.nam$b_nop = NAM$M_SYNCHK; - sts = sys$parse(&dlfab); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tSYNCHK sys$parse = %d\n",sts)); - if (!(sts & 1)) { - dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); - ST(0) = &PL_sv_undef; - } - else { - /* Now set up a default spec - everything but the name */ - deflen = dlnam.nam$l_name - dlesa; - memcpy(defspec,dlesa,deflen); - memcpy(defspec+deflen,dlnam.nam$l_type, - dlnam.nam$b_type + dlnam.nam$b_ver); - deflen += dlnam.nam$b_type + dlnam.nam$b_ver; - memcpy(vmsspec,dlnam.nam$l_name,dlnam.nam$b_name); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsplit filespec: name = %.*s, default = %.*s\n", - dlnam.nam$b_name,vmsspec,deflen,defspec)); - /* . . . and go back to expand it */ - dlnam.nam$b_nop = 0; - dlfab.fab$l_dna = defspec; - dlfab.fab$b_dns = deflen; - dlfab.fab$b_fns = dlnam.nam$b_name; - sts = sys$parse(&dlfab); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tname/default sys$parse = %d\n",sts)); - if (!(sts & 1)) { - dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); - ST(0) = &PL_sv_undef; - } - else { - /* Now find the actual file */ - sts = sys$search(&dlfab); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsys$search = %d\n",sts)); - if (!(sts & 1)) { - dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); - ST(0) = &PL_sv_undef; - } - else { - ST(0) = sv_2mortal(newSVpvn(dlnam.nam$l_rsa,dlnam.nam$b_rsl)); - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "\tresult = \\%.*s\\\n", - dlnam.nam$b_rsl,dlnam.nam$l_rsa)); - } - } - } - -void -dl_load_file(filespec, flags) - char * filespec - int flags - PREINIT: - dTHX; - char vmsspec[NAM$C_MAXRSS]; - SV *reqSV, **reqSVhndl; - STRLEN deflen; - struct dsc$descriptor_s - specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}, - symdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; - struct fscnlst { - unsigned short int len; - unsigned short int code; - char *string; - } namlst[2] = {{0,FSCN$_NAME,0},{0,0,0}}; - struct libref *dlptr; - vmssts sts, failed = 0; - void (*entry)(); - CODE: - - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filespec,flags)); - specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec); - specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tVMS-ified filespec is %s\n", - specdsc.dsc$a_pointer)); - New(1399,dlptr,1,struct libref); - dlptr->name.dsc$b_dtype = dlptr->defspec.dsc$b_dtype = DSC$K_DTYPE_T; - dlptr->name.dsc$b_class = dlptr->defspec.dsc$b_class = DSC$K_CLASS_S; - sts = sys$filescan(&specdsc,namlst,0); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsys$filescan: returns %d, name is %.*s\n", - sts,namlst[0].len,namlst[0].string)); - if (!(sts & 1)) { - failed = 1; - dl_set_error(sts,0); - } - else { - dlptr->name.dsc$w_length = namlst[0].len; - dlptr->name.dsc$a_pointer = savepvn(namlst[0].string,namlst[0].len); - dlptr->defspec.dsc$w_length = specdsc.dsc$w_length - namlst[0].len; - New(1097, dlptr->defspec.dsc$a_pointer, dlptr->defspec.dsc$w_length + 1, char); - deflen = namlst[0].string - specdsc.dsc$a_pointer; - memcpy(dlptr->defspec.dsc$a_pointer,specdsc.dsc$a_pointer,deflen); - memcpy(dlptr->defspec.dsc$a_pointer + deflen, - namlst[0].string + namlst[0].len, - dlptr->defspec.dsc$w_length - deflen); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlibref = name: %s, defspec: %.*s\n", - dlptr->name.dsc$a_pointer, - dlptr->defspec.dsc$w_length, - dlptr->defspec.dsc$a_pointer)); - if (!(reqSVhndl = av_fetch(dl_require_symbols,0,FALSE)) || !(reqSV = *reqSVhndl)) { - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\t@dl_require_symbols empty, returning untested libref\n")); - } - else { - symdsc.dsc$w_length = SvCUR(reqSV); - symdsc.dsc$a_pointer = SvPVX(reqSV); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\t$dl_require_symbols[0] = %.*s\n", - symdsc.dsc$w_length, symdsc.dsc$a_pointer)); - sts = my_find_image_symbol(&(dlptr->name),&symdsc, - &entry,&(dlptr->defspec)); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlib$find_image_symbol returns %d\n",sts)); - if (!(sts&1)) { - failed = 1; - dl_set_error(sts,0); - } - } - } - - if (failed) { - Safefree(dlptr->name.dsc$a_pointer); - Safefree(dlptr->defspec.dsc$a_pointer); - Safefree(dlptr); - ST(0) = &PL_sv_undef; - } - else { - ST(0) = sv_2mortal(newSViv(PTR2IV(dlptr))); - } - - -void -dl_find_symbol(librefptr,symname) - void * librefptr - SV * symname - CODE: - struct libref thislib = *((struct libref *)librefptr); - struct dsc$descriptor_s - symdsc = {SvCUR(symname),DSC$K_DTYPE_T,DSC$K_CLASS_S,SvPVX(symname)}; - void (*entry)(); - vmssts sts; - - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_find_dymbol(%.*s,%.*s):\n", - thislib.name.dsc$w_length, thislib.name.dsc$a_pointer, - symdsc.dsc$w_length,symdsc.dsc$a_pointer)); - sts = my_find_image_symbol(&(thislib.name),&symdsc, - &entry,&(thislib.defspec)); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlib$find_image_symbol returns %d\n",sts)); - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tentry point is %d\n", - (unsigned long int) entry)); - if (!(sts & 1)) { - /* error message already saved by findsym_handler */ - ST(0) = &PL_sv_undef; - } - else ST(0) = sv_2mortal(newSViv(PTR2IV(entry))); - - -void -dl_undef_symbols() - PPCODE: - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/contrib/perl5/ext/DynaLoader/dlutils.c b/contrib/perl5/ext/DynaLoader/dlutils.c deleted file mode 100644 index 9d88f5f..0000000 --- a/contrib/perl5/ext/DynaLoader/dlutils.c +++ /dev/null @@ -1,106 +0,0 @@ -/* dlutils.c - handy functions and definitions for dl_*.xs files - * - * Currently this file is simply #included into dl_*.xs/.c files. - * It should really be split into a dlutils.h and dlutils.c - * - * Modified: - * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd - * files when the interpreter exits - */ - - -/* pointer to allocated memory for last error message */ -static char *LastError = (char*)NULL; - -/* flag for immediate rather than lazy linking (spots unresolved symbol) */ -static int dl_nonlazy = 0; - -#ifdef DL_LOADONCEONLY -static HV *dl_loaded_files = Nullhv; /* only needed on a few systems */ -#endif - - -#ifdef DEBUGGING -static int dl_debug = 0; /* value copied from $DynaLoader::dl_debug */ -#define DLDEBUG(level,code) if (dl_debug>=level) { code; } -#else -#define DLDEBUG(level,code) -#endif - - -/* Close all dlopen'd files */ -static void -dl_unload_all_files(pTHXo_ void *unused) -{ - CV *sub; - AV *dl_librefs; - SV *dl_libref; - - if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) { - dl_librefs = get_av("DynaLoader::dl_librefs", FALSE); - while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) { - dSP; - ENTER; - SAVETMPS; - PUSHMARK(SP); - XPUSHs(sv_2mortal(dl_libref)); - PUTBACK; - call_sv((SV*)sub, G_DISCARD | G_NODEBUG); - FREETMPS; - LEAVE; - } - } -} - - -static void -dl_generic_private_init(pTHXo) /* called by dl_*.xs dl_private_init() */ -{ - char *perl_dl_nonlazy; -#ifdef DEBUGGING - SV *sv = get_sv("DynaLoader::dl_debug", 0); - dl_debug = sv ? SvIV(sv) : 0; -#endif - if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL ) - dl_nonlazy = atoi(perl_dl_nonlazy); - if (dl_nonlazy) - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n")); -#ifdef DL_LOADONCEONLY - if (!dl_loaded_files) - dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */ -#endif -#ifdef DL_UNLOAD_ALL_AT_EXIT - call_atexit(&dl_unload_all_files, (void*)0); -#endif -} - - -/* SaveError() takes printf style args and saves the result in LastError */ -static void -SaveError(pTHXo_ char* pat, ...) -{ - va_list args; - SV *msv; - char *message; - STRLEN len; - - /* This code is based on croak/warn, see mess() in util.c */ - - va_start(args, pat); - msv = vmess(pat, &args); - va_end(args); - - message = SvPV(msv,len); - len++; /* include terminating null char */ - - /* Allocate some memory for the error message */ - if (LastError) - LastError = (char*)saferealloc(LastError, len) ; - else - LastError = (char *) safemalloc(len) ; - - /* Copy message into LastError (including terminating null char) */ - strncpy(LastError, message, len) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",LastError)); -} - diff --git a/contrib/perl5/ext/DynaLoader/hints/aix.pl b/contrib/perl5/ext/DynaLoader/hints/aix.pl deleted file mode 100644 index d4231cc..0000000 --- a/contrib/perl5/ext/DynaLoader/hints/aix.pl +++ /dev/null @@ -1,14 +0,0 @@ -# See dl_aix.xs for details. -use Config; -if ($Config{libs} =~ /-lC/ && -f '/lib/libC.a') { - $self->{CCFLAGS} = $Config{ccflags} . ' -DUSE_libC'; - if (-f '/usr/vacpp/include/load.h') { - $self->{CCFLAGS} .= ' -DUSE_vacpp_load_h'; - } elsif (-f '/usr/ibmcxx/include/load.h') { - $self->{CCFLAGS} .= ' -DUSE_ibmcxx_load_h'; - } elsif (-f '/usr/lpp/xlC/include/load.h') { - $self->{CCFLAGS} .= ' -DUSE_xlC_load_h'; - } elsif (-f '/usr/include/load.h') { - $self->{CCFLAGS} .= ' -DUSE_load_h'; - } -} diff --git a/contrib/perl5/ext/DynaLoader/hints/linux.pl b/contrib/perl5/ext/DynaLoader/hints/linux.pl deleted file mode 100644 index 06f4f4c..0000000 --- a/contrib/perl5/ext/DynaLoader/hints/linux.pl +++ /dev/null @@ -1,4 +0,0 @@ -# XXX Configure test needed. -# Some Linux releases like to hide their <nlist.h> -$self->{CCFLAGS} = $Config{ccflags} . ' -I/usr/include/libelf' - if -f "/usr/include/libelf/nlist.h"; diff --git a/contrib/perl5/ext/DynaLoader/hints/netbsd.pl b/contrib/perl5/ext/DynaLoader/hints/netbsd.pl deleted file mode 100644 index a0fbaf7..0000000 --- a/contrib/perl5/ext/DynaLoader/hints/netbsd.pl +++ /dev/null @@ -1,3 +0,0 @@ -# XXX Configure test needed? -# Some NetBSDs seem to have a dlopen() that won't accept relative paths -$self->{CCFLAGS} = $Config{ccflags} . ' -DDLOPEN_WONT_DO_RELATIVE_PATHS'; diff --git a/contrib/perl5/ext/DynaLoader/hints/openbsd.pl b/contrib/perl5/ext/DynaLoader/hints/openbsd.pl deleted file mode 100644 index aeaa92c..0000000 --- a/contrib/perl5/ext/DynaLoader/hints/openbsd.pl +++ /dev/null @@ -1,3 +0,0 @@ -# XXX Configure test needed? -# Some OpenBSDs seem to have a dlopen() that won't accept relative paths -$self->{CCFLAGS} = $Config{ccflags} . ' -DDLOPEN_WONT_DO_RELATIVE_PATHS'; |
