/* Thanks! to Andreas Raab for the initial version of this file.
 *
 * Posixification, stuff for non-Linux Unices, miscellaneous reorganisation
 * and random inane comments by The Unixal Suspect: ian.piumarta@inria.fr
 *
 * Last edited: Tue Feb 23 15:05:03 1999 by piumarta (Ian Piumarta) on pingu


/* Notes:

1. Before loading the first shared library we implicitly load the executing
   program as the "null" library, allowing "intrinsic" functions to be
   called as named primitives.  (Normally these are primitives for plugin
   modules that are compiled and linked statically along with the
   Interpreter itself -- but hey, all the standard C libraries [and syscalls
   too] are there for you to play with: an _infinity_ of ways to generate
   "little process poops" called "core". ;^)

2. We explicitly look for a library XXX in the following places:

        ./XXX.so	./libXXX.so	./XXX
          XXX.so	  libXXX.so	  XXX

   The former three are a minor concession to incorrect LD_LIBRARY_PATH
   settings (which occur far too often [minor diatribe elided]), and more
   importantly for poor old SunOS -- whose dlopen() tends to explode when
   LD_LIBRARY_PATH is set ("stub interception failed", remember? ;^).

   (The optional "lib" prefix is probably a good idea, but I'm almost
   convinced that we should _enforce_ the ".so" suffix: my Emacs hangs
   Damoclean, poised to eradicate this thoroughly unwholesome herecy...)

3. Library names in the image are not qualified with a ".so" suffix, since
   this is meaningless on non-Unix platforms.
 */

#include "sq.h"
#include "sqVirtualMachine.h"

#include <dlfcn.h>
#include <sys/param.h>
#include <sys/stat.h>

#if !defined(RTLD_NOW)
# if defined(sun) && (defined(sparc) || defined(__sparc)) && (!defined(ECHRNG))
    /* From the SunOS4 manual pages:
         void *dlopen(path, mode)
         char *path; int mode;
            mode is an integer containing flags describing options to be
            applied to the opening and loading process - it is reserved for
            future expansion and must always have the value 1.
       Ho hum...
    */
#   define RTLD_NOW	1
# else
#   error: Your <dlfcn.h> forgot to define RTLD_NOW
# endif
#endif

#undef	DEBUG

#ifdef DEBUG
# define dprintf(ARGS) fprintf ARGS
#else
# define dprintf(ARGS)
#endif

#if !defined(NAME_MAX)
# if defined(FILENAME_MAX)
#   define NAME_MAX FILENAME_MAX
# else
#   define NAME_MAX 256		/* nobody has fewer than this */
# endif
#endif

typedef struct ModuleEntry {
  struct ModuleEntry *next;
  char		      name[NAME_MAX + 1];
  void		     *handle;
} ModuleEntry;

static ModuleEntry *squeakModule= NULL;	/* the running program */
static ModuleEntry *moduleList=   NULL;	/* linked list of shared libs */


/*  Lookup a module in the list by name.  Answer the module entry or 0
 *  if the module is not loaded.
 */
static ModuleEntry *findModuleEntryNamed(char *name)
{ 
  ModuleEntry *module;

  for (module= moduleList; module != 0; module= module->next)
    if (strcmp(module->name, name) == 0) return module;
  return NULL;
}


/*  Attempt to load the shared library named by the concatenation of prefix,
 *  moduleName and suffix.  Answer the new module entry, or 0 if the shared
 *  library could not be loaded.
 */
static void *tryLoading(char *prefix, char *moduleName, char *suffix)
{
  char libName[NAME_MAX + 32];	/* headroom for prefix/suffix */
  void *handle;

  sprintf(libName, "%s%s%s", prefix, moduleName, suffix);
  handle= dlopen(libName, RTLD_NOW);
  if (handle == 0) {
    /* to preserve the humour of Jitter hackers: try to differentiate
       between "file not found" and a genuine load error (which would be
       difficult to diagnose out of context) when the lib is in the CWD */
    struct stat buf;
    if ((strcmp(prefix,  "./") == 0) &&
	(strcmp(suffix, ".so") == 0) &&
	(stat(libName, &buf) == 0)) {
      /* insist on the error message: the shared lib really _is_ broken */
      fprintf(stderr, "%s\n", dlerror());
    }
  }
  else
    dprintf((stderr, "loaded:  %s\n", libName));
  return handle;
}


/*  Load the named module and push a corredponding entry onto the module
 *  list.  Answer the module entry, or 0 if the shared library could not be
 *  loaded.
 *  
 *  Note: this is extern, to permit the startup code to go grubbing for a
 *  runtime compiler (or whatever) by calling loadModEnt before interpret.
 */
ModuleEntry *loadModuleEntry(char *name)
{
  ModuleEntry *module;
  int ok;

  module= (ModuleEntry *)calloc(1, sizeof(ModuleEntry));
  strcpy(module->name, name);

  (/* these are ordered to permit a knowledgeable user
      to override a "system" library with one in the CWD */
   (module->handle= tryLoading(   "./", name, ".so")) ||
   (module->handle= tryLoading("./lib", name, ".so")) ||
   (module->handle= tryLoading(   "./", name,    "")) ||
   /* these are the normal cases: when LD_LIBRARY_PATH is not
      set they search /etc/ld.so.cache, /usr/lib and /lib */
   (module->handle= tryLoading(     "", name, ".so")) ||
   (module->handle= tryLoading(  "lib", name, ".so")) ||
   (module->handle= tryLoading(     "", name,    ""))
  );
  
  if (module->handle) {
    /* find module initialisation function `setInterpreter()' */
    void *fn;
    fn= dlsym(module->handle, "setInterpreter");
    if (fn) {
      VirtualMachine *proxy;
      proxy= sqGetInterpreterProxy();
      dprintf((stderr, "calling: setInterpreter=%p(vm=%p)\n", fn, proxy));
      ok= ((int (*) (VirtualMachine *))fn)(proxy);
      if (ok) {
	module->next= moduleList;
	moduleList= module;
	return module; /* success */
      } else
	dprintf((stderr, "setInterpreter failed\n"));
    } else {
      dprintf((stderr, "%s\n", dlerror()));
    }
  }
  /* failure */
  if (module->handle) dlclose(module->handle);
  free(module);
  return NULL;
}


/*  Primitive entry point from the Interpreter.  Answer the address of the
 *  given function in the given module.  Fail the primitive (setting
 *  successFlag to false) if the function cannot be found.
 */
int ioLoadExternalFunctionOfLengthFromModuleOfLength(
	int functionNameIndex, int functionNameLength,
	int moduleNameIndex, int moduleNameLength)
{
  int i;
  ModuleEntry *module;
  char name[NAME_MAX + 1];
  void *fn;

  if (moduleNameLength > NAME_MAX || functionNameLength > NAME_MAX)
    return success(false);

  if (!squeakModule) {
    dprintf((stderr, "loading: <intrinsics>\n"));
    squeakModule= (ModuleEntry *)calloc(1, sizeof(ModuleEntry));
    squeakModule->handle= dlopen(NULL, RTLD_NOW);
    if (!squeakModule->handle) dprintf((stderr, "%s\n", dlerror()));
  }

  if (moduleNameLength != 0) 
    {
      for (i= 0; i < moduleNameLength; ++i)
	name[i]= ((unsigned char *)moduleNameIndex)[i];
      name[moduleNameLength]= '\0';

      module= findModuleEntryNamed(name);

      if (!module) {
	/* new module */
	dprintf((stderr, "loading: %s\n", name));
	module= loadModuleEntry(name);
	if (!module) {
	  dprintf((stderr, "could not find library for module: %s\n", name));
	  return success(false);
	}
      }
    }
  else
    module= squeakModule;

  dprintf((stderr, "handle:  %p\n", module->handle));

  /* module has been found; load the function from it */
  for (i= 0; i < functionNameLength; ++i)
    name[i]= ((char *)functionNameIndex)[i];
  name[functionNameLength]= '\0';

  dprintf((stderr, "resolve: `%s'\n", name));

  fn= dlsym(module->handle, name);

  dprintf((stderr, "address: %p\n", fn));

  if (!fn) {
    dprintf((stderr, "%s\n", dlerror()));
    return success(false);
  }

  return (int)fn;
}