

Hello everybody,

There's been a fair amount of discussion over the months regarding
dynamic loading of C subroutines into a running Perl. I've decided
to post this to

    (1) show that it _is_ possible, and
    (2) provide a set of starting blocks for a proper implementation

Please read carefully the comments at the start of the README file.
This is not production quality code, but I don't have the time or
the motivation to work on it at present. I will not be supporting it
as I do Oraperl. However, it does work (at least on my system, an
Encore Multimax running UMAX V (Sys V.3 based)).

This requires the dynload(3x) dynamic loading interface, but it could
be a starting point for other implementations (for example, GNU's DLD).

The nicest thing about this is that it interacts correctly with existing
usersubs. I have used it to dynamically load in the Oracle and Curses
subroutines (both in the same script) without any changes to either, or
to the script (other than the loading requests, obviously).

	Kevin
	[email-masked]

#!/bin/sh
# This is a shell archive (shar 3.47)
# made 10/08/1992 08:55 UTC by kstock@isfrance
# Source directory /wp/users/kstock/tmp
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#    480 -rw-r--r-- Makefile
#   3509 -rw-r--r-- README
#   5141 -rw-r--r-- dl.mus
#   1490 -rw-r--r-- dlperl.1
#   1513 -rw-r--r-- dltest.mus
#    203 -rwxr-xr-x dltest.pl
#
# ============= Makefile ==============
if test -f 'Makefile' -a X"$1" != X"-c"; then
	echo 'x - skipping Makefile (File already exists)'
else
echo 'x - extracting Makefile (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'Makefile' &&
X# Makefile for dlperl and dltest.o
X#
X
XSRC = /usr/soft/public/perl
XGLOBINCS = 
XLOCINCS = 
XLIBS = `. $(SRC)/config.sh; echo $$libs` -lld
X
XCFLAGS = -O -I$(SRC)
X
Xall:	dlperl dltest.o
X
Xtest:	all
X	dltest.pl
X
Xdlperl: $(SRC)/uperl.o dl.o
X	cc $(SRC)/uperl.o dl.o $(LIBS) -o dlperl
X
Xdl.c: dl.mus
X	$(SRC)/usub/mus dl.mus >dl.c
X
Xdltest.c:	dltest.mus
X	$(SRC)/usub/mus dltest.mus >dltest.c
X
Xclean:
X	rm -f dl.c dltest.c dl.o core nohup.out PRINT
X
Xrealclean clobber:	clean
X	rm -f dlperl dltest.o
SHAR_EOF
chmod 0644 Makefile ||
echo 'restore of Makefile failed'
Wc_c="`wc -c < 'Makefile'`"
test 480 -eq "$Wc_c" ||
	echo 'Makefile: original size 480, current size' "$Wc_c"
fi
# ============= README ==============
if test -f 'README' -a X"$1" != X"-c"; then
	echo 'x - skipping README (File already exists)'
else
echo 'x - extracting README (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'README' &&
X
X			IMPORTANT NOTICE
X			================
X
X1.  This package (dlperl) is NOT production quality code. I wrote it in
X    December 1991 as an experiment, and was pleased to find that it works,
X    but I have not put any effort into it since then.
X
X2.  This implementation relies on dynload(3x) which is available on the
X    Encore Multimax running UMAX V. I don't know whether dynload() is a
X    standard. In particular, this code does _not_ work with GNU's DLD.
X    If your system doesn't have dynload, then don't even imagine that
X    you'll be able to get this running without a lot of work (= rewriting
X    the whole thing).
X
X3.  While I would be happy to receive comments and improvements to this
X    code, I will NOT be supporting it as I do Oraperl. I have no plans
X    to maintain or upgrade this package.
X
XFor the above reasons, I am posting this only to comp.lang.perl. I don't
Xplan to release it to any of the sources groups, not even alt.sources,
Xso it won't be in the main archives, nor will I mail out copies.
X
XThe reason that I am releasing this is that there has been quite a bit of
Xdiscussion over the past few months debating whether some form of dynamic
Xloading would be possible with Perl. Here is the proof that it is! If this
Xcould be extended to use DLD and whatever other schemes of dynamic loading
Xare around, that would be a great service to the Perl community.
X
X	Kevin Stock
X	[email-masked]
X
X-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
X
XThis is a set of usersubs to implement dynamic function loading for Perl.
X
X
XThe files contained are:
X
X	README		this file
X	dlperl.1	manual page for dynamic loading
X	Makefile	building instructions
X	dl.mus		code for the dynamic loading usersubs
X	dltest.mus	code for a simple set of usersubs, for testing
X	dltest.pl	script to run the test
X
X
XUsage is simple. The usersubs should be written and compiled in the normal
Xway with the exception of the following points:
X
X	1)  the userinit() routine, which conventionally only calls
X	    init_*() is not required.
X	    
X	2)  instead of linking with uperl.o to create a new executable
X	    Perl, the routines should be linked into a single .o file,
X	    for example:
X
X		ld -r -o stuff.o gluestuff.o stufflib.o
X
X
XTo use this within a perl script, call &dynload() as follows:
X
X	&dynload('stuff.o', '-lcurses', '-lc');
X
XApart from the .o file, you must supply the names of any libraries which are
Xrequired to resolve external references. The "-lname" form may be used, in
Xwhich case &dynload() will look for libname.a in /lib and /usr/lib.
X
X
XIf the load is successful, the initialisation routine will be called
Xautomatically. As usual, this should declare the subroutines and variables
Xwhich are to be made visible to the Perl program. &dynload() requires that
Xthis initialisation function is called init_stuff(), "stuff" being the
Xbasename of the .o file.
X
XAs evidence that this works, I have done this with Oraperl. I linked the
XOracle routines into a single file as above, then loaded them and the
Xcurses routines into one of the standard Oraperl examples:
X
X	$ORACLE_HOME	= '/usr/soft/oracle';
X
X	@ORA_LIBS	= ("$ORACLE_HOME/rdbms/lib/libocic.a",
X			   "$ORACLE_HOME/rdbms/lib/osntab.o",
X			   "$ORACLE_HOME/rdbms/lib/libsqlnet.a",
X			   "$ORACLE_HOME/rdbms/lib/libora.a");
X
X	&dynload("oracle.o", @ORA_LIBS, '-lc');
X	&dynload("curses.o", '-lcurses', '-lc');
X
XApart from that, no other changes were required to the Oraperl routines,
Xthe curses routines, or the sample script.
SHAR_EOF
chmod 0644 README ||
echo 'restore of README failed'
Wc_c="`wc -c < 'README'`"
test 3509 -eq "$Wc_c" ||
	echo 'README: original size 3509, current size' "$Wc_c"
fi
# ============= dl.mus ==============
if test -f 'dl.mus' -a X"$1" != X"-c"; then
	echo 'x - skipping dl.mus (File already exists)'
else
echo 'x - extracting dl.mus (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'dl.mus' &&
X/* dlperl.mus
X *
X * This file contains routines to add dynamic loading to Perl
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X#include <syms.h>
X
Xint do_dynload();
Xchar *savestr();
XSYMENT *lookupsym();
X
Xenum usersubs {
X    US_dynload,
X};
X
Xstatic int usersub();
Xchar *malloc(), *find_aout(), *find_ofile(), *find_lib();
Xvoid cant_find();
X
Xint
Xinit_dl()
X{
X    make_usub("dynload",	US_dynload,	usersub, 	"dl.c");
X};
X  
X
Xuserinit()
X{
X	init_dl();
X}
X
X
Xstatic int
Xusersub(ix, sp, items)
Xint ix;
Xregister int sp;
Xregister int items;
X{
X    STR **st = stack->ary_array + sp;
X    register int i;
X    register STR *Str;		/* used in str_get and str_gnum macros */
X
X    switch (ix) {
X
X    case US_dynload:
X	if (items == 0)
X	    fatal("Usage: &dynload($o_file, [ $lib, ... ])");
X	else {
X	    char *o_file	= (char *) str_get(st[1]);
X	    char **libs		= (char **) malloc(items * sizeof(char *));
X	    char *tlib, *o_path;
X	    int retval;
X
X	    if ((o_path = find_ofile(o_file)) == NULL)
X	    {
X		cant_find(o_file, "@INC");
X		/* NOTREACHED */
X	    }
X
X	    if (libs == NULL)
X	    {
X		fatal("dynload: out of memory");
X	    }
X	    else
X	    {
X		for (i = 0 ; i < items - 1 ; i++)
X		{
X		    libs[i] = (char *) str_get(st[i+2]);
X
X		    if ((*libs[i] == '-') && (libs[i][1] == 'l'))
X		    {
X			if ((tlib = find_lib(&libs[i][2])) == NULL)
X			{
X			    cant_find(libs[i], "libraries");
X			    /* NOTREACHED */
X			}
X		        else if ((libs[i] = malloc(strlen(tlib) + 1)) == NULL)
X		        {
X			    fatal("dynload: out of memory");
X		        }
X		    	/* else */ strcpy(libs[i], tlib);
X		    }
X		}
X		libs[i] = NULL;
X
X		retval = do_dynload(o_path, libs);
X		free(libs);
X	    }
X
X	    str_numset(st[0], (double) retval);
X	}
X	return sp;
X
X    }
X
X    return sp;
X}
X
Xint do_dynload(o_file, libs)
Xchar *o_file, **libs;
X{
X	static int first_time = 1;
X	char *p, init[BUFSIZ], *loadaddr;
X	SYMENT *init_sym;
X
X	if (first_time)		/* initialise the symbol table */
X	{
X		char *aout_file;
X
X		first_time = 0;
X
X		if ((aout_file = find_aout(*origargv, getenv("PATH"))) == NULL)
X			cant_find(*origargv, "PATH");
X		else if (initsyms(aout_file) == 0)
X			fatal("dynload: unable to initialise symbol table");
X	}
X
X	if (dynload(o_file, &loadaddr, 0L, libs, 1) < 1)
X	{
X		fatal("dynamic loading errors");
X	}
X
X	/* work out what the initialisation function is called */
X
X	if (((p = strrchr(o_file, '.')) != NULL) &&
X	    (p[1] == 'o') && (p[2] == '\0'))
X	{
X		*p = '\0';
X	}
X
X	(p = strrchr(o_file, '/')) ? ++p : p = o_file;
X	sprintf(init, "_init_%s", p);
X
X	if ((init_sym = lookupsym(init)) == NULL)
X		cant_find(init, o_file);
X
X	/* We've found the initialisation routine; now call it */
X
X	(*(int()) init_sym->n_value)();
X	return 1;
X}
X
X
Xchar *find_aout(name, path)
Xchar *name, *path;
X{
X	int found = 0;
X	char *p, *q, buf[BUFSIZ], *mypath;
X
X	/* simple cases which don't require path search */
X
X	if ((name == NULL) || (*name == '\0'))
X		return(NULL);		/* nothing to look for	*/
X	else if (access(name, 0) == 0)
X		return(name);		/* in current directory	*/
X	else if ((*name == '/') || (path == NULL) || (*path == '\0'))
X		return(NULL);		/* no path to check	*/
X
X	/* search through the path for the file.
X	 * copy the path locally so we don't damage the environment
X	 */
X
X	if ((mypath = malloc(strlen(path) + 1)) == NULL)
X	{
X		sprintf(buf, "insufficient memory to find %s", name);
X		fatal(buf);
X	}
X
X	strcpy(mypath, path);
X	q = (*mypath == ':') ? &mypath[1] : mypath;
X
X	do
X	{
X		if ((p = strchr(q, ':')) != NULL)
X		{
X			*p = '\0';
X		}
X
X		sprintf(buf, "%s/%s", q, name);
X		if (access(buf, 0) == 0)
X		{
X			found = 1;
X			break;
X		}
X
X		if (p != NULL)
X		{
X			q = p + 1;
X		}
X	} while (p != NULL);
X
X	free(mypath);
X	return(found ? buf : NULL);
X}
X
X/* List of directories to be checked for libraries.
X *
X * There ought to be a better way of doing this, or at least something
X * at compile time to automatically configure this list.
X */
X
Xchar *lib_path[] =
X{
X	"/lib",
X	"/usr/lib",
X	"/local/lib",
X	"/usr/local/lib",
X	NULL,
X};
X
X
X/* Check directories in lib_path for a file libname.a
X * and return the full path name if found, NULL otherwise
X */
X
Xchar *find_lib(name)
Xchar *name;
X{
X	static char buf[BUFSIZ];
X	char **dir = lib_path;
X
X	while (*dir)
X	{
X		sprintf(buf, "%s/lib%s.a", *dir, name);
X		if (access(buf, 0) == 0)
X		{
X			return(buf);
X		}
X		++dir;
X	}
X	return(NULL);
X}
X
X/* find_ofile
X *
X * Searches though @INC in pursuit of the specified file.
X * Modified from the REQUIRE code in perl.c
X */
X
Xchar *find_ofile(name)
Xchar *name;
X{
X	int i, found;
X	static char buf[BUFSIZ];
X	ARRAY *ar;
X
X	if ((found = access(name, 0)) == 0)
X	{
X		/* file exists, absolute or relative to local directory */
X		strcpy(buf, name);
X	}
X	else if (*name == '/')
X	{
X		/* absolute path, doesn't exist */
X		found = -1;
X	}
X	else	    /* search through @INC for the file */
X	{
X		ar = stab_array(incstab);
X		for (i = 0; i <= ar->ary_fill; i++)
X		{
X			sprintf(buf, "%s/%s", str_get(afetch(ar,i,TRUE)), name);
X			if ((found = access(buf, 0)) == 0)
X			{
X				break;
X			}
X		}
X	}
X	return (found == 0) ? buf : NULL;
X}
X
Xvoid cant_find(file, where)
Xchar *file, *where;
X{
X	char buf[BUFSIZ];
X
X	sprintf(buf, "dynload: unable to locate %s in %s", file, where);
X	fatal(buf);
X}
SHAR_EOF
chmod 0644 dl.mus ||
echo 'restore of dl.mus failed'
Wc_c="`wc -c < 'dl.mus'`"
test 5141 -eq "$Wc_c" ||
	echo 'dl.mus: original size 5141, current size' "$Wc_c"
fi
# ============= dlperl.1 ==============
if test -f 'dlperl.1' -a X"$1" != X"-c"; then
	echo 'x - skipping dlperl.1 (File already exists)'
else
echo 'x - extracting dlperl.1 (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'dlperl.1' &&
X.TH DLPERL 1 "Encore France"
X.nh
X.ad
X.SH NAME
Xdlperl \- Perl with dynamic function loading 
X.SH SYNOPSIS
X\fB&dynload(\fIname\fB.o \fR[ \fB, \fIlibrary\fR ... ]\fB);\fR
X.SH DESCRIPTION
X\fBDlperl\fP is a version of \fIPerl\fP
Xwhich has been extended using the \fIusersubs\fP facility
Xto enable it to dynamically load user defined functions
Xat run time.
X
XThe user must specify a single object file (\fIname\fB.o\fR)
Xand zero or more \fIlibraries\fP
Xrequired to resolve any external references within it.
XIf \fIname\fB.o\fR does not begin with a `\fB/\fP',
X\fB&dynload\fP will look for it first in the current directory
Xthen in the directories defined by the \fI@INC\fP array
X(the same array as is used for \fIrequire\fP searches).
XA \fIlibrary\fP may be specified in the form \fB'-l\fIlibrary'\fR
Xused by \fIld(1)\fP;
Xin this case \fB&dynload\fP will look for the file \fBlib\fIlibrary\fB.a\fR
Xin the following directories:
X
X.in +5
X.nf
X/lib
X/usr/lib
X/local/lib
X/usr/local/lib
X.fi
X.in -5
X
XThe object file \fIname\fB.o\fR
Xmust be constructed in the normal manner for \fIPerl\fP usersubs.
XIn particular, it must contain a function named `\fBinit_\fIname\fR'
Xwhich declares the subroutines and/or variables for \fIPerl\fP.
XThis function will be called automatically by \fB&dynload\fP.
X
XIf the loading fails for any reason, a fatal error will result.
X.SH SEE ALSO
Xperl(1), dynload(3)
X.SH AUTHOR
XKevin Stock, Encore Computer SA
X.if t .ft CW
X<[email-masked], [email-masked]>
X.if t .ft P
SHAR_EOF
chmod 0644 dlperl.1 ||
echo 'restore of dlperl.1 failed'
Wc_c="`wc -c < 'dlperl.1'`"
test 1490 -eq "$Wc_c" ||
	echo 'dlperl.1: original size 1490, current size' "$Wc_c"
fi
# ============= dltest.mus ==============
if test -f 'dltest.mus' -a X"$1" != X"-c"; then
	echo 'x - skipping dltest.mus (File already exists)'
else
echo 'x - extracting dltest.mus (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'dltest.mus' &&
X/* dltest.mus
X *
X * This is a very simple set of usersubs to test the dynamic loading usersubs.
X */
X
X#include "EXTERN.h"
X#include "perl.h"
Xextern int wantarray;
X
Xchar *savestr();
X
Xstatic enum uservars {
X    UV_pow,
X};
X
Xstatic enum usersubs {
X    US_power,
X};
X
Xstatic	long	power();
Xstatic	int	pow;
X
Xstatic int usersub();
Xstatic int userset();
Xstatic int userval();
X
Xint
Xinit_dltest()
X{
X    struct ufuncs uf;
X    char *filename = "dltest.c";
X
X    uf.uf_set = userset;
X    uf.uf_val = userval;
X
X#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
X
X    MAGICVAR("pow",		UV_pow);
X
X    make_usub("power",		US_power,	usersub, filename);
X};
X
Xstatic int
Xusersub(ix, sp, items)
Xint ix;
Xregister int sp;
Xregister int items;
X{
X    STR **st = stack->ary_array + sp;
X    register int i;
X    register char *tmps;
X    register STR *Str;		/* used in str_get and str_gnum macros */
X
X    switch (ix) {
X
XCASE long power
XI	int	n
XEND
X
X    default:
X	fatal("Unimplemented user-defined subroutine");
X    }
X    return sp;
X}
X
Xstatic int
Xuserval(ix, str)
Xint ix;
XSTR *str;
X{
X    switch (ix) {
X    case UV_pow:
X	str_numset(str, (double) pow);
X        break;
X
X    default:
X        break;
X    }
X    return 0;
X}
X
Xstatic int
Xuserset(ix, str)
Xint ix;
XSTR *str;
X{
X    switch (ix) {
X    case UV_pow:
X        pow = (int) str_gnum(str);
X	break;
X
X    default:
X	break;
X    }
X    return 0;
X}
X
Xlong power(n)
Xlong n;
X{
X	int i = pow;
X	int tot = n;
X
X
X	if (i <= 0)
X	{
X		return(1);
X	}
X
X	while (--i)
X	{
X		tot *= n;
X	}
X	return(tot);
X}
SHAR_EOF
chmod 0644 dltest.mus ||
echo 'restore of dltest.mus failed'
Wc_c="`wc -c < 'dltest.mus'`"
test 1513 -eq "$Wc_c" ||
	echo 'dltest.mus: original size 1513, current size' "$Wc_c"
fi
# ============= dltest.pl ==============
if test -f 'dltest.pl' -a X"$1" != X"-c"; then
	echo 'x - skipping dltest.pl (File already exists)'
else
echo 'x - extracting dltest.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'dltest.pl' &&
X#!./dlperl
X
X&dynload('dltest.o');
X
Xsub test
X{
X	local($x) = @_;
X
X	$pow = $x;
X	print '$pow = ', $pow;
X	print '	&power(3) = ', &power(3), '; &power(5) = ', &power(5), "\n";
X}
X
X&test(2);
X&test(3);
X&test(5);
SHAR_EOF
chmod 0755 dltest.pl ||
echo 'restore of dltest.pl failed'
Wc_c="`wc -c < 'dltest.pl'`"
test 203 -eq "$Wc_c" ||
	echo 'dltest.pl: original size 203, current size' "$Wc_c"
fi
exit 0