summaryrefslogtreecommitdiff
path: root/contrib/perl5/ext/DynaLoader
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/perl5/ext/DynaLoader')
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_dllload.xs189
-rw-r--r--contrib/perl5/ext/DynaLoader/dl_mac.xs137
-rw-r--r--contrib/perl5/ext/DynaLoader/hints/netbsd.pl3
3 files changed, 329 insertions, 0 deletions
diff --git a/contrib/perl5/ext/DynaLoader/dl_dllload.xs b/contrib/perl5/ext/DynaLoader/dl_dllload.xs
new file mode 100644
index 000000000000..fe6957ac200d
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_dllload.xs
@@ -0,0 +1,189 @@
+/* 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_mac.xs b/contrib/perl5/ext/DynaLoader/dl_mac.xs
new file mode 100644
index 000000000000..5f48139c56a0
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/dl_mac.xs
@@ -0,0 +1,137 @@
+/* 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/hints/netbsd.pl b/contrib/perl5/ext/DynaLoader/hints/netbsd.pl
new file mode 100644
index 000000000000..a0fbaf7d89ee
--- /dev/null
+++ b/contrib/perl5/ext/DynaLoader/hints/netbsd.pl
@@ -0,0 +1,3 @@
+# 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';
generated by cgit v1.2.3 (git 2.25.1) at 2025-08-06 10:33:22 +0000