libguile/dynl-dld.c

   1 /* dynl-dld.c - dynamic linking with dld
   2  *
   3  * Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
   4  *
   5  * This program is free software; you can redistribute it and/or modify
   6  * it under the terms of the GNU General Public License as published by
   7  * the Free Software Foundation; either version 2, or (at your option)
   8  * any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with this software; see the file COPYING.  If not, write to
  17  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  18  *
  19  * As a special exception, the Free Software Foundation gives permission
  20  * for additional uses of the text contained in its release of GUILE.
  21  *
  22  * The exception is that, if you link the GUILE library with other files
  23  * to produce an executable, this does not by itself cause the
  24  * resulting executable to be covered by the GNU General Public License.
  25  * Your use of that executable is in no way restricted on account of
  26  * linking the GUILE library code into it.
  27  *
  28  * This exception does not however invalidate any other reasons why
  29  * the executable file might be covered by the GNU General Public License.
  30  *
  31  * This exception applies only to the code released by the
  32  * Free Software Foundation under the name GUILE.  If you copy
  33  * code from other Free Software Foundation releases into a copy of
  34  * GUILE, as the General Public License permits, the exception does
  35  * not apply to the code that you add in this way.  To avoid misleading
  36  * anyone as to the status of such modified files, you must delete
  37  * this exception notice from them.
  38  *
  39  * If you write modifications of your own for GUILE, it is your choice
  40  * whether to permit this exception to apply to your modifications.
  41  * If you do not wish that, delete this exception notice.
  42  */
  43
  44 /* "dynl.c" dynamically link&load object files.
  45    Author: Aubrey Jaffer
  46    Modified for libguile by Marius Vollmer */
  47
  48 #include "_scm.h"
  49 #include "genio.h"
  50 #include "smob.h"
  51
  52 #include "dld.h"
  53
  54 static void listundef SCM_P ((void));
  55
  56 static void
  57 listundefs ()
  58 {
  59     int i;
  60     char **undefs = dld_list_undefined_sym();
  61     puts("   undefs:");
  62     for(i = dld_undefined_sym_count;i--;) {
  63         putc('"', stdout);
  64         fputs(undefs[i], stdout);
  65         puts("\"");
  66     }
  67     free(undefs);
  68 }
  69
  70 SCM_PROC (s_dynamic_link, "dynamic-link", 1, 0, 0, scm_dynamic_link);
  71
  72 SCM
  73 scm_dynamic_link (fname)
  74      SCM fname;
  75 {
  76     int status;
  77
  78     fname = scm_coerce_rostring (fname, s_dynamic_link, SCM_ARG1);
  79
  80     SCM_DEFER_INTS;
  81     status = dld_link (SCM_CHARS (fname));
  82     SCM_ALLOW_INTS;
  83     if (status)
  84         scm_misc_error (s_dynamic_link, dld_strerror (status), SCM_EOL);
  85     return fname;
  86 }
  87
  88 static void *get_func SCM_P ((char *subr, char *fname));
  89
  90 static void *
  91 get_func (subr, fname)
  92      char *subr;
  93      char *fname;
  94 {
  95     void *func;
  96
  97     if (!dld_function_executable_p (func)) {
  98         listundefs ();
  99         scm_misc_error (subr, "unresolved symbols remain", SCM_EOL);
 100     }
 101     func = (void *) dld_get_func (func);
 102     if (func == 0)
 103         scm_misc_error (subr, dld_strerror (dld_errno), SCM_EOL);
 104     return func;
 105 }
 106
 107 SCM_PROC (s_dynamic_call, "dynamic-call", 2, 0, 0, scm_dynamic_call);
 108
 109 SCM
 110 scm_dynamic_call (symb, shl)
 111      SCM symb;
 112      SCM shl;
 113 {
 114     void (*func)() = 0;
 115
 116     symb = scm_coerce_rostring (symb, s_dynamic_call, SCM_ARG1);
 117
 118     SCM_DEFER_INTS;
 119     func = get_func (s_dynamic_call, SCM_CHARS (symb));
 120     SCM_ALLOW_INST;
 121     (*func) ();
 122     return SCM_BOOL_T;
 123 }
 124
 125 SCM_PROC (s_dynamic_args_call, "dynamic-args-call", 3, 0, 0, scm_dynamic_args_call);
 126
 127 SCM
 128 scm_dynamic_args_call (symb, shl, args)
 129      SCM symb, shl, args;
 130 {
 131     int i, argc;
 132     char **argv;
 133     int (*func) SCM_P ((int argc, char **argv)) = 0;
 134
 135     symb = scm_coerce_rostring (symb, s_dynamic_args_call, SCM_ARG1);
 136
 137     SCM_DEFER_INTS;
 138     func = get_func (SCM_CHARS (symb), s_dynamic_args_call);
 139     argv = scm_make_argv_from_stringlist (args, &argc, s_dynamic_args_call,
 140                                       SCM_ARG3);
 141     SCM_ALLOW_INTS;
 142
 143     i = (*func) (argc, argv);
 144
 145     SCM_DEFER_INTS;
 146     scm_must_free_argv(argv);
 147     SCM_ALLOW_INTS;
 148     return SCM_MAKINUM(0L+i);
 149 }
 150
 151 SCM_PROC (s_dynamic_unlink, "dynamic-unlink", 1, 0, 0, scm_dynamic_unlink);
 152
 153 SCM
 154 scm_dynamic_unlink(fname)
 155      SCM fname;
 156 {
 157     int status;
 158
 159     fname = scm_coerce_rostring (fname, s_dynamic_unlink, SCM_ARG1);
 160
 161     SCM_DEFER_INTS;
 162     status = dld_unlink_by_file (SCM_CHARS (fname), 1);
 163     SCM_ALLOW_INTS;
 164
 165     if (status)
 166         scm_misc_error (s_dynamic_unlink, dld_strerror (status), SCM_EOL);
 167     return SCM_BOOL_T;
 168 }
 169
 170 void
 171 scm_init_dynamic_linking ()
 172 {
 173 #ifndef RTL
 174     if (!execpath)
 175         execpath = dld_find_executable (SCM_CHARS (SCM_CAR (progargs)));
 176     if (dld_init (SCM_CHARS (SCM_CAR (progargs)))) {
 177         dld_perror("DLD");
 178         return;
 179     }
 180 #endif
 181
 182 #include "dynl.x"
 183
 184 #ifdef DLD_DYNCM /* XXX - what's this? */
 185     add_feature("dld:dyncm");
 186 #endif
 187 }