This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
partial support for dynaloading on OS/390
authorPeter Prymmer <PPrymmer@factset.com>
Fri, 19 Jan 2001 18:12:05 +0000 (10:12 -0800)
committerJarkko Hietaniemi <jhi@iki.fi>
Sat, 20 Jan 2001 22:21:18 +0000 (22:21 +0000)
Message-ID: <Pine.OSF.4.10.10101191646420.61158-100000@aspara.forte.com>

p4raw-id: //depot/perl@8487

MANIFEST
Makefile.SH
ext/DynaLoader/dl_dllload.xs [new file with mode: 0644]
hints/os390.sh

index 4269c3c..8b0d0f4 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -176,6 +176,7 @@ ext/DynaLoader/README               Dynamic Loader notes and intro
 ext/DynaLoader/XSLoader_pm.PL  Simple XS Loader perl module
 ext/DynaLoader/dl_aix.xs       AIX implementation
 ext/DynaLoader/dl_beos.xs      BeOS implementation
+ext/DynaLoader/dl_dllload.xs   S/390 dllload() style implementation
 ext/DynaLoader/dl_dld.xs       GNU dld style implementation
 ext/DynaLoader/dl_dlopen.xs    BSD/SunOS4&5 dlopen() style implementation
 ext/DynaLoader/dl_dyld.xs      NeXT/Apple dyld implementation
index d0b5465..7a2ee11 100644 (file)
@@ -26,6 +26,7 @@ esac
 linklibperl='$(LIBPERL)'
 shrpldflags='$(LDDLFLAGS)'
 ldlibpth=''
+DPERL_EXTERNAL_GLOB='-DPERL_EXTERNAL_GLOB'
 case "$useshrplib" in
 true)
        # Prefix all runs of 'miniperl' and 'perl' with 
@@ -76,6 +77,10 @@ true)
        hpux*)
                linklibperl="-L `pwd | sed 's/\/UU$//'` -Wl,+s -Wl,+b$archlibexp/CORE -lperl"
                ;;
+       os390*)
+           linklibperl='libperl.x'
+           DPERL_EXTERNAL_GLOB=''
+           ;;
        esac
        case "$ldlibpthname" in
        '') ;;
@@ -300,17 +305,21 @@ utilities:        miniperl lib/Config.pm $(plextract) lib/lib.pm FORCE
 # Apparently some makes require an action for the FORCE target.
 FORCE:
        @sh -c true
+!NO!SUBS!
+$spitshell >>Makefile <<!GROK!THIS!
 
 # We do a copy of the op.c instead of a symlink because gcc gets huffy
 # if we have a symlink forest to another disk (it complains about too many
 # levels of symbolic links, even if we have only two)
 
-opmini$(OBJ_EXT): op.c config.h
-       $(RMS) opmini.c
-       $(CPS) op.c opmini.c
-       $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB opmini.c
-       $(RMS) opmini.c
+opmini\$(OBJ_EXT): op.c config.h
+       \$(RMS) opmini.c
+       \$(CPS) op.c opmini.c
+       \$(CCCMD) \$(PLDLFLAGS) $DPERL_EXTERNAL_GLOB opmini.c
+       \$(RMS) opmini.c
 
+!GROK!THIS!
+$spitshell >>Makefile <<'!NO!SUBS!'
 miniperlmain$(OBJ_EXT): miniperlmain.c patchlevel.h
        $(CCCMD) $(PLDLFLAGS) $*.c
 
diff --git a/ext/DynaLoader/dl_dllload.xs b/ext/DynaLoader/dl_dllload.xs
new file mode 100644 (file)
index 0000000..fe6957a
--- /dev/null
@@ -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.
index 7a69634..ee75172 100644 (file)
@@ -3,7 +3,8 @@
 # OS/390 hints by David J. Fiander <davidf@mks.com>
 #
 # OS/390 OpenEdition Release 3 Mon Sep 22 1997 thanks to:
-#     
+# 
+#     John Goodyear <johngood@us.ibm.com>
 #     John Pfuntner <pfuntner@vnet.ibm.com>
 #     Len Johnson <lenjay@ibm.net>
 #     Bud Huff  <BAHUFF@us.oracle.com>
@@ -42,27 +43,12 @@ case "$optimize" in
 '') optimize='none' ;;
 esac
 
-# ccdlflags have yet to be determined.
-#case "$ccdlflags" in
-#'') ccdlflags='-c' ;;
-#esac
-
 # To link via definition side decks we need the dll option
 # You can override this with Configure -Ucccdlflags or somesuch.
 case "$cccdlflags" in
-'') cccdlflags='-W 0,dll,"langlvl(extended)"' ;;
+'') cccdlflags='-W 0,dll' ;;
 esac
 
-# ldflags have yet to be determined.
-#case "$ldflags" in
-#'') ldflags='' ;;
-#esac
-
-# lddlflags have yet to be determined.
-#case "$lddlflags" in
-#'') lddlflags='' ;;
-#esac
-
 case "$so" in
 '') so='a' ;;
 esac
@@ -83,17 +69,41 @@ case "$usenm" in
 esac
 
 # Dynamic loading doesn't work on OS/390 quite yet.
-# You can override this with 
-#  Configure -Dusedl -Ddlext=.so -Ddlsrc=dl_dllload.xs.
+# However the easiest way to experiment with dynamic loading is with:
+#  Configure -Dusedl
+# You can even override some of this with things like:
+#  Configure -Dusedl -Ddlext=so -Ddlsrc=dl_dllload.xs.
 case "$usedl" in
-'') usedl='n' ;;
-esac
-case "$dlext" in
-'') dlext='none' ;;
-esac
-#case "$dlsrc" in
-#'') dlsrc='none' ;;
-#esac
+'')
+    usedl='n' 
+    case "$dlext" in
+    '') dlext='none' ;;
+    esac
+    ;;
+define)
+    case "$useshrplib" in
+    '') useshrplib='true' ;;
+    esac
+    case "$dlext" in
+    '') dlext='dll' ;;
+    esac
+    case "$dlsrc" in
+    '') dlsrc='dl_dllload.xs' ;;
+    esac
+    so='dll'
+    libperl='libperl.dll'
+    ccflags="$ccflags -D_SHR_ENVIRON -DPERL_EXTERNAL_GLOB -Wc,dll"
+    cccdlflags='-c -Wc,dll,EXPORTALL'
+    # You might add '-Wl,EDIT=NO' to get rid of the symbol
+    # information at the end of the executable.
+    #
+    # The following will need to be modified for the installed libperl.x
+    ccdlflags="-W l,dll `pwd`/libperl.x"
+    ldflags=''
+    lddlflags='-W l,dll'
+    ;;
+esac
+# even on static builds using LIBPATH should be OK.
 case "$ldlibpthname" in
 '') ldlibpthname=LIBPATH ;;
 esac