dynload.c 3.32 KB
Newer Older
eg's avatar
eg committed
1 2
/*
 * dynload.c	-- Dynamic loading stuff
3 4 5 6
 *
 * Copyright © 2000-2008 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
 *
 *
eg's avatar
eg committed
7 8 9 10
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
11
 *
eg's avatar
eg committed
12 13 14 15
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
16
 *
eg's avatar
eg committed
17 18
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
19
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
eg's avatar
eg committed
20
 * USA.
21
 *
eg's avatar
eg committed
22 23
 *           Author: Erick Gallesio [eg@kaolin.unice.fr]
 *    Creation date: 23-Jan-1994 19:09
24
 * Last file update:  2-May-2008 17:23 (eg)
eg's avatar
eg committed
25 26 27 28 29
 *
 */

#include "stklos.h"

30 31
#define INIT_FUNC_NAME "STk_module_main"
#define INFO_FUNC_NAME "STk_module_info"
eg's avatar
eg committed
32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52

#define INIT_FUNC_NAME_STRING(x) #x

#ifdef HAVE_DLOPEN
#  include <dlfcn.h>

#  ifdef RTLD_LAZY
#     define FLAG1 RTLD_LAZY
#  else
#     define FLAG1 1
#  endif

#  ifdef RTLD_GLOBAL
#    define FLAG2 RTLD_GLOBAL
#  else
#    define FLAG2 0
#  endif

#  define DYN_FLAG (FLAG1|FLAG2)

typedef void (*InitFunc)(void);
53
typedef SCM  (*InfoFunc)(void);
eg's avatar
eg committed
54 55 56 57



static SCM files_already_loaded = (SCM) NULL;
58
MUT_DECL(dynload_mutex);
eg's avatar
eg committed
59 60 61 62 63 64 65 66


static void initialize_dynload(void)
{
  void *handle;

  if ((handle = (void *) dlopen(NULL, DYN_FLAG)) == NULL)
    STk_error("cannot initialize dynamic loading system (%s)", dlerror());
67 68

  MUT_LOCK(dynload_mutex);
eg's avatar
eg committed
69
  files_already_loaded = LIST1(STk_cons(STk_Cstring2string(""), (SCM) handle));
70
  MUT_UNLOCK(dynload_mutex);
eg's avatar
eg committed
71 72 73
}


74
void *STk_find_external_function(char *path, char *fname, int error_if_absent)
eg's avatar
eg committed
75 76 77
{
  void *handle, *fct;
  SCM l;
78

eg's avatar
eg committed
79 80
  handle = fct = NULL;

81
  if (!files_already_loaded)
eg's avatar
eg committed
82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
    initialize_dynload();

  /* See if the file has already loaded. If so, use the old handle */
  for (l = files_already_loaded; !NULLP(l); l = CDR(l)) {
    /* An inline Assoc which knows that keys are well formed C strings */
    if (strcmp(STRING_CHARS(CAR(CAR(l))), path) == 0) {
      handle = (void *) CDR(CAR(l));
      break;
    }
  }

  if (!handle) {
    errno = 0;
    /* Not seen before => dynamically load the file and enter its handle in cache */
    if ((handle=(void *) dlopen(path, DYN_FLAG)) == NULL) {
      STk_error("cannot open object file %s (%s)", path, dlerror());
    }
99 100
    MUT_LOCK(dynload_mutex);
    files_already_loaded = STk_cons(STk_cons(STk_Cstring2string(path), (SCM) handle),
eg's avatar
eg committed
101
				    files_already_loaded);
102
    MUT_UNLOCK(dynload_mutex);
eg's avatar
eg committed
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117
  }

  if ((fct = (void *) dlsym(handle, fname)) == NULL && error_if_absent) {
    STk_error("cannot find symbol `%s' in `%s'", fname, path);
  }
  return fct;
}

SCM STk_load_object_file(SCM f, char *path)
{
  InitFunc init_fct;

  /* Close the port since we don't need it */
  STk_close_port(f);

118
  init_fct = STk_find_external_function(path, INIT_FUNC_NAME, TRUE);
eg's avatar
eg committed
119 120 121 122
  init_fct();
  return STk_true;
}

123 124 125 126
SCM STk_info_object_file(char *path)
{
  InfoFunc info_fct;

127
  info_fct = STk_find_external_function(path, INFO_FUNC_NAME, FALSE);
128 129
  return (info_fct) ? info_fct() : STk_nil;
}
eg's avatar
eg committed
130
#endif /* HAVE_DLOPEN */