Feedback on dynamic loading for OSF/1
Sanjay Ghemawat
Hi,
About a week ago, I posted an implementation of the "load" command for
OSF/1 as suggested by John Ousterhout. Like an idiot I forgot to ask
people to tell me if they tested it on their systems.
So if you did test it, send me a line telling me whether or not it
worked. In case you missed the posting the first time around, a
shar file is appended to the end of this message. It contains
an automated test script.
Thanks,
-Sanjay
---- cut here ----
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: README Makefile is_osf1 tclLoad.c main.c bar.c foo.c
# testscript
# Wrapped by san...@thor.lcs.mit.edu on Mon Jul 26 15:56:41 1993
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(628 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
XThe following shar archive contains an implementation of dynamic
Xloading for OSF1 in response to the request for dynamic loading
Ximplementations by John Ousterhout. I have tested it on alphas
Xrunning "OSF1.2 BL 10". Please try it out on your system if possible.
X
XYou will need tcl7.0b1 or later releases of Tcl because the testing
Xprocess depends on the Tcl_AppInit() routine.
X
X1. Edit Makefile (fix definitions of TCLINCDIR and TCLLIBDIR).
X2. Build shared libraries and a dynamic loading tcl shell by executing "make".
X3. Test it by executing "make test". You should see a bunch of informational
X messages, but no errors.
END_OF_FILE
if test 628 -ne `wc -c <'README'`; then
echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test -f 'Makefile' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'Makefile'\"
else
echo shar: Extracting \"'Makefile'\" \(971 characters\)
sed "s/^X//" >'Makefile' <<'END_OF_FILE'
X##############################################################################
X# Configuration parameters
X
X# Set the following to the location of tcl.h
XTCLINCDIR = ./tcl7.0b1
X
X# Set the following to the location of the Tcl library (libtcl.a or libtcl.so)
XTCLLIBDIR = ./tcl7.0b1
X
X##############################################################################
X# Should not need to change anything below
X
XMKSHLIB = ld -shared -no_archive
XRM = rm -f
X
XCFLAGS = -g -I$(TCLINCDIR)
X
Xall: testload libfoo.so libbar.so
X
Xtestload: main.o tclLoad.o
X $(CC) $(CFLAGS) -o $@ main.o tclLoad.o -L$(TCLLIBDIR) -ltcl -lm -lc
X
Xlibfoo.so: foo.o
X $(MKSHLIB) -o $@ foo.o -L$(TCLLIBDIR) -ltcl -lm -lc
X
Xlibbar.so: bar.o
X $(MKSHLIB) -o $@ bar.o -L$(TCLLIBDIR) -ltcl -lm -lc
X
Xtest: testload libfoo.so libbar.so
X /bin/sh is_osf1
X testload testscript
X
Xclean:
X $(RM) testload *.o *.so so_locations SHAR
X
XSHAR: FORCE
X shar README Makefile is_osf1 tclLoad.c main.c bar.c foo.c testscript > SHAR
X
XFORCE:
END_OF_FILE
if test 971 -ne `wc -c <'Makefile'`; then
echo shar: \"'Makefile'\" unpacked with wrong size!
fi
# end of 'Makefile'
fi
if test -f 'is_osf1' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'is_osf1'\"
else
echo shar: Extracting \"'is_osf1'\" \(191 characters\)
sed "s/^X//" >'is_osf1' <<'END_OF_FILE'
X#!/bin/sh
X#
X# Return with exit status 0 iff system is running osf1.
X
Xif test -f /bin/uname; then
X SYSTEM=`/bin/uname`
X if test "$SYSTEM" = "OSF1"; then
X exit 0
X fi
X fi
Xexit 1
END_OF_FILE
if test 191 -ne `wc -c <'is_osf1'`; then
echo shar: \"'is_osf1'\" unpacked with wrong size!
fi
chmod +x 'is_osf1'
# end of 'is_osf1'
fi
if test -f 'tclLoad.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tclLoad.c'\"
else
echo shar: Extracting \"'tclLoad.c'\" \(4378 characters\)
sed "s/^X//" >'tclLoad.c' <<'END_OF_FILE'
X/*
X * tclLoad.c --
X *
X * Tcl support for dynamic loading of packages on OSF/1.
X */
X
X#ifndef lint
Xstatic char rcsid[] = "$Header$";
X#endif /* not lint */
X
X#include <ctype.h>
X#include <stdio.h>
X#include <string.h>
X#include <dlfcn.h>
X#include <tcl.h>
X
X/*
X * Type of initialization functions.
X */
Xtypedef int (*InitProcedure) _ANSI_ARGS_((Tcl_Interp* interp));
X
X/*
X * Internal procedures.
X */
Xstatic char* FunctionName _ANSI_ARGS_((char* loadfile));
Xstatic char* FixError _ANSI_ARGS_((char* error));
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_LoadCmd --
X *
X * This procedure is invoked to process the "load" Tcl command.
X * See the user documentation for details on what it does.
X *
X * Results:
X * A standard Tcl result.
X *
X * Side effects:
X * See the user documentation.
X *
X *----------------------------------------------------------------------
X */
X
X /* ARGSUSED */
Xint
XTcl_LoadCmd(dummy, interp, argc, argv)
X ClientData dummy; /* Not used. */
X Tcl_Interp *interp; /* Current interpreter. */
X int argc; /* Number of arguments. */
X char **argv; /* Argument strings. */
X{
X char *symbol;
X void *xlib;
X InitProcedure initializer;
X
X if (argc != 2) {
X Tcl_AppendResult(interp,
X "wrong # args: should be \"",
X argv[0],
X " file\"",
X (char *) NULL);
X return TCL_ERROR;
X }
X
X xlib = dlopen(argv[1], RTLD_LAZY);
X if (xlib == NULL) {
X char *result = FixError(dlerror());
X Tcl_AppendResult(interp, "load ", argv[1], ": ", result, (char*) NULL);
X ckfree(result);
X return TCL_ERROR;
X }
X
X symbol = FunctionName(argv[1]);
X initializer = (InitProcedure) dlsym(xlib, symbol);
X ckfree(symbol);
X
X if (initializer == 0) {
X char *result = FixError(dlerror());
X Tcl_AppendResult(interp, "load ", argv[1], ": ", result, (char*) NULL);
X dlclose(xlib);
X ckfree(result);
X return TCL_ERROR;
X }
X
X return (*initializer)(interp);
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * FunctionName
X *
X * Convert library name into initialization procedure name by
X * capitalizing the base name of the library and appending _Init.
X *
X * The base name of the library is obtained by removing all directory
X * components, any remaining prefix "lib", and everything onwards from
X * the first "." in the remaining string.
X *
X * Example -
X * dp.o ==> Dp_Init
X * libtk.a ==> Tk_Init
X * /usr/local/lib/libical.so ==> Ical_Init
X *
X * Results:
X * The returned string contains the name of the initialization
X * procedure. It is a dynamically allocated string and must
X * be freed by calling ckfree(result).
X *
X *----------------------------------------------------------------------
X */
Xstatic char* FunctionName(library)
X char *library;
X{
X char *start;
X char *finish;
X char *temp;
X int length;
X
X start = library;
X finish = library + strlen(library);
X
X /* Strip directory components */
X temp = strrchr(start, '/');
X if (temp != NULL) {
X start = temp+1;
X }
X
X /* Strip leading "lib" */
X if (strncmp(start, "lib", 3) == 0) {
X start += 3;
X }
X
X /* Strip everything from the first "." onwards */
X temp = strchr(start, '.');
X if (temp != NULL) {
X finish = temp;
X }
X
X /* New string */
X length = finish - start;
X temp = (char*) ckalloc(sizeof(char) * (length + strlen("_Init") + 1));
X strncpy(temp, start, length);
X strcpy(temp+length, "_Init");
X
X /* Upcase word */
X temp[0] = toupper(temp[0]);
X return temp;
X}
X
X/*
X *----------------------------------------------------------------------
X *
X * FixError
X *
X * Create approproate error message from error string.
X *
X * Results:
X * The returned string contains the error message.
X * It is a dynamically allocated string and must be freed by calling
X * ckfree(result).
X *
X *----------------------------------------------------------------------
X */
X
Xstatic char* FixError(error)
X char *error;
X{
X char *result;
X int error_length;
X
X if (error == 0) {
X error = "failure";
X error_length = strlen(error);
X }
X else {
X error_length = strlen(error);
X if ((error_length > 0) && (error[error_length-1] == '\n')) {
X /* Trim trailing newline */
X error_length--;
X }
X }
X
X result = (char*) malloc(sizeof(char) * (error_length + 1));
X strncpy(result, error, error_length);
X result[error_length] = '\0';
X
X return result;
X}
END_OF_FILE
if test 4378 -ne `wc -c <'tclLoad.c'`; then
echo shar: \"'tclLoad.c'\" unpacked with wrong size!
fi
# end of 'tclLoad.c'
fi
if test -f 'main.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'main.c'\"
else
echo shar: Extracting \"'main.c'\" \(3211 characters\)
sed "s/^X//" >'main.c' <<'END_OF_FILE'
X/*
X * tclAppInit.c --
X *
X * Provides a default version of the Tcl_AppInit procedure.
X *
X * Copyright (c) 1993 The Regents of the University of California.
X * All rights reserved.
X *
X * Permission is hereby granted, without written agreement and without
X * license or royalty fees, to use, copy, modify, and distribute this
X * software and its documentation for any purpose, provided that the
X * above copyright notice and the following two paragraphs appear in
X * all copies of this software.
X *
X * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
X * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
X * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
X * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
X *
X * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
X * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
X * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
X * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
X * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
X */
X
X/*
X * Hacked to provide dynamic loading.
X */
X
X#ifndef lint
Xstatic char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclAppInit.c,v 1.3 93/07/01 15:16:08 ouster Exp $ SPRITE (Berkeley)";
X#endif /* not lint */
X
X#include "tcl.h"
X
X/*
X * The variable below holds a startup script to be executed at the
X * beginning of the application.
X */
X
Xchar initCmd[] =
X"if [file exists [info library]/init.tcl] {\n\
X source [info library]/init.tcl\n\
X} else {\n\
X set msg \"can't find [info library]/init.tcl; perhaps you need to\\n\"\n\
X append msg \"install Tcl or set your TCL_LIBRARY environment \"\n\
X append msg \"variable?\"\n\
X error $msg\n\
X}";
X
X/*
X * The following variable is a special hack that allows applications
X * to be linked using the procedure "main" from the Tcl library. The
X * variable generates a reference to "main", which causes main to
X * be brought in from the library (and all of Tcl with it).
X */
X
Xextern int main();
Xint *tclDummyMainPtr = (int *) main;
X
X/*
X * The dynamic loading command.
X */
Xextern int Tcl_LoadCmd _ANSI_ARGS_((ClientData, Tcl_Interp*, int, char**));
X
X
X/*
X *----------------------------------------------------------------------
X *
X * Tcl_AppInit --
X *
X * This procedure performs application-specific initialization.
X * Most applications, especially those that incorporate additional
X * packages, will have their own version of this procedure.
X *
X * Results:
X * Returns a standard Tcl completion code, and leaves an error
X * message in interp->result if an error occurs.
X *
X * Side effects:
X * Depends on the startup script.
X *
X *----------------------------------------------------------------------
X */
X
Xint
XTcl_AppInit(interp)
X Tcl_Interp *interp; /* Interpreter for application. */
X{
X /*
X * Calls to init procedures for various included packages should
X * appear below, if there are any included packages:
X */
X Tcl_CreateCommand(interp, "load", Tcl_LoadCmd, 0, 0);
X
X /*
X * Execute a start-up script.
X */
X
X return Tcl_Eval(interp, initCmd);
X}
END_OF_FILE
if test 3211 -ne `wc -c <'main.c'`; then
echo shar: \"'main.c'\" unpacked with wrong size!
fi
# end of 'main.c'
fi
if test -f 'bar.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'bar.c'\"
else
echo shar: Extracting \"'bar.c'\" \(1090 characters\)
sed "s/^X//" >'bar.c' <<'END_OF_FILE'
X/*
X * Some simple minded procedures to test dynamic loading for Tcl.
X */
X
X#include <stdio.h>
X#include <tcl.h>
X
Xstatic int cmd1 _ANSI_ARGS_((ClientData, Tcl_Interp*, int, char**));
Xstatic int cmd2 _ANSI_ARGS_((ClientData, Tcl_Interp*, int, char**));
X
Xint Bar_Init(interp)
X Tcl_Interp* interp;
X{
X Tcl_CreateCommand(interp, "bar_cmd1", cmd1, 0, 0);
X Tcl_CreateCommand(interp, "bar_cmd2", cmd2, 0, 0);
X}
X
X/* ARGSUSED */
Xstatic int cmd1(data, interp, argc, argv)
X ClientData data;
X Tcl_Interp* interp;
X int argc;
X char* argv[];
X{
X int i;
X
X Tcl_AppendResult(interp, "running bar_cmd1", (char*) NULL);
X for (i = 1; i < argc; i++) {
X Tcl_AppendResult(interp, " ", argv[i], (char*) NULL);
X }
X
X return TCL_OK;
X}
X
X/* ARGSUSED */
Xstatic int cmd2(data, interp, argc, argv)
X ClientData data;
X Tcl_Interp* interp;
X int argc;
X char* argv[];
X{
X int i;
X
X Tcl_AppendResult(interp, "running bar_cmd2", (char*) NULL);
X for (i = 1; i < argc; i++) {
X Tcl_AppendResult(interp, " ", argv[i], (char*) NULL);
X }
X
X return TCL_OK;
X}
END_OF_FILE
if test 1090 -ne `wc -c <'bar.c'`; then
echo shar: \"'bar.c'\" unpacked with wrong size!
fi
# end of 'bar.c'
fi
if test -f 'foo.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'foo.c'\"
else
echo shar: Extracting \"'foo.c'\" \(1090 characters\)
sed "s/^X//" >'foo.c' <<'END_OF_FILE'
X/*
X * Some simple minded procedures to test dynamic loading for Tcl.
X */
X
X#include <stdio.h>
X#include <tcl.h>
X
Xstatic int cmd1 _ANSI_ARGS_((ClientData, Tcl_Interp*, int, char**));
Xstatic int cmd2 _ANSI_ARGS_((ClientData, Tcl_Interp*, int, char**));
X
Xint Foo_Init(interp)
X Tcl_Interp* interp;
X{
X Tcl_CreateCommand(interp, "foo_cmd1", cmd1, 0, 0);
X Tcl_CreateCommand(interp, "foo_cmd2", cmd2, 0, 0);
X}
X
X/* ARGSUSED */
Xstatic int cmd1(data, interp, argc, argv)
X ClientData data;
X Tcl_Interp* interp;
X int argc;
X char* argv[];
X{
X int i;
X
X Tcl_AppendResult(interp, "running foo_cmd1", (char*) NULL);
X for (i = 1; i < argc; i++) {
X Tcl_AppendResult(interp, " ", argv[i], (char*) NULL);
X }
X
X return TCL_OK;
X}
X
X/* ARGSUSED */
Xstatic int cmd2(data, interp, argc, argv)
X ClientData data;
X Tcl_Interp* interp;
X int argc;
X char* argv[];
X{
X int i;
X
X Tcl_AppendResult(interp, "running foo_cmd2", (char*) NULL);
X for (i = 1; i < argc; i++) {
X Tcl_AppendResult(interp, " ", argv[i], (char*) NULL);
X }
X
X return TCL_OK;
X}
END_OF_FILE
if test 1090 -ne `wc -c <'foo.c'`; then
echo shar: \"'foo.c'\" unpacked with wrong size!
fi
# end of 'foo.c'
fi
if test -f 'testscript' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'testscript'\"
else
echo shar: Extracting \"'testscript'\" \(1145 characters\)
sed "s/^X//" >'testscript' <<'END_OF_FILE'
X# Check that nothing is loaded
Xputs stdout " (checking initial state)"
Xif ![catch {foo_cmd1}] {
X error "foo: library is not being dynamically loaded"
X}
X
Xif ![catch {bar_cmd1}] {
X error "bar: library is not being dynamically loaded"
X}
X
X# Check that "foo" loads correctly
Xputs stdout " (loading foo)"
Xload ./libfoo.so
X
Xforeach cmd {
X {foo_cmd1}
X {foo_cmd1 x}
X {foo_cmd1 x y}
X {foo_cmd2}
X {foo_cmd2 a}
X {foo_cmd2 a b}
X} {
X puts stdout " (testing \"$cmd\")"
X set result [eval $cmd]
X if {$result != [concat running $cmd]} {
X error "$cmd: invalid result \"$result\""
X }
X}
X
X# Check that "bar" did not get loaded inadvertantly
Xif ![catch {bar_cmd1}] {
X error "bar: library was erroneously loaded with foo"
X}
X
X# Check that "bar" loads correctly
Xputs stdout " (loading bar)"
Xload ./libbar.so
X
Xforeach cmd {
X {bar_cmd1}
X {bar_cmd1 x}
X {bar_cmd1 x y}
X {bar_cmd2}
X {bar_cmd2 a}
X {bar_cmd2 a b}
X} {
X puts stdout " (testing \"$cmd\")"
X set result [eval $cmd]
X if {$result != [concat running $cmd]} {
X error "$cmd: invalid result \"$result\""
X }
X}
X
Xputs stdout "no errors occurred"
END_OF_FILE
if test 1145 -ne `wc -c <'testscript'`; then
echo shar: \"'testscript'\" unpacked with wrong size!
fi
# end of 'testscript'
fi
echo shar: End of shell archive.
exit 0