/[guile]/guile/guile-core/libltdl/ltdl.c
ViewVC logotype

Diff of /guile/guile-core/libltdl/ltdl.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by mvo, Tue Jan 25 20:31:34 2000 UTC revision 1.3 by mvo, Thu Oct 3 21:57:09 2002 UTC
# Line 1  Line 1 
1  /* ltdl.c -- system independent dlopen wrapper  /* ltdl.c -- system independent dlopen wrapper
2     Copyright (C) 1998-1999 Free Software Foundation, Inc.     Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.
3     Originally by Thomas Tanner <tanner@ffii.org>     Originally by Thomas Tanner <tanner@ffii.org>
4     This file is part of GNU Libtool.     This file is part of GNU Libtool.
5    
6  This library is free software; you can redistribute it and/or  This library is free software; you can redistribute it and/or
7  modify it under the terms of the GNU Library General Public  modify it under the terms of the GNU Lesser General Public
8  License as published by the Free Software Foundation; either  License as published by the Free Software Foundation; either
9  version 2 of the License, or (at your option) any later version.  version 2 of the License, or (at your option) any later version.
10    
11  As a special exception to the GNU Library General Public License,  As a special exception to the GNU Lesser General Public License,
12  if you distribute this file as part of a program that uses GNU libtool  if you distribute this file as part of a program or library that
13  to create libraries and programs, you may include it under the same  is built using GNU libtool, you may include it under the same
14  distribution terms that you use for the rest of that program.  distribution terms that you use for the rest of that program.
15    
16  This library is distributed in the hope that it will be useful,  This library is distributed in the hope that it will be useful,
17  but WITHOUT ANY WARRANTY; without even the implied warranty of  but WITHOUT ANY WARRANTY; without even the implied warranty of
18  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19  Library General Public License for more details.  Lesser General Public License for more details.
20    
21  You should have received a copy of the GNU Library General Public  You should have received a copy of the GNU Lesser General Public
22  License along with this library; if not, write to the Free Software  License along with this library; if not, write to the Free Software
23  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
24  02111-1307  USA  02111-1307  USA
 */  
25    
26  #define _LTDL_COMPILE_  */
27    
28  #if HAVE_CONFIG_H  #if HAVE_CONFIG_H
29  #include <config.h>  #  include <config.h>
30  #endif  #endif
31    
32  #if HAVE_STRING_H  #if HAVE_UNISTD_H
33  #include <string.h>  #  include <unistd.h>
34  #endif  #endif
35    
36  #if HAVE_STRINGS_H  #if HAVE_STDIO_H
37  #include <strings.h>  #  include <stdio.h>
38    #endif
39    
40    #if HAVE_STDLIB_H
41    #  include <stdlib.h>
42    #endif
43    
44    #if HAVE_STRING_H
45    #  include <string.h>
46    #else
47    #  if HAVE_STRINGS_H
48    #    include <strings.h>
49    #  endif
50  #endif  #endif
51    
52  #if HAVE_CTYPE_H  #if HAVE_CTYPE_H
53  #include <ctype.h>  #  include <ctype.h>
54  #endif  #endif
55    
56  #if HAVE_MALLOC_H  #if HAVE_MALLOC_H
57  #include <malloc.h>  #  include <malloc.h>
58  #endif  #endif
59    
60  #if HAVE_MEMORY_H  #if HAVE_MEMORY_H
61  #include <memory.h>  #  include <memory.h>
62  #endif  #endif
63    
64  #if HAVE_STDLIB_H  #if HAVE_ERRNO_H
65  #include <stdlib.h>  #  include <errno.h>
66  #endif  #endif
67    
68  #if HAVE_STDIO_H  #if HAVE_DIRENT_H
69  #include <stdio.h>  #  include <dirent.h>
70    #  define LT_D_NAMLEN(dirent) (strlen((dirent)->d_name))
71    #else
72    #  define dirent direct
73    #  define LT_D_NAMLEN(dirent) ((dirent)->d_namlen)
74    #  if HAVE_SYS_NDIR_H
75    #    include <sys/ndir.h>
76    #  endif
77    #  if HAVE_SYS_DIR_H
78    #    include <sys/dir.h>
79    #  endif
80    #  if HAVE_NDIR_H
81    #    include <ndir.h>
82    #  endif
83    #endif
84    
85    #if HAVE_ARGZ_H
86    #  include <argz.h>
87    #endif
88    
89    #if HAVE_ASSERT_H
90    #  include <assert.h>
91    #else
92    #  define assert(arg)   ((void) 0)
93  #endif  #endif
94    
95  #include "ltdl.h"  #include "ltdl.h"
96    
97  /* max. filename length */  
98  #ifndef LTDL_FILENAME_MAX  
99  #define LTDL_FILENAME_MAX 1024  
100    /* --- WINDOWS SUPPORT --- */
101    
102    
103    #ifdef DLL_EXPORT
104    #  define LT_GLOBAL_DATA        __declspec(dllexport)
105    #else
106    #  define LT_GLOBAL_DATA
107  #endif  #endif
108    
 #undef  LTDL_READTEXT_MODE  
109  /* fopen() mode flags for reading a text file */  /* fopen() mode flags for reading a text file */
110  #ifdef _WIN32  #undef  LT_READTEXT_MODE
111  #define LTDL_READTEXT_MODE "rt"  #ifdef __WINDOWS__
112    #  define LT_READTEXT_MODE "rt"
113  #else  #else
114  #define LTDL_READTEXT_MODE "r"  #  define LT_READTEXT_MODE "r"
115    #endif
116    
117    
118    
119    
120    /* --- MANIFEST CONSTANTS --- */
121    
122    
123    /* Standard libltdl search path environment variable name  */
124    #undef  LTDL_SEARCHPATH_VAR
125    #define LTDL_SEARCHPATH_VAR     "LTDL_LIBRARY_PATH"
126    
127    /* Standard libtool archive file extension.  */
128    #undef  LTDL_ARCHIVE_EXT
129    #define LTDL_ARCHIVE_EXT        ".la"
130    
131    /* max. filename length */
132    #ifndef LT_FILENAME_MAX
133    #  define LT_FILENAME_MAX       1024
134  #endif  #endif
135    
 #undef  LTDL_SYMBOL_LENGTH  
136  /* This is the maximum symbol size that won't require malloc/free */  /* This is the maximum symbol size that won't require malloc/free */
137  #define LTDL_SYMBOL_LENGTH      128  #undef  LT_SYMBOL_LENGTH
138    #define LT_SYMBOL_LENGTH        128
139    
 #undef  LTDL_SYMBOL_OVERHEAD  
140  /* This accounts for the _LTX_ separator */  /* This accounts for the _LTX_ separator */
141  #define LTDL_SYMBOL_OVERHEAD    5  #undef  LT_SYMBOL_OVERHEAD
142    #define LT_SYMBOL_OVERHEAD      5
143    
144    
 static const char objdir[] = LTDL_OBJDIR;  
 #ifdef  LTDL_SHLIB_EXT  
 static const char shlib_ext[] = LTDL_SHLIB_EXT;  
 #endif  
145    
146  static const char unknown_error[] = "unknown error";  
147  static const char dlopen_not_supported_error[] = "dlopen support not available";  /* --- MEMORY HANDLING --- */
148  static const char file_not_found_error[] = "file not found";  
149  static const char no_symbols_error[] = "no symbols defined";  
150  static const char cannot_open_error[] = "can't open the module";  /* These are the functions used internally.  In addition to making
151  static const char cannot_close_error[] = "can't close the module";     use of the associated function pointers above, they also perform
152  static const char symbol_error[] = "symbol not found";     error handling.  */
153  static const char memory_error[] = "not enough memory";  static char   *lt_estrdup       LT_PARAMS((const char *str));
154  static const char invalid_handle_error[] = "invalid handle";  static lt_ptr lt_emalloc        LT_PARAMS((size_t size));
155  static const char buffer_overflow_error[] = "internal buffer overflow";  static lt_ptr lt_erealloc       LT_PARAMS((lt_ptr addr, size_t size));
156  static const char shutdown_error[] = "library already shutdown";  
157    static lt_ptr rpl_realloc       LT_PARAMS((lt_ptr ptr, size_t size));
158  #ifndef HAVE_PRELOADED_SYMBOLS  
159  /* If libtool won't define it, we'd better do */  /* These are the pointers that can be changed by the caller:  */
160  const lt_dlsymlist lt_preloaded_symbols[1] = { { 0, 0 } };  LT_GLOBAL_DATA lt_ptr (*scm_lt_dlmalloc)        LT_PARAMS((size_t size))
161  #endif                          = (lt_ptr (*) LT_PARAMS((size_t))) malloc;
162    LT_GLOBAL_DATA lt_ptr (*scm_lt_dlrealloc)       LT_PARAMS((lt_ptr ptr, size_t size))
163  static const char *last_error = 0;                          = (lt_ptr (*) LT_PARAMS((lt_ptr, size_t))) rpl_realloc;
164    LT_GLOBAL_DATA void   (*scm_lt_dlfree)  LT_PARAMS((lt_ptr ptr))
165  lt_ptr_t (*lt_dlmalloc) LTDL_PARAMS((size_t size)) = (lt_ptr_t(*)LTDL_PARAMS((size_t)))malloc;                          = (void (*) LT_PARAMS((lt_ptr))) free;
166  void     (*lt_dlfree)  LTDL_PARAMS((lt_ptr_t ptr)) = (void(*)LTDL_PARAMS((lt_ptr_t)))free;  
167    /* The following macros reduce the amount of typing needed to cast
168  typedef struct lt_dltype_t {     assigned memory.  */
169          struct lt_dltype_t *next;  #define LT_DLMALLOC(tp, n)      ((tp *) scm_lt_dlmalloc ((n) * sizeof(tp)))
170          const char *sym_prefix; /* prefix for symbols */  #define LT_DLREALLOC(tp, p, n)  ((tp *) rpl_realloc ((p), (n) * sizeof(tp)))
171          int (*mod_init) LTDL_PARAMS((void));  #define LT_DLFREE(p)                                            \
172          int (*mod_exit) LTDL_PARAMS((void));          LT_STMT_START { if (p) (p) = (scm_lt_dlfree (p), (lt_ptr) 0); } LT_STMT_END
173          int (*lib_open) LTDL_PARAMS((lt_dlhandle handle, const char *filename));  
174          int (*lib_close) LTDL_PARAMS((lt_dlhandle handle));  #define LT_EMALLOC(tp, n)       ((tp *) lt_emalloc ((n) * sizeof(tp)))
175          lt_ptr_t (*find_sym) LTDL_PARAMS((lt_dlhandle handle, const char *symbol));  #define LT_EREALLOC(tp, p, n)   ((tp *) lt_erealloc ((p), (n) * sizeof(tp)))
176  } lt_dltype_t;  
177    #define LT_DLMEM_REASSIGN(p, q)                 LT_STMT_START { \
178  #define LTDL_TYPE_TOP 0          if ((p) != (q)) { scm_lt_dlfree (p); (p) = (q); (q) = 0; }      \
179                                                    } LT_STMT_END
180  typedef struct lt_dlhandle_t {  
181          struct lt_dlhandle_t *next;  
182          lt_dltype_t *type;      /* dlopening interface */  /* --- REPLACEMENT FUNCTIONS --- */
183          char    *filename;      /* file name */  
         char    *name;          /* module name */  
         int     usage;          /* usage */  
         int     depcount;       /* number of dependencies */  
         lt_dlhandle *deplibs;   /* dependencies */  
         lt_ptr_t handle;        /* system handle */  
         lt_ptr_t system;        /* system specific data */  
 } lt_dlhandle_t;  
184    
185  #undef strdup  #undef strdup
186  #define strdup xstrdup  #define strdup rpl_strdup
187    
188    static char *strdup LT_PARAMS((const char *str));
189    
190  static inline char *  char *
191  strdup(str)  strdup(str)
192          const char *str;       const char *str;
193  {  {
194          char *tmp;    char *tmp = 0;
195    
196          if (!str)    if (str)
197                  return 0;      {
198          tmp = (char*) lt_dlmalloc(strlen(str)+1);        tmp = LT_DLMALLOC (char, 1+ strlen (str));
199          if (tmp)        if (tmp)
200                  strcpy(tmp, str);          {
201          return tmp;            strcpy(tmp, str);
202            }
203        }
204    
205      return tmp;
206  }  }
207    
 #if ! HAVE_STRCHR  
208    
209  # if HAVE_INDEX  #if ! HAVE_STRCMP
210    
211    #undef strcmp
212    #define strcmp rpl_strcmp
213    
214    static int strcmp LT_PARAMS((const char *str1, const char *str2));
215    
216    int
217    strcmp (str1, str2)
218         const char *str1;
219         const char *str2;
220    {
221      if (str1 == str2)
222        return 0;
223      if (str1 == 0)
224        return -1;
225      if (str2 == 0)
226        return 1;
227    
228      for (;*str1 && *str2; ++str1, ++str2)
229        {
230          if (*str1 != *str2)
231            break;
232        }
233    
234      return (int)(*str1 - *str2);
235    }
236    #endif
237    
238    
239  #  define strchr index  #if ! HAVE_STRCHR
240    
241  # else  #  if HAVE_INDEX
242    #    define strchr index
243    #  else
244    #    define strchr rpl_strchr
245    
246  #  define strchr xstrchr  static const char *strchr LT_PARAMS((const char *str, int ch));
247    
248  static inline const char*  const char*
249  strchr(str, ch)  strchr(str, ch)
250          const char *str;       const char *str;
251          int ch;       int ch;
252  {  {
253          const char *p;    const char *p;
254    
255          for (p = str; *p != (char)ch && *p != '\0'; p++)    for (p = str; *p != (char)ch && *p != LT_EOS_CHAR; ++p)
256                  /*NOWORK*/;      /*NOWORK*/;
257    
258          return (*p == (char)ch) ? p : 0;    return (*p == (char)ch) ? p : 0;
259  }  }
260    
261  # endif  #  endif
262    #endif /* !HAVE_STRCHR */
263    
 #endif  
264    
265  #if ! HAVE_STRRCHR  #if ! HAVE_STRRCHR
266    
267  # if HAVE_RINDEX  #  if HAVE_RINDEX
268    #    define strrchr rindex
269    #  else
270    #    define strrchr rpl_strrchr
271    
272    static const char *strrchr LT_PARAMS((const char *str, int ch));
273    
274    const char*
275    strrchr(str, ch)
276         const char *str;
277         int ch;
278    {
279      const char *p, *q = 0;
280    
281      for (p = str; *p != LT_EOS_CHAR; ++p)
282        {
283          if (*p == (char) ch)
284            {
285              q = p;
286            }
287        }
288    
289      return q;
290    }
291    
292    # endif
293    #endif
294    
295  #  define strrchr rindex  /* NOTE:  Neither bcopy nor the memcpy implementation below can
296              reliably handle copying in overlapping areas of memory.  Use
297              memmove (for which there is a fallback implmentation below)
298              if you need that behaviour.  */
299    #if ! HAVE_MEMCPY
300    
301  # else  #  if HAVE_BCOPY
302    #    define memcpy(dest, src, size)     bcopy (src, dest, size)
303    #  else
304    #    define memcpy rpl_memcpy
305    
306  #  define strrchr xstrrchr  static lt_ptr memcpy LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size));
307    
308  static inline const char*  lt_ptr
309  strrchr(str, ch)  memcpy (dest, src, size)
310          const char *str;       lt_ptr dest;
311          int ch;       const lt_ptr src;
312         size_t size;
313  {  {
314          const char *p;    size_t i = 0;
315    
316          for (p = str; *p != '\0'; p++)    for (i = 0; i < size; ++i)
317                  /*NOWORK*/;      {
318          dest[i] = src[i];
319        }
320    
321          while (*p != (char)ch && p >= str)    return dest;
322                  p--;  }
323    
324    #  endif /* !HAVE_BCOPY */
325    #endif   /* !HAVE_MEMCPY */
326    
327    #if ! HAVE_MEMMOVE
328    #  define memmove rpl_memmove
329    
330    static lt_ptr memmove LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size));
331    
332    lt_ptr
333    memmove (dest, src, size)
334         lt_ptr dest;
335         const lt_ptr src;
336         size_t size;
337    {
338      size_t i;
339    
340      if (dest < src)
341        for (i = 0; i < size; ++i)
342          {
343            dest[i] = src[i];
344          }
345      else if (dest > src)
346        for (i = size -1; i >= 0; --i)
347          {
348            dest[i] = src[i];
349          }
350    
351          return (*p == (char)ch) ? p : 0;    return dest;
352  }  }
353    
354  # endif  #endif /* !HAVE_MEMMOVE */
355    
356    
357    /* According to Alexandre Oliva <oliva@lsd.ic.unicamp.br>,
358        ``realloc is not entirely portable''
359       In any case we want to use the allocator supplied by the user without
360       burdening them with an scm_lt_dlrealloc function pointer to maintain.
361       Instead implement our own version (with known boundary conditions)
362       using scm_lt_dlmalloc and scm_lt_dlfree. */
363    
364    #undef realloc
365    #define realloc rpl_realloc
366    
367    lt_ptr
368    realloc (ptr, size)
369         lt_ptr ptr;
370         size_t size;
371    {
372      if (size <= 0)
373        {
374          /* For zero or less bytes, free the original memory */
375          if (ptr != 0)
376            {
377              scm_lt_dlfree (ptr);
378            }
379    
380          return (lt_ptr) 0;
381        }
382      else if (ptr == 0)
383        {
384          /* Allow reallocation of a NULL pointer.  */
385          return scm_lt_dlmalloc (size);
386        }
387      else
388        {
389          /* Allocate a new block, copy and free the old block.  */
390          lt_ptr mem = scm_lt_dlmalloc (size);
391    
392          if (mem)
393            {
394              memcpy (mem, ptr, size);
395              scm_lt_dlfree (ptr);
396            }
397    
398          /* Note that the contents of PTR are not damaged if there is
399             insufficient memory to realloc.  */
400          return mem;
401        }
402    }
403    
404    
405    #if ! HAVE_ARGZ_APPEND
406    #  define argz_append rpl_argz_append
407    
408    static error_t argz_append LT_PARAMS((char **pargz, size_t *pargz_len,
409                                            const char *buf, size_t buf_len));
410    
411    error_t
412    argz_append (pargz, pargz_len, buf, buf_len)
413         char **pargz;
414         size_t *pargz_len;
415         const char *buf;
416         size_t buf_len;
417    {
418      size_t argz_len;
419      char  *argz;
420    
421      assert (pargz);
422      assert (pargz_len);
423      assert ((*pargz && *pargz_len) || (!*pargz && !*pargz_len));
424    
425      /* If nothing needs to be appended, no more work is required.  */
426      if (buf_len == 0)
427        return 0;
428    
429      /* Ensure there is enough room to append BUF_LEN.  */
430      argz_len = *pargz_len + buf_len;
431      argz = LT_DLREALLOC (char, *pargz, argz_len);
432      if (!argz)
433        return ENOMEM;
434    
435      /* Copy characters from BUF after terminating '\0' in ARGZ.  */
436      memcpy (argz + *pargz_len, buf, buf_len);
437    
438      /* Assign new values.  */
439      *pargz = argz;
440      *pargz_len = argz_len;
441    
442      return 0;
443    }
444    #endif /* !HAVE_ARGZ_APPEND */
445    
446    
447    #if ! HAVE_ARGZ_CREATE_SEP
448    #  define argz_create_sep rpl_argz_create_sep
449    
450    static error_t argz_create_sep LT_PARAMS((const char *str, int delim,
451                                                char **pargz, size_t *pargz_len));
452    
453    error_t
454    argz_create_sep (str, delim, pargz, pargz_len)
455         const char *str;
456         int delim;
457         char **pargz;
458         size_t *pargz_len;
459    {
460      size_t argz_len;
461      char *argz = 0;
462    
463      assert (str);
464      assert (pargz);
465      assert (pargz_len);
466    
467      /* Make a copy of STR, but replacing each occurence of
468         DELIM with '\0'.  */
469      argz_len = 1+ LT_STRLEN (str);
470      if (argz_len)
471        {
472          const char *p;
473          char *q;
474    
475          argz = LT_DLMALLOC (char, argz_len);
476          if (!argz)
477            return ENOMEM;
478    
479          for (p = str, q = argz; *p != LT_EOS_CHAR; ++p)
480            {
481              if (*p == delim)
482                {
483                  /* Ignore leading delimiters, and fold consecutive
484                     delimiters in STR into a single '\0' in ARGZ.  */
485                  if ((q > argz) && (q[-1] != LT_EOS_CHAR))
486                    *q++ = LT_EOS_CHAR;
487                  else
488                    --argz_len;
489                }
490              else
491                *q++ = *p;
492            }
493          /* Copy terminating LT_EOS_CHAR.  */
494          *q = *p;
495        }
496    
497      /* If ARGZ_LEN has shrunk to nothing, release ARGZ's memory.  */
498      if (!argz_len)
499        LT_DLFREE (argz);
500    
501      /* Assign new values.  */
502      *pargz = argz;
503      *pargz_len = argz_len;
504    
505      return 0;
506    }
507    #endif /* !HAVE_ARGZ_CREATE_SEP */
508    
509    
510    #if ! HAVE_ARGZ_INSERT
511    #  define argz_insert rpl_argz_insert
512    
513    static error_t argz_insert LT_PARAMS((char **pargz, size_t *pargz_len,
514                                            char *before, const char *entry));
515    
516    error_t
517    argz_insert (pargz, pargz_len, before, entry)
518         char **pargz;
519         size_t *pargz_len;
520         char *before;
521         const char *entry;
522    {
523      assert (pargz);
524      assert (pargz_len);
525      assert (entry && *entry);
526    
527      /* Either PARGZ/PARGZ_LEN is empty and BEFORE is NULL,
528         or BEFORE points into an address within the ARGZ vector.  */
529      assert ((!*pargz && !*pargz_len && !before)
530              || ((*pargz <= before) && (before < (*pargz + *pargz_len))));
531    
532      /* No BEFORE address indicates ENTRY should be inserted after the
533         current last element.  */
534      if (!before)
535        return argz_append (pargz, pargz_len, entry, 1+ LT_STRLEN (entry));
536    
537      /* This probably indicates a programmer error, but to preserve
538         semantics, scan back to the start of an entry if BEFORE points
539         into the middle of it.  */
540      while ((before >= *pargz) && (before[-1] != LT_EOS_CHAR))
541        --before;
542    
543      {
544        size_t entry_len    = 1+ LT_STRLEN (entry);
545        size_t argz_len     = *pargz_len + entry_len;
546        size_t offset       = before - *pargz;
547        char   *argz        = LT_DLREALLOC (char, *pargz, argz_len);
548    
549        if (!argz)
550          return ENOMEM;
551    
552        /* Make BEFORE point to the equivalent offset in ARGZ that it
553           used to have in *PARGZ incase realloc() moved the block.  */
554        before = argz + offset;
555    
556        /* Move the ARGZ entries starting at BEFORE up into the new
557           space at the end -- making room to copy ENTRY into the
558           resulting gap.  */
559        memmove (before + entry_len, before, *pargz_len - offset);
560        memcpy  (before, entry, entry_len);
561    
562        /* Assign new values.  */
563        *pargz = argz;
564        *pargz_len = argz_len;
565      }
566    
567      return 0;
568    }
569    #endif /* !HAVE_ARGZ_INSERT */
570    
571    
572    #if ! HAVE_ARGZ_NEXT
573    #  define argz_next rpl_argz_next
574    
575    static char *argz_next LT_PARAMS((char *argz, size_t argz_len,
576                                        const char *entry));
577    
578    char *
579    argz_next (argz, argz_len, entry)
580         char *argz;
581         size_t argz_len;
582         const char *entry;
583    {
584      assert ((argz && argz_len) || (!argz && !argz_len));
585    
586      if (entry)
587        {
588          /* Either ARGZ/ARGZ_LEN is empty, or ENTRY points into an address
589             within the ARGZ vector.  */
590          assert ((!argz && !argz_len)
591                  || ((argz <= entry) && (entry < (argz + argz_len))));
592    
593          /* Move to the char immediately after the terminating
594             '\0' of ENTRY.  */
595          entry = 1+ strchr (entry, LT_EOS_CHAR);
596    
597          /* Return either the new ENTRY, or else NULL if ARGZ is
598             exhausted.  */
599          return (entry >= argz + argz_len) ? 0 : (char *) entry;
600        }
601      else
602        {
603          /* This should probably be flagged as a programmer error,
604             since starting an argz_next loop with the iterator set
605             to ARGZ is safer.  To preserve semantics, handle the NULL
606             case by returning the start of ARGZ (if any).  */
607          if (argz_len > 0)
608            return argz;
609          else
610            return 0;
611        }
612    }
613    #endif /* !HAVE_ARGZ_NEXT */
614    
615    
616    
617    #if ! HAVE_ARGZ_STRINGIFY
618    #  define argz_stringify rpl_argz_stringify
619    
620    static void argz_stringify LT_PARAMS((char *argz, size_t argz_len,
621                                           int sep));
622    
623    void
624    argz_stringify (argz, argz_len, sep)
625         char *argz;
626         size_t argz_len;
627         int sep;
628    {
629      assert ((argz && argz_len) || (!argz && !argz_len));
630    
631      if (sep)
632        {
633          --argz_len;               /* don't stringify the terminating EOS */
634          while (--argz_len > 0)
635            {
636              if (argz[argz_len] == LT_EOS_CHAR)
637                argz[argz_len] = sep;
638            }
639        }
640    }
641    #endif /* !HAVE_ARGZ_STRINGIFY */
642    
643    
644    
645    
646    /* --- TYPE DEFINITIONS -- */
647    
648    
649    /* This type is used for the array of caller data sets in each handler. */
650    typedef struct {
651      lt_dlcaller_id        key;
652      lt_ptr                data;
653    } lt_caller_data;
654    
655    
656    
657    
658    /* --- OPAQUE STRUCTURES DECLARED IN LTDL.H --- */
659    
660    
661    /* Extract the diagnostic strings from the error table macro in the same
662       order as the enumerated indices in ltdl.h. */
663    
664    static const char *scm_lt_dlerror_strings[] =
665      {
666    #define LT_ERROR(name, diagnostic)      (diagnostic),
667        scm_lt_dlerror_table
668    #undef LT_ERROR
669    
670        0
671      };
672    
673    /* This structure is used for the list of registered loaders. */
674    struct lt_dlloader {
675      struct lt_dlloader   *next;
676      const char           *loader_name;    /* identifying name for each loader */
677      const char           *sym_prefix;     /* prefix for symbols */
678      lt_module_open       *module_open;
679      lt_module_close      *module_close;
680      lt_find_sym          *find_sym;
681      lt_dlloader_exit     *dlloader_exit;
682      lt_user_data          dlloader_data;
683    };
684    
685    struct lt_dlhandle_struct {
686      struct lt_dlhandle_struct   *next;
687      lt_dlloader          *loader;         /* dlopening interface */
688      lt_dlinfo             info;
689      int                   depcount;       /* number of dependencies */
690      lt_dlhandle          *deplibs;        /* dependencies */
691      lt_module             module;         /* system module handle */
692      lt_ptr                system;         /* system specific data */
693      lt_caller_data       *caller_data;    /* per caller associated data */
694      int                   flags;          /* various boolean stats */
695    };
696    
697    /* Various boolean flags can be stored in the flags field of an
698       lt_dlhandle_struct... */
699    #define LT_DLGET_FLAG(handle, flag) (((handle)->flags & (flag)) == (flag))
700    #define LT_DLSET_FLAG(handle, flag) ((handle)->flags |= (flag))
701    
702    #define LT_DLRESIDENT_FLAG          (0x01 << 0)
703    /* ...add more flags here... */
704    
705    #define LT_DLIS_RESIDENT(handle)    LT_DLGET_FLAG(handle, LT_DLRESIDENT_FLAG)
706    
707    
708    #define LT_DLSTRERROR(name)     scm_lt_dlerror_strings[LT_CONC(LT_ERROR_,name)]
709    
710    static  const char      objdir[]                = LTDL_OBJDIR;
711    static  const char      archive_ext[]           = LTDL_ARCHIVE_EXT;
712    #ifdef  LTDL_SHLIB_EXT
713    static  const char      shlib_ext[]             = LTDL_SHLIB_EXT;
714  #endif  #endif
715    #ifdef  LTDL_SYSSEARCHPATH
716    static  const char      sys_search_path[]       = LTDL_SYSSEARCHPATH;
717    #endif
718    
719    
720    
721    
722    /* --- MUTEX LOCKING --- */
723    
724    
725    /* Macros to make it easier to run the lock functions only if they have
726       been registered.  The reason for the complicated lock macro is to
727       ensure that the stored error message from the last error is not
728       accidentally erased if the current function doesn't generate an
729       error of its own.  */
730    #define LT_DLMUTEX_LOCK()                       LT_STMT_START { \
731            if (lt_dlmutex_lock_func) (*lt_dlmutex_lock_func)();    \
732                                                    } LT_STMT_END
733    #define LT_DLMUTEX_UNLOCK()                     LT_STMT_START { \
734            if (lt_dlmutex_unlock_func) (*lt_dlmutex_unlock_func)();\
735                                                    } LT_STMT_END
736    #define LT_DLMUTEX_SETERROR(errormsg)           LT_STMT_START { \
737            if (lt_dlmutex_seterror_func)                           \
738                    (*lt_dlmutex_seterror_func) (errormsg);         \
739            else    lt_dllast_error = (errormsg);   } LT_STMT_END
740    #define LT_DLMUTEX_GETERROR(errormsg)           LT_STMT_START { \
741            if (lt_dlmutex_seterror_func)                           \
742                    (errormsg) = (*lt_dlmutex_geterror_func) ();    \
743            else    (errormsg) = lt_dllast_error;   } LT_STMT_END
744    
745    /* The mutex functions stored here are global, and are necessarily the
746       same for all threads that wish to share access to libltdl.  */
747    static  lt_dlmutex_lock     *lt_dlmutex_lock_func     = 0;
748    static  lt_dlmutex_unlock   *lt_dlmutex_unlock_func   = 0;
749    static  lt_dlmutex_seterror *lt_dlmutex_seterror_func = 0;
750    static  lt_dlmutex_geterror *lt_dlmutex_geterror_func = 0;
751    static  const char          *lt_dllast_error          = 0;
752    
753    
754    /* Either set or reset the mutex functions.  Either all the arguments must
755       be valid functions, or else all can be NULL to turn off locking entirely.
756       The registered functions should be manipulating a static global lock
757       from the lock() and unlock() callbacks, which needs to be reentrant.  */
758    int
759    scm_lt_dlmutex_register (lock, unlock, seterror, geterror)
760         lt_dlmutex_lock *lock;
761         lt_dlmutex_unlock *unlock;
762         lt_dlmutex_seterror *seterror;
763         lt_dlmutex_geterror *geterror;
764    {
765      lt_dlmutex_unlock *old_unlock = unlock;
766      int                errors     = 0;
767    
768      /* Lock using the old lock() callback, if any.  */
769      LT_DLMUTEX_LOCK ();
770    
771      if ((lock && unlock && seterror && geterror)
772          || !(lock || unlock || seterror || geterror))
773        {
774          lt_dlmutex_lock_func     = lock;
775          lt_dlmutex_unlock_func   = unlock;
776          lt_dlmutex_geterror_func = geterror;
777        }
778      else
779        {
780          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_MUTEX_ARGS));
781          ++errors;
782        }
783    
784      /* Use the old unlock() callback we saved earlier, if any.  Otherwise
785         record any errors using internal storage.  */
786      if (old_unlock)
787        (*old_unlock) ();
788    
789      /* Return the number of errors encountered during the execution of
790         this function.  */
791      return errors;
792    }
793    
794    
795    
796    
797    /* --- ERROR HANDLING --- */
798    
799    
800    static  const char    **user_error_strings      = 0;
801    static  int             errorcount              = LT_ERROR_MAX;
802    
803    int
804    scm_lt_dladderror (diagnostic)
805         const char *diagnostic;
806    {
807      int           errindex = 0;
808      int           result   = -1;
809      const char  **temp     = (const char **) 0;
810    
811      assert (diagnostic);
812    
813      LT_DLMUTEX_LOCK ();
814    
815      errindex = errorcount - LT_ERROR_MAX;
816      temp = LT_EREALLOC (const char *, user_error_strings, 1 + errindex);
817      if (temp)
818        {
819          user_error_strings                = temp;
820          user_error_strings[errindex]      = diagnostic;
821          result                            = errorcount++;
822        }
823    
824  #if HAVE_LIBDL    LT_DLMUTEX_UNLOCK ();
825    
826      return result;
827    }
828    
829    int
830    scm_lt_dlseterror (errindex)
831         int errindex;
832    {
833      int           errors   = 0;
834    
835      LT_DLMUTEX_LOCK ();
836    
837      if (errindex >= errorcount || errindex < 0)
838        {
839          /* Ack!  Error setting the error message! */
840          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_ERRORCODE));
841          ++errors;
842        }
843      else if (errindex < LT_ERROR_MAX)
844        {
845          /* No error setting the error message! */
846          LT_DLMUTEX_SETERROR (scm_lt_dlerror_strings[errindex]);
847        }
848      else
849        {
850          /* No error setting the error message! */
851          LT_DLMUTEX_SETERROR (user_error_strings[errindex - LT_ERROR_MAX]);
852        }
853    
854      LT_DLMUTEX_UNLOCK ();
855    
856      return errors;
857    }
858    
859    lt_ptr
860    lt_emalloc (size)
861         size_t size;
862    {
863      lt_ptr mem = scm_lt_dlmalloc (size);
864      if (size && !mem)
865        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY));
866      return mem;
867    }
868    
869    lt_ptr
870    lt_erealloc (addr, size)
871         lt_ptr addr;
872         size_t size;
873    {
874      lt_ptr mem = realloc (addr, size);
875      if (size && !mem)
876        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY));
877      return mem;
878    }
879    
880    char *
881    lt_estrdup (str)
882         const char *str;
883    {
884      char *dup = strdup (str);
885      if (LT_STRLEN (str) && !dup)
886        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY));
887      return dup;
888    }
889    
890    
891    
892    
893    /* --- DLOPEN() INTERFACE LOADER --- */
894    
895    
896    /* The Cygwin dlopen implementation prints a spurious error message to
897       stderr if its call to LoadLibrary() fails for any reason.  We can
898       mitigate this by not using the Cygwin implementation, and falling
899       back to our own LoadLibrary() wrapper. */
900    #if HAVE_LIBDL && !defined(__CYGWIN__)
901    
902  /* dynamic linking with dlopen/dlsym */  /* dynamic linking with dlopen/dlsym */
903    
904  #if HAVE_DLFCN_H  #if HAVE_DLFCN_H
905  # include <dlfcn.h>  #  include <dlfcn.h>
906    #endif
907    
908    #if HAVE_SYS_DL_H
909    #  include <sys/dl.h>
910  #endif  #endif
911    
912  #ifdef RTLD_GLOBAL  #ifdef RTLD_GLOBAL
913  # define LTDL_GLOBAL    RTLD_GLOBAL  #  define LT_GLOBAL             RTLD_GLOBAL
914  #else  #else
915  # ifdef DL_GLOBAL  #  ifdef DL_GLOBAL
916  #  define LTDL_GLOBAL   DL_GLOBAL  #    define LT_GLOBAL           DL_GLOBAL
917  # else  #  endif
918  #  define LTDL_GLOBAL   0  #endif /* !RTLD_GLOBAL */
919  # endif  #ifndef LT_GLOBAL
920  #endif  #  define LT_GLOBAL             0
921    #endif /* !LT_GLOBAL */
922    
923  /* We may have to define LTDL_LAZY_OR_NOW in the command line if we  /* We may have to define LT_LAZY_OR_NOW in the command line if we
924     find out it does not work in some platform. */     find out it does not work in some platform. */
925  #ifndef LTDL_LAZY_OR_NOW  #ifndef LT_LAZY_OR_NOW
926  # ifdef RTLD_LAZY  #  ifdef RTLD_LAZY
927  #  define LTDL_LAZY_OR_NOW      RTLD_LAZY  #    define LT_LAZY_OR_NOW      RTLD_LAZY
928  # else  #  else
929  #  ifdef DL_LAZY  #    ifdef DL_LAZY
930  #   define LTDL_LAZY_OR_NOW     DL_LAZY  #      define LT_LAZY_OR_NOW    DL_LAZY
931    #    endif
932    #  endif /* !RTLD_LAZY */
933    #endif
934    #ifndef LT_LAZY_OR_NOW
935    #  ifdef RTLD_NOW
936    #    define LT_LAZY_OR_NOW      RTLD_NOW
937  #  else  #  else
 #   ifdef RTLD_NOW  
 #    define LTDL_LAZY_OR_NOW    RTLD_NOW  
 #   else  
938  #    ifdef DL_NOW  #    ifdef DL_NOW
939  #     define LTDL_LAZY_OR_NOW   DL_NOW  #      define LT_LAZY_OR_NOW    DL_NOW
 #    else  
 #     define LTDL_LAZY_OR_NOW   0  
940  #    endif  #    endif
941  #   endif  #  endif /* !RTLD_NOW */
 #  endif  
 # endif  
942  #endif  #endif
943    #ifndef LT_LAZY_OR_NOW
944    #  define LT_LAZY_OR_NOW        0
945    #endif /* !LT_LAZY_OR_NOW */
946    
947  static int  #if HAVE_DLERROR
948  sys_dl_init LTDL_PARAMS((void))  #  define DLERROR(arg)  dlerror ()
949  {  #else
950          return 0;  #  define DLERROR(arg)  LT_DLSTRERROR (arg)
951  }  #endif
952    
953  static int  static lt_module
954  sys_dl_exit LTDL_PARAMS((void))  sys_dl_open (loader_data, filename)
955         lt_user_data loader_data;
956         const char *filename;
957  {  {
958          return 0;    lt_module   module   = dlopen (filename, LT_GLOBAL | LT_LAZY_OR_NOW);
959    
960      if (!module)
961        {
962          LT_DLMUTEX_SETERROR (DLERROR (CANNOT_OPEN));
963        }
964    
965      return module;
966  }  }
967    
968  static int  static int
969  sys_dl_open (handle, filename)  sys_dl_close (loader_data, module)
970          lt_dlhandle handle;       lt_user_data loader_data;
971          const char *filename;       lt_module module;
972  {  {
973          handle->handle = dlopen(filename, LTDL_GLOBAL | LTDL_LAZY_OR_NOW);    int errors = 0;
974          if (!handle->handle) {  
975  #if HAVE_DLERROR    if (dlclose (module) != 0)
976                  last_error = dlerror();      {
977  #else        LT_DLMUTEX_SETERROR (DLERROR (CANNOT_CLOSE));
978                  last_error = cannot_open_error;        ++errors;
979  #endif      }
980                  return 1;  
981          }    return errors;
         return 0;  
982  }  }
983    
984  static int  static lt_ptr
985  sys_dl_close (handle)  sys_dl_sym (loader_data, module, symbol)
986          lt_dlhandle handle;       lt_user_data loader_data;
987         lt_module module;
988         const char *symbol;
989  {  {
990          if (dlclose(handle->handle) != 0) {    lt_ptr address = dlsym (module, symbol);
 #if HAVE_DLERROR  
                 last_error = dlerror();  
 #else  
                 last_error = cannot_close_error;  
 #endif  
                 return 1;  
         }  
         return 0;  
 }  
991    
992  static lt_ptr_t    if (!address)
993  sys_dl_sym (handle, symbol)      {
994          lt_dlhandle handle;        LT_DLMUTEX_SETERROR (DLERROR (SYMBOL_NOT_FOUND));
995          const char *symbol;      }
996  {  
997          lt_ptr_t address = dlsym(handle->handle, symbol);    return address;
           
         if (!address)  
 #if HAVE_DLERROR  
                 last_error = dlerror();  
 #else  
                 last_error = symbol_error;  
 #endif  
         return address;  
998  }  }
999    
1000  static  static struct lt_user_dlloader sys_dl =
1001  lt_dltype_t    {
1002  #ifdef NEED_USCORE  #  ifdef NEED_USCORE
1003  sys_dl = { LTDL_TYPE_TOP, "_", sys_dl_init, sys_dl_exit,      "_",
1004          sys_dl_open, sys_dl_close, sys_dl_sym };  #  else
1005  #else      0,
1006  sys_dl = { LTDL_TYPE_TOP, 0, sys_dl_init, sys_dl_exit,  #  endif
1007          sys_dl_open, sys_dl_close, sys_dl_sym };      sys_dl_open, sys_dl_close, sys_dl_sym, 0, 0 };
 #endif  
1008    
 #undef LTDL_TYPE_TOP  
 #define LTDL_TYPE_TOP &sys_dl  
1009    
1010  #endif  #endif /* HAVE_LIBDL */
1011    
1012    
1013    
1014    /* --- SHL_LOAD() INTERFACE LOADER --- */
1015    
1016  #if HAVE_SHL_LOAD  #if HAVE_SHL_LOAD
1017    
1018  /* dynamic linking with shl_load (HP-UX) (comments from gmodule) */  /* dynamic linking with shl_load (HP-UX) (comments from gmodule) */
1019    
1020  #ifdef HAVE_DL_H  #ifdef HAVE_DL_H
1021  #include <dl.h>  #  include <dl.h>
1022  #endif  #endif
1023    
1024  /* some flags are missing on some systems, so we provide  /* some flags are missing on some systems, so we provide
# Line 337  sys_dl = { LTDL_TYPE_TOP, 0, sys_dl_init Line 1029  sys_dl = { LTDL_TYPE_TOP, 0, sys_dl_init
1029   * BIND_DEFERRED   - Delay code symbol resolution until actual reference.   * BIND_DEFERRED   - Delay code symbol resolution until actual reference.
1030   *   *
1031   * Optionally:   * Optionally:
1032   * BIND_FIRST      - Place the library at the head of the symbol search order.   * BIND_FIRST      - Place the library at the head of the symbol search
1033   * BIND_NONFATAL   - The default BIND_IMMEDIATE behavior is to treat all unsatisfied   *                   order.
1034   *                   symbols as fatal.  This flag allows binding of unsatisfied code   * BIND_NONFATAL   - The default BIND_IMMEDIATE behavior is to treat all
1035   *                   symbols to be deferred until use.   *                   unsatisfied symbols as fatal.  This flag allows
1036   *                   [Perl: For certain libraries, like DCE, deferred binding often   *                   binding of unsatisfied code symbols to be deferred
1037   *                   causes run time problems.  Adding BIND_NONFATAL to BIND_IMMEDIATE   *                   until use.
1038   *                   still allows unresolved references in situations like this.]   *                   [Perl: For certain libraries, like DCE, deferred
1039   * BIND_NOSTART    - Do not call the initializer for the shared library when the   *                   binding often causes run time problems. Adding
1040   *                   library is loaded, nor on a future call to shl_unload().   *                   BIND_NONFATAL to BIND_IMMEDIATE still allows
1041   * BIND_VERBOSE    - Print verbose messages concerning possible unsatisfied symbols.   *                   unresolved references in situations like this.]
1042     * BIND_NOSTART    - Do not call the initializer for the shared library
1043     *                   when the library is loaded, nor on a future call to
1044     *                   shl_unload().
1045     * BIND_VERBOSE    - Print verbose messages concerning possible
1046     *                   unsatisfied symbols.
1047   *   *
1048   * hp9000s700/hp9000s800:   * hp9000s700/hp9000s800:
1049   * BIND_RESTRICTED - Restrict symbols visible by the library to those present at   * BIND_RESTRICTED - Restrict symbols visible by the library to those
1050   *                   library load time.   *                   present at library load time.
1051   * DYNAMIC_PATH    - Allow the loader to dynamically search for the library specified   * DYNAMIC_PATH    - Allow the loader to dynamically search for the
1052   *                   by the path argument.   *                   library specified by the path argument.
1053   */   */
1054    
1055  #ifndef DYNAMIC_PATH  #ifndef DYNAMIC_PATH
1056  #define DYNAMIC_PATH    0  #  define DYNAMIC_PATH          0
1057  #endif  /* DYNAMIC_PATH */  #endif
1058  #ifndef BIND_RESTRICTED  #ifndef BIND_RESTRICTED
1059  #define BIND_RESTRICTED 0  #  define BIND_RESTRICTED       0
1060  #endif  /* BIND_RESTRICTED */  #endif
1061    
1062  #define LTDL_BIND_FLAGS (BIND_IMMEDIATE | BIND_NONFATAL | DYNAMIC_PATH)  #define LT_BIND_FLAGS   (BIND_IMMEDIATE | BIND_NONFATAL | DYNAMIC_PATH)
1063    
1064  static int  static lt_module
1065  sys_shl_init LTDL_PARAMS((void))  sys_shl_open (loader_data, filename)
1066         lt_user_data loader_data;
1067         const char *filename;
1068  {  {
1069          return 0;    static shl_t self = (shl_t) 0;
1070      lt_module module = shl_load (filename, LT_BIND_FLAGS, 0L);
1071    
1072      /* Since searching for a symbol against a NULL module handle will also
1073         look in everything else that was already loaded and exported with
1074         the -E compiler flag, we always cache a handle saved before any
1075         modules are loaded.  */
1076      if (!self)
1077        {
1078          lt_ptr address;
1079          shl_findsym (&self, "main", TYPE_UNDEFINED, &address);
1080        }
1081    
1082      if (!filename)
1083        {
1084          module = self;
1085        }
1086      else
1087        {
1088          module = shl_load (filename, LT_BIND_FLAGS, 0L);
1089    
1090          if (!module)
1091            {
1092              LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN));
1093            }
1094        }
1095    
1096      return module;
1097  }  }
1098    
1099  static int  static int
1100  sys_shl_exit LTDL_PARAMS((void))  sys_shl_close (loader_data, module)
1101         lt_user_data loader_data;
1102         lt_module module;
1103  {  {
1104          return 0;    int errors = 0;
1105    
1106      if (module && (shl_unload ((shl_t) (module)) != 0))
1107        {
1108          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE));
1109          ++errors;
1110        }
1111    
1112      return errors;
1113  }  }
1114    
1115  static int  static lt_ptr
1116  sys_shl_open (handle, filename)  sys_shl_sym (loader_data, module, symbol)
1117          lt_dlhandle handle;       lt_user_data loader_data;
1118          const char *filename;       lt_module module;
1119  {       const char *symbol;
1120          handle->handle = shl_load(filename, LTDL_BIND_FLAGS, 0L);  {
1121          if (!handle->handle) {    lt_ptr address = 0;
1122                  last_error = cannot_open_error;  
1123                  return 1;    /* sys_shl_open should never return a NULL module handle */
1124      if (module == (lt_module) 0)
1125      {
1126        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE));
1127      }
1128      else if (!shl_findsym((shl_t*) &module, symbol, TYPE_UNDEFINED, &address))
1129        {
1130          if (!address)
1131            {
1132              LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND));
1133          }          }
1134          return 0;      }
1135    
1136      return address;
1137    }
1138    
1139    static struct lt_user_dlloader sys_shl = {
1140      0, sys_shl_open, sys_shl_close, sys_shl_sym, 0, 0
1141    };
1142    
1143    #endif /* HAVE_SHL_LOAD */
1144    
1145    
1146    
1147    
1148    /* --- LOADLIBRARY() INTERFACE LOADER --- */
1149    
1150    #ifdef __WINDOWS__
1151    
1152    /* dynamic linking for Win32 */
1153    
1154    #include <windows.h>
1155    
1156    /* Forward declaration; required to implement handle search below. */
1157    static lt_dlhandle handles;
1158    
1159    static lt_module
1160    sys_wll_open (loader_data, filename)
1161         lt_user_data loader_data;
1162         const char *filename;
1163    {
1164      lt_dlhandle   cur;
1165      lt_module     module     = 0;
1166      const char   *errormsg   = 0;
1167      char         *searchname = 0;
1168      char         *ext;
1169      char          self_name_buf[MAX_PATH];
1170    
1171      if (!filename)
1172        {
1173          /* Get the name of main module */
1174          *self_name_buf = 0;
1175          GetModuleFileName (NULL, self_name_buf, sizeof (self_name_buf));
1176          filename = ext = self_name_buf;
1177        }
1178      else
1179        {
1180          ext = strrchr (filename, '.');
1181        }
1182    
1183      if (ext)
1184        {
1185          /* FILENAME already has an extension. */
1186          searchname = lt_estrdup (filename);
1187        }
1188      else
1189        {
1190          /* Append a `.' to stop Windows from adding an
1191             implicit `.dll' extension. */
1192          searchname = LT_EMALLOC (char, 2+ LT_STRLEN (filename));
1193          if (searchname)
1194            sprintf (searchname, "%s.", filename);
1195        }
1196      if (!searchname)
1197        return 0;
1198    
1199    #if __CYGWIN__
1200      {
1201        char wpath[MAX_PATH];
1202        cygwin_conv_to_full_win32_path(searchname, wpath);
1203        module = LoadLibrary(wpath);
1204      }
1205    #else
1206      module = LoadLibrary (searchname);
1207    #endif
1208      LT_DLFREE (searchname);
1209    
1210      /* libltdl expects this function to fail if it is unable
1211         to physically load the library.  Sadly, LoadLibrary
1212         will search the loaded libraries for a match and return
1213         one of them if the path search load fails.
1214    
1215         We check whether LoadLibrary is returning a handle to
1216         an already loaded module, and simulate failure if we
1217         find one. */
1218      LT_DLMUTEX_LOCK ();
1219      cur = handles;
1220      while (cur)
1221        {
1222          if (!cur->module)
1223            {
1224              cur = 0;
1225              break;
1226            }
1227    
1228          if (cur->module == module)
1229            {
1230              break;
1231            }
1232    
1233          cur = cur->next;
1234      }
1235      LT_DLMUTEX_UNLOCK ();
1236    
1237      if (cur || !module)
1238        {
1239          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN));
1240          module = 0;
1241        }
1242    
1243      return module;
1244  }  }
1245    
1246  static int  static int
1247  sys_shl_close (handle)  sys_wll_close (loader_data, module)
1248          lt_dlhandle handle;       lt_user_data loader_data;
1249         lt_module module;
1250  {  {
1251          if (shl_unload((shl_t) (handle->handle)) != 0) {    int         errors   = 0;
1252                  last_error = cannot_close_error;  
1253                  return 1;    if (FreeLibrary(module) == 0)
1254          }      {
1255          return 0;        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE));
1256          ++errors;
1257        }
1258    
1259      return errors;
1260  }  }
1261    
1262  static lt_ptr_t  static lt_ptr
1263  sys_shl_sym (handle, symbol)  sys_wll_sym (loader_data, module, symbol)
1264          lt_dlhandle handle;       lt_user_data loader_data;
1265          const char *symbol;       lt_module module;
1266  {       const char *symbol;
1267          lt_ptr_t address;  {
1268      lt_ptr      address  = GetProcAddress (module, symbol);
1269          if (handle->handle && shl_findsym((shl_t*) &(handle->handle),  
1270              symbol, TYPE_UNDEFINED, &address) == 0)    if (!address)
1271                  if (address)      {
1272                          return address;        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND));
1273          last_error = symbol_error;      }
1274          return 0;  
1275      return address;
1276  }  }
1277    
1278  static  static struct lt_user_dlloader sys_wll = {
1279  lt_dltype_t    0, sys_wll_open, sys_wll_close, sys_wll_sym, 0, 0
1280  sys_shl = { LTDL_TYPE_TOP, 0, sys_shl_init, sys_shl_exit,  };
         sys_shl_open, sys_shl_close, sys_shl_sym };  
1281    
1282  #undef LTDL_TYPE_TOP  #endif /* __WINDOWS__ */
1283  #define LTDL_TYPE_TOP &sys_shl  
1284    
1285    
1286    
1287    /* --- LOAD_ADD_ON() INTERFACE LOADER --- */
1288    
1289    
1290    #ifdef __BEOS__
1291    
1292    /* dynamic linking for BeOS */
1293    
1294    #include <kernel/image.h>
1295    
1296    static lt_module
1297    sys_bedl_open (loader_data, filename)
1298         lt_user_data loader_data;
1299         const char *filename;
1300    {
1301      image_id image = 0;
1302    
1303      if (filename)
1304        {
1305          image = load_add_on (filename);
1306        }
1307      else
1308        {
1309          image_info info;
1310          int32 cookie = 0;
1311          if (get_next_image_info (0, &cookie, &info) == B_OK)
1312            image = load_add_on (info.name);
1313        }
1314    
1315      if (image <= 0)
1316        {
1317          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN));
1318          image = 0;
1319        }
1320    
1321      return (lt_module) image;
1322    }
1323    
1324    static int
1325    sys_bedl_close (loader_data, module)
1326         lt_user_data loader_data;
1327         lt_module module;
1328    {
1329      int errors = 0;
1330    
1331      if (unload_add_on ((image_id) module) != B_OK)
1332        {
1333          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE));
1334          ++errors;
1335        }
1336    
1337      return errors;
1338    }
1339    
1340    static lt_ptr
1341    sys_bedl_sym (loader_data, module, symbol)
1342         lt_user_data loader_data;
1343         lt_module module;
1344         const char *symbol;
1345    {
1346      lt_ptr address = 0;
1347      image_id image = (image_id) module;
1348    
1349      if (get_image_symbol (image, symbol, B_SYMBOL_TYPE_ANY, address) != B_OK)
1350        {
1351          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND));
1352          address = 0;
1353        }
1354    
1355      return address;
1356    }
1357    
1358    static struct lt_user_dlloader sys_bedl = {
1359      0, sys_bedl_open, sys_bedl_close, sys_bedl_sym, 0, 0
1360    };
1361    
1362    #endif /* __BEOS__ */
1363    
1364    
1365    
1366    
1367    /* --- DLD_LINK() INTERFACE LOADER --- */
1368    
 #endif  
1369    
1370  #if HAVE_DLD  #if HAVE_DLD
1371    
# Line 433  sys_shl = { LTDL_TYPE_TOP, 0, sys_shl_in Line 1375  sys_shl = { LTDL_TYPE_TOP, 0, sys_shl_in
1375  #include <dld.h>  #include <dld.h>
1376  #endif  #endif
1377    
1378  static int  static lt_module
1379  sys_dld_init LTDL_PARAMS((void))  sys_dld_open (loader_data, filename)
1380         lt_user_data loader_data;
1381         const char *filename;
1382  {  {
1383          return 0;    lt_module module = strdup (filename);
 }  
1384    
1385  static int    if (dld_link (filename) != 0)
1386  sys_dld_exit LTDL_PARAMS((void))      {
1387  {        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN));
1388          return 0;        LT_DLFREE (module);
1389  }        module = 0;
1390        }
1391    
1392  static int    return module;
 sys_dld_open (handle, filename)  
         lt_dlhandle handle;  
         const char *filename;  
 {  
         handle->handle = strdup(filename);  
         if (!handle->handle) {  
                 last_error = memory_error;  
                 return 1;  
         }  
         if (dld_link(filename) != 0) {  
                 last_error = cannot_open_error;  
                 lt_dlfree(handle->handle);  
                 return 1;  
         }  
         return 0;  
1393  }  }
1394    
1395  static int  static int
1396  sys_dld_close (handle)  sys_dld_close (loader_data, module)
1397          lt_dlhandle handle;       lt_user_data loader_data;
1398         lt_module module;
1399  {  {
1400          if (dld_unlink_by_file((char*)(handle->handle), 1) != 0) {    int errors = 0;
1401                  last_error = cannot_close_error;  
1402                  return 1;    if (dld_unlink_by_file ((char*)(module), 1) != 0)
1403          }      {
1404          lt_dlfree(handle->filename);        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE));
1405          return 0;        ++errors;
1406        }
1407      else
1408        {
1409          LT_DLFREE (module);
1410        }
1411    
1412      return errors;
1413  }  }
1414    
1415  static lt_ptr_t  static lt_ptr
1416  sys_dld_sym (handle, symbol)  sys_dld_sym (loader_data, module, symbol)
1417          lt_dlhandle handle;       lt_user_data loader_data;
1418          const char *symbol;       lt_module module;
1419         const char *symbol;
1420  {  {
1421          lt_ptr_t address = dld_get_func(symbol);    lt_ptr address = dld_get_func (symbol);
1422            
1423          if (!address)    if (!address)
1424                  last_error = symbol_error;      {
1425          return address;        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND));
1426        }
1427    
1428      return address;
1429  }  }
1430    
1431  static  static struct lt_user_dlloader sys_dld = {
1432  lt_dltype_t    0, sys_dld_open, sys_dld_close, sys_dld_sym, 0, 0
1433  sys_dld = { LTDL_TYPE_TOP, 0, sys_dld_init, sys_dld_exit,  };
         sys_dld_open, sys_dld_close, sys_dld_sym };  
1434    
1435  #undef LTDL_TYPE_TOP  #endif /* HAVE_DLD */
 #define LTDL_TYPE_TOP &sys_dld  
1436    
 #endif  
1437    
 #ifdef _WIN32  
1438    
1439  /* dynamic linking for Win32 */  
1440    /* --- DLPREOPEN() INTERFACE LOADER --- */
1441    
1442  #include <windows.h>  
1443    /* emulate dynamic linking using preloaded_symbols */
1444    
1445    typedef struct scm_lt_dlsymlists_t
1446    {
1447      struct scm_lt_dlsymlists_t       *next;
1448      const scm_lt_dlsymlist               *syms;
1449    } scm_lt_dlsymlists_t;
1450    
1451    static  const scm_lt_dlsymlist     *default_preloaded_symbols   = 0;
1452    static  scm_lt_dlsymlists_t            *preloaded_symbols               = 0;
1453    
1454  static int  static int
1455  sys_wll_init LTDL_PARAMS((void))  presym_init (loader_data)
1456         lt_user_data loader_data;
1457  {  {
1458          return 0;    int errors = 0;
1459    
1460      LT_DLMUTEX_LOCK ();
1461    
1462      preloaded_symbols = 0;
1463      if (default_preloaded_symbols)
1464        {
1465          errors = scm_lt_dlpreload (default_preloaded_symbols);
1466        }
1467    
1468      LT_DLMUTEX_UNLOCK ();
1469    
1470      return errors;
1471  }  }
1472    
1473  static int  static int
1474  sys_wll_exit LTDL_PARAMS((void))  presym_free_symlists ()
1475  {  {
1476          return 0;    scm_lt_dlsymlists_t *lists;
 }  
1477    
1478  /* Forward declaration; required to implement handle search below. */    LT_DLMUTEX_LOCK ();
 static lt_dlhandle handles;  
1479    
1480  static int    lists = preloaded_symbols;
1481  sys_wll_open (handle, filename)    while (lists)
1482          lt_dlhandle handle;      {
1483          const char *filename;        scm_lt_dlsymlists_t       *tmp = lists;
 {  
         lt_dlhandle cur;  
         char *searchname = NULL;  
         char *ext = strrchr(filename, '.');  
   
         if (ext) {  
                 /* FILENAME already has an extension. */  
                 searchname = strdup(filename);  
         } else {  
                 /* Append a `.' to stop Windows from adding an  
                    implicit `.dll' extension. */  
                 searchname = (char*)lt_dlmalloc(2+ strlen(filename));  
                 strcpy(searchname, filename);  
                 strcat(searchname, ".");  
         }  
       
         handle->handle = LoadLibrary(searchname);  
         lt_dlfree(searchname);  
           
         /* libltdl expects this function to fail if it is unable  
            to physically load the library.  Sadly, LoadLibrary  
            will search the loaded libraries for a match and return  
            one of them if the path search load fails.  
   
            We check whether LoadLibrary is returning a handle to  
            an already loaded module, and simulate failure if we  
            find one. */  
         cur = handles;  
         while (cur) {  
                 if (!cur->handle) {  
                         cur = 0;  
                         break;  
                 }  
                 if (cur->handle == handle->handle)  
                         break;  
                 cur = cur->next;  
         }  
1484    
1485          if (cur || !handle->handle) {        lists = lists->next;
1486                  last_error = cannot_open_error;        LT_DLFREE (tmp);
1487                  return 1;      }
1488          }    preloaded_symbols = 0;
1489    
1490          return 0;    LT_DLMUTEX_UNLOCK ();
1491    
1492      return 0;
1493  }  }
1494    
1495  static int  static int
1496  sys_wll_close (handle)  presym_exit (loader_data)
1497          lt_dlhandle handle;       lt_user_data loader_data;
1498  {  {
1499          if (FreeLibrary(handle->handle) == 0) {    presym_free_symlists ();
1500                  last_error = cannot_close_error;    return 0;
                 return 1;  
         }  
         return 0;  
1501  }  }
1502    
1503  static lt_ptr_t  static int
1504  sys_wll_sym (handle, symbol)  presym_add_symlist (preloaded)
1505          lt_dlhandle handle;       const scm_lt_dlsymlist *preloaded;
1506          const char *symbol;  {
1507  {    scm_lt_dlsymlists_t *tmp;
1508          lt_ptr_t address = GetProcAddress(handle->handle, symbol);    scm_lt_dlsymlists_t *lists;
1509              int              errors   = 0;
1510          if (!address)  
1511                  last_error = symbol_error;    LT_DLMUTEX_LOCK ();
1512          return address;  
1513  }    lists = preloaded_symbols;
1514      while (lists)
1515  static      {
1516  lt_dltype_t        if (lists->syms == preloaded)
1517  sys_wll = { LTDL_TYPE_TOP, 0, sys_wll_init, sys_wll_exit,          {
1518          sys_wll_open, sys_wll_close, sys_wll_sym };            goto done;
1519            }
1520          lists = lists->next;
1521        }
1522    
1523      tmp = LT_EMALLOC (scm_lt_dlsymlists_t, 1);
1524      if (tmp)
1525        {
1526          memset (tmp, 0, sizeof(scm_lt_dlsymlists_t));
1527          tmp->syms = preloaded;
1528          tmp->next = preloaded_symbols;
1529          preloaded_symbols = tmp;
1530        }
1531      else
1532        {
1533          ++errors;
1534        }
1535    
1536     done:
1537      LT_DLMUTEX_UNLOCK ();
1538      return errors;
1539    }
1540    
1541    static lt_module
1542    presym_open (loader_data, filename)
1543         lt_user_data loader_data;
1544         const char *filename;
1545    {
1546      scm_lt_dlsymlists_t *lists;
1547      lt_module        module = (lt_module) 0;
1548    
1549      LT_DLMUTEX_LOCK ();
1550      lists = preloaded_symbols;
1551    
1552      if (!lists)
1553        {
1554          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_SYMBOLS));
1555          goto done;
1556        }
1557    
1558      /* Can't use NULL as the reflective symbol header, as NULL is
1559         used to mark the end of the entire symbol list.  Self-dlpreopened
1560         symbols follow this magic number, chosen to be an unlikely
1561         clash with a real module name.  */
1562      if (!filename)
1563        {
1564          filename = "@PROGRAM@";
1565        }
1566    
1567      while (lists)
1568        {
1569          const scm_lt_dlsymlist *syms = lists->syms;
1570    
1571          while (syms->name)
1572            {
1573              if (!syms->address && strcmp(syms->name, filename) == 0)
1574                {
1575                  module = (lt_module) syms;
1576                  goto done;
1577                }
1578              ++syms;
1579            }
1580    
1581          lists = lists->next;
1582        }
1583    
1584      LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND));
1585    
1586     done:
1587      LT_DLMUTEX_UNLOCK ();
1588      return module;
1589    }
1590    
1591    static int
1592    presym_close (loader_data, module)
1593         lt_user_data loader_data;
1594         lt_module module;
1595    {
1596      /* Just to silence gcc -Wall */
1597      module = 0;
1598      return 0;
1599    }
1600    
1601    static lt_ptr
1602    presym_sym (loader_data, module, symbol)
1603         lt_user_data loader_data;
1604         lt_module module;
1605         const char *symbol;
1606    {
1607      scm_lt_dlsymlist *syms = (scm_lt_dlsymlist*) module;
1608    
1609      ++syms;
1610      while (syms->address)
1611        {
1612          if (strcmp(syms->name, symbol) == 0)
1613            {
1614              return syms->address;
1615            }
1616    
1617        ++syms;
1618      }
1619    
1620      LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND));
1621    
1622      return 0;
1623    }
1624    
1625    static struct lt_user_dlloader presym = {
1626      0, presym_open, presym_close, presym_sym, presym_exit, 0
1627    };
1628    
1629    
1630    
1631    
1632    
1633    /* --- DYNAMIC MODULE LOADING --- */
1634    
1635    
1636    /* The type of a function used at each iteration of  foreach_dirinpath().  */
1637    typedef int     foreach_callback_func LT_PARAMS((char *filename, lt_ptr data1,
1638                                                     lt_ptr data2));
1639    
1640    static  int     foreach_dirinpath     LT_PARAMS((const char *search_path,
1641                                                     const char *base_name,
1642                                                     foreach_callback_func *func,
1643                                                     lt_ptr data1, lt_ptr data2));
1644    
1645    static  int     find_file_callback    LT_PARAMS((char *filename, lt_ptr data,
1646                                                     lt_ptr ignored));
1647    static  int     find_handle_callback  LT_PARAMS((char *filename, lt_ptr data,
1648                                                     lt_ptr ignored));
1649    static  int     foreachfile_callback  LT_PARAMS((char *filename, lt_ptr data1,
1650                                                     lt_ptr data2));
1651    
1652    
1653    static  int     canonicalize_path     LT_PARAMS((const char *path,
1654                                                     char **pcanonical));
1655    static  int     argzize_path          LT_PARAMS((const char *path,
1656                                                     char **pargz,
1657                                                     size_t *pargz_len));
1658    static  FILE   *find_file             LT_PARAMS((const char *search_path,
1659                                                     const char *base_name,
1660                                                     char **pdir));
1661    static  lt_dlhandle *find_handle      LT_PARAMS((const char *search_path,
1662                                                     const char *base_name,
1663                                                     lt_dlhandle *handle));
1664    static  int     find_module           LT_PARAMS((lt_dlhandle *handle,
1665                                                     const char *dir,
1666                                                     const char *libdir,
1667                                                     const char *dlname,
1668                                                     const char *old_name,
1669                                                     int installed));
1670    static  int     free_vars             LT_PARAMS((char *dlname, char *oldname,
1671                                                     char *libdir, char *deplibs));
1672    static  int     load_deplibs          LT_PARAMS((lt_dlhandle handle,
1673                                                     char *deplibs));
1674    static  int     trim                  LT_PARAMS((char **dest,
1675                                                     const char *str));
1676    static  int     try_dlopen            LT_PARAMS((lt_dlhandle *handle,
1677                                                     const char *filename));
1678    static  int     tryall_dlopen         LT_PARAMS((lt_dlhandle *handle,
1679                                                     const char *filename));
1680    static  int     unload_deplibs        LT_PARAMS((lt_dlhandle handle));
1681    static  int     lt_argz_insert        LT_PARAMS((char **pargz,
1682                                                     size_t *pargz_len,
1683                                                     char *before,
1684                                                     const char *entry));
1685    static  int     lt_argz_insertinorder LT_PARAMS((char **pargz,
1686                                                     size_t *pargz_len,
1687                                                     const char *entry));
1688    static  int     lt_dlpath_insertdir   LT_PARAMS((char **ppath,
1689                                                     char *before,
1690                                                     const char *dir));
1691    
1692    static  char           *user_search_path= 0;
1693    static  lt_dlloader    *loaders         = 0;
1694    static  lt_dlhandle     handles         = 0;
1695    static  int             initialized     = 0;
1696    
1697    /* Initialize libltdl. */
1698    int
1699    scm_lt_dlinit ()
1700    {
1701      int         errors   = 0;
1702    
1703  #undef LTDL_TYPE_TOP    LT_DLMUTEX_LOCK ();
 #define LTDL_TYPE_TOP &sys_wll  
1704    
1705  #endif    /* Initialize only at first call. */
1706      if (++initialized == 1)
1707        {
1708          handles = 0;
1709          user_search_path = 0; /* empty search path */
1710    
1711    #if HAVE_LIBDL && !defined(__CYGWIN__)
1712          errors += scm_lt_dlloader_add (scm_lt_dlloader_next (0), &sys_dl, "dlopen");
1713    #endif
1714    #if HAVE_SHL_LOAD
1715          errors += scm_lt_dlloader_add (scm_lt_dlloader_next (0), &sys_shl, "dlopen");
1716    #endif
1717    #ifdef __WINDOWS__
1718          errors += scm_lt_dlloader_add (scm_lt_dlloader_next (0), &sys_wll, "dlopen");
1719    #endif
1720  #ifdef __BEOS__  #ifdef __BEOS__
1721          errors += scm_lt_dlloader_add (scm_lt_dlloader_next (0), &sys_bedl, "dlopen");
1722    #endif
1723    #if HAVE_DLD
1724          errors += scm_lt_dlloader_add (scm_lt_dlloader_next (0), &sys_dld, "dld");
1725    #endif
1726          errors += scm_lt_dlloader_add (scm_lt_dlloader_next (0), &presym, "dlpreload");
1727    
1728  /* dynamic linking for BeOS */        if (presym_init (presym.dlloader_data))
1729            {
1730              LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INIT_LOADER));
1731              ++errors;
1732            }
1733          else if (errors != 0)
1734            {
1735              LT_DLMUTEX_SETERROR (LT_DLSTRERROR (DLOPEN_NOT_SUPPORTED));
1736              ++errors;
1737            }
1738        }
1739    
1740  #include <kernel/image.h>    LT_DLMUTEX_UNLOCK ();
1741    
1742  static int    return errors;
1743  sys_bedl_init LTDL_PARAMS((void))  }
1744    
1745    int
1746    scm_lt_dlpreload (preloaded)
1747         const scm_lt_dlsymlist *preloaded;
1748  {  {
1749          return 0;    int errors = 0;
1750    
1751      if (preloaded)
1752        {
1753          errors = presym_add_symlist (preloaded);
1754        }
1755      else
1756        {
1757          presym_free_symlists();
1758    
1759          LT_DLMUTEX_LOCK ();
1760          if (default_preloaded_symbols)
1761            {
1762              errors = scm_lt_dlpreload (default_preloaded_symbols);
1763            }
1764          LT_DLMUTEX_UNLOCK ();
1765        }
1766    
1767      return errors;
1768  }  }
1769    
1770  static int  int
1771  sys_bedl_exit LTDL_PARAMS((void))  scm_lt_dlpreload_default (preloaded)
1772         const scm_lt_dlsymlist *preloaded;
1773  {  {
1774          return 0;    LT_DLMUTEX_LOCK ();
1775      default_preloaded_symbols = preloaded;
1776      LT_DLMUTEX_UNLOCK ();
1777      return 0;
1778  }  }
1779    
1780  static int  int
1781  sys_bedl_open (handle, filename)  scm_lt_dlexit ()
1782          lt_dlhandle handle;  {
1783          const char *filename;    /* shut down libltdl */
1784  {    lt_dlloader *loader;
1785          image_id image = 0;    int          errors   = 0;
1786            
1787          if (filename) {    LT_DLMUTEX_LOCK ();
1788                  image = load_add_on(filename);    loader = loaders;
1789          } else {  
1790                  image_info info;    if (!initialized)
1791                  int32 cookie = 0;      {
1792                  if (get_next_image_info(0, &cookie, &info) == B_OK)        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SHUTDOWN));
1793                          image = load_add_on(info.name);        ++errors;
1794          }        goto done;
1795          if (image <= 0) {      }
1796                  last_error = cannot_open_error;  
1797                  return 1;    /* shut down only at last call. */
1798          }    if (--initialized == 0)
1799          handle->handle = (void*) image;      {
1800          return 0;        int       level;
1801    
1802          while (handles && LT_DLIS_RESIDENT (handles))
1803            {
1804              handles = handles->next;
1805            }
1806    
1807          /* close all modules */
1808          for (level = 1; handles; ++level)
1809            {
1810              lt_dlhandle cur = handles;
1811              int saw_nonresident = 0;
1812    
1813              while (cur)
1814                {
1815                  lt_dlhandle tmp = cur;
1816                  cur = cur->next;
1817                  if (!LT_DLIS_RESIDENT (tmp))
1818                    saw_nonresident = 1;
1819                  if (!LT_DLIS_RESIDENT (tmp) && tmp->info.ref_count <= level)
1820                    {
1821                      if (scm_lt_dlclose (tmp))
1822                        {
1823                          ++errors;
1824                        }
1825                    }
1826                }
1827              /* done if only resident modules are left */
1828              if (!saw_nonresident)
1829                break;
1830            }
1831    
1832          /* close all loaders */
1833          while (loader)
1834            {
1835              lt_dlloader *next = loader->next;
1836              lt_user_data data = loader->dlloader_data;
1837              if (loader->dlloader_exit && loader->dlloader_exit (data))
1838                {
1839                  ++errors;
1840                }
1841    
1842              LT_DLMEM_REASSIGN (loader, next);
1843            }
1844          loaders = 0;
1845        }
1846    
1847     done:
1848      LT_DLMUTEX_UNLOCK ();
1849      return errors;
1850  }  }
1851    
1852  static int  static int
1853  sys_bedl_close (handle)  tryall_dlopen (handle, filename)
1854          lt_dlhandle handle;       lt_dlhandle *handle;
1855         const char *filename;
1856  {  {
1857          if (unload_add_on((image_id)handle->handle) != B_OK) {    lt_dlhandle    cur;
1858                  last_error = cannot_close_error;    lt_dlloader   *loader;
1859                  return 1;    const char    *saved_error;
1860          }    int            errors         = 0;
1861          return 0;  
1862      LT_DLMUTEX_GETERROR (saved_error);
1863      LT_DLMUTEX_LOCK ();
1864    
1865      cur    = handles;
1866      loader = loaders;
1867    
1868      /* check whether the module was already opened */
1869      while (cur)
1870        {
1871          /* try to dlopen the program itself? */
1872          if (!cur->info.filename && !filename)
1873            {
1874              break;
1875            }
1876    
1877          if (cur->info.filename && filename
1878              && strcmp (cur->info.filename, filename) == 0)
1879            {
1880              break;
1881            }
1882    
1883          cur = cur->next;
1884        }
1885    
1886      if (cur)
1887        {
1888          ++cur->info.ref_count;
1889          *handle = cur;
1890          goto done;
1891        }
1892    
1893      cur = *handle;
1894      if (filename)
1895        {
1896          cur->info.filename = lt_estrdup (filename);
1897          if (!cur->info.filename)
1898            {
1899              ++errors;
1900              goto done;
1901            }
1902        }
1903      else
1904        {
1905          cur->info.filename = 0;
1906        }
1907    
1908      while (loader)
1909        {
1910          lt_user_data data = loader->dlloader_data;
1911    
1912          cur->module = loader->module_open (data, filename);
1913    
1914          if (cur->module != 0)
1915            {
1916              break;
1917            }
1918          loader = loader->next;
1919        }
1920    
1921      if (!loader)
1922        {
1923          LT_DLFREE (cur->info.filename);
1924          ++errors;
1925          goto done;
1926        }
1927    
1928      cur->loader   = loader;
1929      LT_DLMUTEX_SETERROR (saved_error);
1930    
1931     done:
1932      LT_DLMUTEX_UNLOCK ();
1933    
1934      return errors;
1935    }
1936    
1937    static int
1938    tryall_dlopen_module (handle, prefix, dirname, dlname)
1939         lt_dlhandle *handle;
1940         const char *prefix;
1941         const char *dirname;
1942         const char *dlname;
1943    {
1944      int      error        = 0;
1945      char     *filename    = 0;
1946      size_t   filename_len = 0;
1947      size_t   dirname_len  = LT_STRLEN (dirname);
1948    
1949      assert (handle);
1950      assert (dirname);
1951      assert (dlname);
1952    #ifdef LT_DIRSEP_CHAR
1953      /* Only canonicalized names (i.e. with DIRSEP chars already converted)
1954         should make it into this function:  */
1955      assert (strchr (dirname, LT_DIRSEP_CHAR) == 0);
1956    #endif
1957    
1958      if (dirname[dirname_len -1] == '/')
1959        --dirname_len;
1960      filename_len = dirname_len + 1 + LT_STRLEN (dlname);
1961    
1962      /* Allocate memory, and combine DIRNAME and MODULENAME into it.
1963         The PREFIX (if any) is handled below.  */
1964      filename  = LT_EMALLOC (char, dirname_len + 1 + filename_len + 1);
1965      if (!filename)
1966        return 1;
1967    
1968      sprintf (filename, "%.*s/%s", (int) dirname_len, dirname, dlname);
1969    
1970      /* Now that we have combined DIRNAME and MODULENAME, if there is
1971         also a PREFIX to contend with, simply recurse with the arguments
1972         shuffled.  Otherwise, attempt to open FILENAME as a module.  */
1973      if (prefix)
1974        {
1975          error += tryall_dlopen_module (handle,
1976                                         (const char *) 0, prefix, filename);
1977        }
1978      else if (tryall_dlopen (handle, filename) != 0)
1979        {
1980          ++error;
1981        }
1982    
1983      LT_DLFREE (filename);
1984      return error;
1985  }  }
1986    
1987  static lt_ptr_t  static int
1988  sys_bedl_sym (handle, symbol)  find_module (handle, dir, libdir, dlname, old_name, installed)
1989          lt_dlhandle handle;       lt_dlhandle *handle;
1990          const char *symbol;       const char *dir;
1991  {       const char *libdir;
1992          lt_ptr_t address = 0;       const char *dlname;
1993          image_id image = (image_id)handle->handle;       const char *old_name;
1994           int installed;
1995          if (get_image_symbol(image, symbol, B_SYMBOL_TYPE_ANY,  {
1996                  &address) != B_OK) {    /* Try to open the old library first; if it was dlpreopened,
1997                  last_error = symbol_error;       we want the preopened version of it, even if a dlopenable
1998                  return 0;       module is available.  */
1999          }    if (old_name && tryall_dlopen (handle, old_name) == 0)
2000          return address;      {
2001  }        return 0;
2002        }
2003  static  
2004  lt_dltype_t    /* Try to open the dynamic library.  */
2005  sys_bedl = { LTDL_TYPE_TOP, 0, sys_bedl_init, sys_bedl_exit,    if (dlname)
2006          sys_bedl_open, sys_bedl_close, sys_bedl_sym };      {
2007          /* try to open the installed module */
2008          if (installed && libdir)
2009            {
2010              if (tryall_dlopen_module (handle,
2011                                        (const char *) 0, libdir, dlname) == 0)
2012                return 0;
2013            }
2014    
2015          /* try to open the not-installed module */
2016          if (!installed)
2017            {
2018              if (tryall_dlopen_module (handle, dir, objdir, dlname) == 0)
2019                return 0;
2020            }
2021    
2022          /* maybe it was moved to another directory */
2023          {
2024              if (tryall_dlopen_module (handle,
2025                                        (const char *) 0, dir, dlname) == 0)
2026                return 0;
2027          }
2028        }
2029    
2030      return 1;
2031    }
2032    
2033    
2034    static int
2035    canonicalize_path (path, pcanonical)
2036         const char *path;
2037         char **pcanonical;
2038    {
2039      char *canonical = 0;
2040    
2041      assert (path && *path);
2042      assert (pcanonical);
2043    
2044      canonical = LT_EMALLOC (char, 1+ LT_STRLEN (path));
2045      if (!canonical)
2046        return 1;
2047    
2048      {
2049        size_t dest = 0;
2050        size_t src;
2051        for (src = 0; path[src] != LT_EOS_CHAR; ++src)
2052          {
2053            /* Path separators are not copied to the beginning or end of
2054               the destination, or if another separator would follow
2055               immediately.  */
2056            if (path[src] == LT_PATHSEP_CHAR)
2057              {
2058                if ((dest == 0)
2059                    || (path[1+ src] == LT_PATHSEP_CHAR)
2060                    || (path[1+ src] == LT_EOS_CHAR))
2061                  continue;
2062              }
2063    
2064            /* Anything other than a directory separator is copied verbatim.  */
2065            if ((path[src] != '/')
2066    #ifdef LT_DIRSEP_CHAR
2067                && (path[src] != LT_DIRSEP_CHAR)
2068    #endif
2069                )
2070              {
2071                canonical[dest++] = path[src];
2072              }
2073            /* Directory separators are converted and copied only if they are
2074               not at the end of a path -- i.e. before a path separator or
2075               NULL terminator.  */
2076            else if ((path[1+ src] != LT_PATHSEP_CHAR)
2077                     && (path[1+ src] != LT_EOS_CHAR)
2078    #ifdef LT_DIRSEP_CHAR
2079                     && (path[1+ src] != LT_DIRSEP_CHAR)
2080    #endif
2081                     && (path[1+ src] != '/'))
2082              {
2083                canonical[dest++] = '/';
2084              }
2085          }
2086    
2087        /* Add an end-of-string marker at the end.  */
2088        canonical[dest] = LT_EOS_CHAR;
2089      }
2090    
2091      /* Assign new value.  */
2092      *pcanonical = canonical;
2093    
2094      return 0;
2095    }
2096    
2097    static int
2098    argzize_path (path, pargz, pargz_len)
2099         const char *path;
2100         char **pargz;
2101         size_t *pargz_len;
2102    {
2103      error_t error;
2104    
2105      assert (path);
2106      assert (pargz);
2107      assert (pargz_len);
2108    
2109      if ((error = argz_create_sep (path, LT_PATHSEP_CHAR, pargz, pargz_len)))
2110        {
2111          switch (error)
2112            {
2113            case ENOMEM:
2114              LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY));
2115              break;
2116            default:
2117              LT_DLMUTEX_SETERROR (LT_DLSTRERROR (UNKNOWN));
2118              break;
2119            }
2120    
2121          return 1;
2122        }
2123    
2124      return 0;
2125    }
2126    
2127    /* Repeatedly call FUNC with each LT_PATHSEP_CHAR delimited element
2128       of SEARCH_PATH and references to DATA1 and DATA2, until FUNC returns
2129       non-zero or all elements are exhausted.  If BASE_NAME is non-NULL,
2130       it is appended to each SEARCH_PATH element before FUNC is called.  */
2131    static int
2132    foreach_dirinpath (search_path, base_name, func, data1, data2)
2133         const char *search_path;
2134         const char *base_name;
2135         foreach_callback_func *func;
2136         lt_ptr data1;
2137         lt_ptr data2;
2138    {
2139      int    result         = 0;
2140      int    filenamesize   = 0;
2141      int    lenbase        = LT_STRLEN (base_name);
2142      size_t argz_len       = 0;
2143      char * argz           = 0;
2144      char * filename       = 0;
2145      char * canonical      = 0;
2146    
2147      LT_DLMUTEX_LOCK ();
2148    
2149      if (!search_path || !*search_path)
2150        {
2151          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND));
2152          goto cleanup;
2153        }
2154    
2155      if (canonicalize_path (search_path, &canonical) != 0)
2156        goto cleanup;
2157    
2158      if (argzize_path (canonical, &argz, &argz_len) != 0)
2159        goto cleanup;
2160    
2161      {
2162        char *dir_name = 0;
2163        while ((dir_name = argz_next (argz, argz_len, dir_name)))
2164          {
2165            int lendir = LT_STRLEN (dir_name);
2166    
2167            if (lendir +1 +lenbase >= filenamesize)
2168            {
2169              LT_DLFREE (filename);
2170              filenamesize  = lendir +1 +lenbase +1; /* "/d" + '/' + "f" + '\0' */
2171              filename      = LT_EMALLOC (char, filenamesize);
2172              if (!filename)
2173                goto cleanup;
2174            }
2175    
2176            strncpy (filename, dir_name, lendir);
2177            if (base_name && *base_name)
2178              {
2179                if (filename[lendir -1] != '/')
2180                  filename[lendir++] = '/';
2181                strcpy (filename +lendir, base_name);
2182              }
2183    
2184            if ((result = (*func) (filename, data1, data2)))
2185              {
2186                break;
2187              }
2188          }
2189      }
2190    
2191     cleanup:
2192      LT_DLFREE (argz);
2193      LT_DLFREE (canonical);
2194      LT_DLFREE (filename);
2195    
2196      LT_DLMUTEX_UNLOCK ();
2197    
2198      return result;
2199    }
2200    
2201    /* If FILEPATH can be opened, store the name of the directory component
2202       in DATA1, and the opened FILE* structure address in DATA2.  Otherwise
2203       DATA1 is unchanged, but DATA2 is set to a pointer to NULL.  */
2204    static int
2205    find_file_callback (filename, data1, data2)
2206         char *filename;
2207         lt_ptr data1;
2208         lt_ptr data2;
2209    {
2210      char       **pdir     = (char **) data1;
2211      FILE       **pfile    = (FILE **) data2;
2212      int        is_done    = 0;
2213    
2214      assert (filename && *filename);
2215      assert (pdir);
2216      assert (pfile);
2217    
2218      if ((*pfile = fopen (filename, LT_READTEXT_MODE)))
2219        {
2220          char *dirend = strrchr (filename, '/');
2221    
2222          if (dirend > filename)
2223            *dirend   = LT_EOS_CHAR;
2224    
2225          LT_DLFREE (*pdir);
2226          *pdir   = lt_estrdup (filename);
2227          is_done = (*pdir == 0) ? -1 : 1;
2228        }
2229    
2230      return is_done;
2231    }
2232    
2233    static FILE *
2234    find_file (search_path, base_name, pdir)
2235         const char *search_path;
2236         const char *base_name;
2237         char **pdir;
2238    {
2239      FILE *file = 0;
2240    
2241      foreach_dirinpath (search_path, base_name, find_file_callback, pdir, &file);
2242    
2243      return file;
2244    }
2245    
2246    static int
2247    find_handle_callback (filename, data, ignored)
2248         char *filename;
2249         lt_ptr data;
2250         lt_ptr ignored;
2251    {
2252      lt_dlhandle  *handle  = (lt_dlhandle *) data;
2253      int           found   = !access (filename, F_OK);
2254    
2255      /* Bail out if file cannot be read...  */
2256      if (!found)
2257        return 0;
2258    
2259      /* Try to dlopen the file, but do not continue searching in any
2260         case.  */
2261      if (tryall_dlopen (handle, filename) != 0)
2262        *handle = 0;
2263    
2264      return 1;
2265    }
2266    
2267    /* If HANDLE was found return it, otherwise return 0.  If HANDLE was
2268       found but could not be opened, *HANDLE will be set to 0.  */
2269    static lt_dlhandle *
2270    find_handle (search_path, base_name, handle)
2271         const char *search_path;
2272         const char *base_name;
2273         lt_dlhandle *handle;
2274    {
2275      if (!search_path)
2276        return 0;
2277    
2278      if (!foreach_dirinpath (search_path, base_name, find_handle_callback,
2279                              handle, 0))
2280        return 0;
2281    
2282      return handle;
2283    }
2284    
2285    static int
2286    load_deplibs (handle, deplibs)
2287         lt_dlhandle handle;
2288         char *deplibs;
2289    {
2290    #if LTDL_DLOPEN_DEPLIBS
2291      char  *p, *save_search_path = 0;
2292      int   depcount = 0;
2293      int   i;
2294      char  **names = 0;
2295    #endif
2296      int   errors = 0;
2297    
2298      handle->depcount = 0;
2299    
2300    #if LTDL_DLOPEN_DEPLIBS
2301      if (!deplibs)
2302        {
2303          return errors;
2304        }
2305      ++errors;
2306    
2307      LT_DLMUTEX_LOCK ();
2308      if (user_search_path)
2309        {
2310          save_search_path = lt_estrdup (user_search_path);
2311          if (!save_search_path)
2312            goto cleanup;
2313        }
2314    
2315      /* extract search paths and count deplibs */
2316      p = deplibs;
2317      while (*p)
2318        {
2319          if (!isspace ((int) *p))
2320            {
2321              char *end = p+1;
2322              while (*end && !isspace((int) *end))
2323                {
2324                  ++end;
2325                }
2326    
2327              if (strncmp(p, "-L", 2) == 0 || strncmp(p, "-R", 2) == 0)
2328                {
2329                  char save = *end;
2330                  *end = 0; /* set a temporary string terminator */
2331                  if (scm_lt_dladdsearchdir(p+2))
2332                    {
2333                      goto cleanup;
2334                    }
2335                  *end = save;
2336                }
2337              else
2338                {
2339                  ++depcount;
2340                }
2341    
2342              p = end;
2343            }
2344          else
2345            {
2346              ++p;
2347            }
2348        }
2349    
2350      /* restore the old search path */
2351      LT_DLFREE (user_search_path);
2352      user_search_path = save_search_path;
2353    
2354      LT_DLMUTEX_UNLOCK ();
2355    
2356      if (!depcount)
2357        {
2358          errors = 0;
2359          goto cleanup;
2360        }
2361    
2362      names = LT_EMALLOC (char *, depcount * sizeof (char*));
2363      if (!names)
2364        goto cleanup;
2365    
2366      /* now only extract the actual deplibs */
2367      depcount = 0;
2368      p = deplibs;
2369      while (*p)
2370        {
2371          if (isspace ((int) *p))
2372            {
2373              ++p;
2374            }
2375          else
2376            {
2377              char *end = p+1;
2378              while (*end && !isspace ((int) *end))
2379                {
2380                  ++end;
2381                }
2382    
2383              if (strncmp(p, "-L", 2) != 0 && strncmp(p, "-R", 2) != 0)
2384                {
2385                  char *name;
2386                  char save = *end;
2387                  *end = 0; /* set a temporary string terminator */
2388                  if (strncmp(p, "-l", 2) == 0)
2389                    {
2390                      size_t name_len = 3+ /* "lib" */ LT_STRLEN (p + 2);
2391                      name = LT_EMALLOC (char, 1+ name_len);
2392                      if (name)
2393                        sprintf (name, "lib%s", p+2);
2394                    }
2395                  else
2396                    name = lt_estrdup(p);
2397    
2398  #undef LTDL_TYPE_TOP                if (!name)
2399  #define LTDL_TYPE_TOP &sys_bedl                  goto cleanup_names;
2400    
2401  #endif                names[depcount++] = name;
2402                  *end = save;
2403                }
2404              p = end;
2405            }
2406        }
2407    
2408  /* emulate dynamic linking using preloaded_symbols */    /* load the deplibs (in reverse order)
2409         At this stage, don't worry if the deplibs do not load correctly,
2410         they may already be statically linked into the loading application
2411         for instance.  There will be a more enlightening error message
2412         later on if the loaded module cannot resolve all of its symbols.  */
2413      if (depcount)
2414        {
2415          int       j = 0;
2416    
2417  typedef struct lt_dlsymlists_t {        handle->deplibs = (lt_dlhandle*) LT_EMALLOC (lt_dlhandle *, depcount);
2418          struct lt_dlsymlists_t *next;        if (!handle->deplibs)
2419          const lt_dlsymlist *syms;          goto cleanup;
 } lt_dlsymlists_t;  
2420    
2421  static const lt_dlsymlist *default_preloaded_symbols = 0;        for (i = 0; i < depcount; ++i)
2422  static lt_dlsymlists_t *preloaded_symbols = 0;          {
2423              handle->deplibs[j] = scm_lt_dlopenext(names[depcount-1-i]);
2424              if (handle->deplibs[j])
2425                {
2426                  ++j;
2427                }
2428            }
2429    
2430  static int        handle->depcount  = j;    /* Number of successfully loaded deplibs */
2431  presym_init LTDL_PARAMS((void))        errors            = 0;
2432  {      }
2433          preloaded_symbols = 0;  
2434          if (default_preloaded_symbols)   cleanup_names:
2435                  return lt_dlpreload(default_preloaded_symbols);    for (i = 0; i < depcount; ++i)
2436          return 0;      {
2437          LT_DLFREE (names[i]);
2438        }
2439    
2440     cleanup:
2441      LT_DLFREE (names);
2442    #endif
2443    
2444      return errors;
2445  }  }
2446    
2447  static int  static int
2448  presym_free_symlists LTDL_PARAMS((void))  unload_deplibs (handle)
2449         lt_dlhandle handle;
2450  {  {
2451          lt_dlsymlists_t *lists = preloaded_symbols;    int i;
2452              int errors = 0;
2453          while (lists) {  
2454                  lt_dlsymlists_t *tmp = lists;    if (handle->depcount)
2455                        {
2456                  lists = lists->next;        for (i = 0; i < handle->depcount; ++i)
2457                  lt_dlfree(tmp);          {
2458              if (!LT_DLIS_RESIDENT (handle->deplibs[i]))
2459                {
2460                  errors += scm_lt_dlclose (handle->deplibs[i]);
2461                }
2462          }          }
2463          preloaded_symbols = 0;      }
2464          return 0;  
2465      return errors;
2466  }  }
2467    
2468  static int  static int
2469  presym_exit LTDL_PARAMS((void))  trim (dest, str)
2470         char **dest;
2471         const char *str;
2472  {  {
2473          presym_free_symlists();    /* remove the leading and trailing "'" from str
2474          return 0;       and store the result in dest */
2475      const char *end   = strrchr (str, '\'');
2476      int   len         = LT_STRLEN (str);
2477      char *tmp;
2478    
2479      LT_DLFREE (*dest);
2480    
2481      if (len > 3 && str[0] == '\'')
2482        {
2483          tmp = LT_EMALLOC (char, end - str);
2484          if (!tmp)
2485            return 1;
2486    
2487          strncpy(tmp, &str[1], (end - str) - 1);
2488          tmp[len-3] = LT_EOS_CHAR;
2489          *dest = tmp;
2490        }
2491      else
2492        {
2493          *dest = 0;
2494        }
2495    
2496      return 0;
2497  }  }
2498    
2499  static int  static int
2500  presym_add_symlist (preloaded)  free_vars (dlname, oldname, libdir, deplibs)
2501          const lt_dlsymlist *preloaded;       char *dlname;
2502  {       char *oldname;
2503          lt_dlsymlists_t *tmp;       char *libdir;
2504          lt_dlsymlists_t *lists = preloaded_symbols;       char *deplibs;
2505            {
2506          while (lists) {    LT_DLFREE (dlname);
2507                  if (lists->syms == preloaded)    LT_DLFREE (oldname);
2508                          return 0;    LT_DLFREE (libdir);
2509                  lists = lists->next;    LT_DLFREE (deplibs);
2510          }  
2511      return 0;
         tmp = (lt_dlsymlists_t*) lt_dlmalloc(sizeof(lt_dlsymlists_t));  
         if (!tmp) {  
                 last_error = memory_error;  
                 return 1;  
         }  
         tmp->syms = preloaded;  
         tmp->next = 0;  
         if (!preloaded_symbols)  
                 preloaded_symbols = tmp;  
         else {  
                 /* append to the end */  
                 lists = preloaded_symbols;  
                 while (lists->next)  
                         lists = lists->next;  
                 lists->next = tmp;  
         }  
         return 0;  
2512  }  }
2513    
2514  static int  int
2515  presym_open (handle, filename)  try_dlopen (phandle, filename)
2516          lt_dlhandle handle;       lt_dlhandle *phandle;
2517          const char *filename;       const char *filename;
2518  {  {
2519          lt_dlsymlists_t *lists = preloaded_symbols;    const char *  ext             = 0;
2520      const char *  saved_error     = 0;
2521          if (!lists) {    char *        canonical       = 0;
2522                  last_error = no_symbols_error;    char *        base_name       = 0;
2523                  return 1;    char *        dir             = 0;
2524          }    char *        name            = 0;
2525          if (!filename)    int           errors          = 0;
2526                  filename = "@PROGRAM@";    lt_dlhandle   newhandle;
2527          while (lists) {  
2528                  const lt_dlsymlist *syms = lists->syms;    assert (phandle);
2529              assert (*phandle == 0);
2530                  while (syms->name) {  
2531                          if (!syms->address &&    LT_DLMUTEX_GETERROR (saved_error);
2532                              strcmp(syms->name, filename) == 0) {  
2533                                  handle->handle = (lt_ptr_t) syms;    /* dlopen self? */
2534                                  return 0;    if (!filename)
2535                          }      {
2536                          syms++;        *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1);
2537          if (*phandle == 0)
2538            return 1;
2539    
2540          memset (*phandle, 0, sizeof(struct lt_dlhandle_struct));
2541          newhandle = *phandle;
2542    
2543          /* scm_lt_dlclose()ing yourself is very bad!  Disallow it.  */
2544          LT_DLSET_FLAG (*phandle, LT_DLRESIDENT_FLAG);
2545    
2546          if (tryall_dlopen (&newhandle, 0) != 0)
2547            {
2548              LT_DLFREE (*phandle);
2549              return 1;
2550            }
2551    
2552          goto register_handle;
2553        }
2554    
2555      assert (filename && *filename);
2556    
2557      /* Doing this immediately allows internal functions to safely
2558         assume only canonicalized paths are passed.  */
2559      if (canonicalize_path (filename, &canonical) != 0)
2560        {
2561          ++errors;
2562          goto cleanup;
2563        }
2564    
2565      /* If the canonical module name is a path (relative or absolute)
2566         then split it into a directory part and a name part.  */
2567      base_name = strrchr (canonical, '/');
2568      if (base_name)
2569        {
2570          size_t dirlen = (1+ base_name) - canonical;
2571    
2572          dir = LT_EMALLOC (char, 1+ dirlen);
2573          if (!dir)
2574            {
2575              ++errors;
2576              goto cleanup;
2577            }
2578    
2579          strncpy (dir, canonical, dirlen);
2580          dir[dirlen] = LT_EOS_CHAR;
2581    
2582          ++base_name;
2583        }
2584      else
2585        LT_DLMEM_REASSIGN (base_name, canonical);
2586    
2587      assert (base_name && *base_name);
2588    
2589      /* Check whether we are opening a libtool module (.la extension).  */
2590      ext = strrchr (base_name, '.');
2591      if (ext && strcmp (ext, archive_ext) == 0)
2592        {
2593          /* this seems to be a libtool module */
2594          FILE *    file     = 0;
2595          char *    dlname   = 0;
2596          char *    old_name = 0;
2597          char *    libdir   = 0;
2598          char *    deplibs  = 0;
2599          char *    line     = 0;
2600          size_t    line_len;
2601          int       i;
2602    
2603          /* if we can't find the installed flag, it is probably an
2604             installed libtool archive, produced with an old version
2605             of libtool */
2606          int       installed = 1;
2607    
2608          /* extract the module name from the file name */
2609          name = LT_EMALLOC (char, ext - base_name + 1);
2610          if (!name)
2611            {
2612              ++errors;
2613              goto cleanup;
2614            }
2615    
2616          /* canonicalize the module name */
2617          for (i = 0; i < ext - base_name; ++i)
2618            {
2619              if (isalnum ((int)(base_name[i])))
2620                {
2621                  name[i] = base_name[i];
2622                }
2623              else
2624                {
2625                  name[i] = '_';
2626                }
2627            }
2628          name[ext - base_name] = LT_EOS_CHAR;
2629    
2630        /* Now try to open the .la file.  If there is no directory name
2631           component, try to find it first in user_search_path and then other
2632           prescribed paths.  Otherwise (or in any case if the module was not
2633           yet found) try opening just the module name as passed.  */
2634          if (!dir)
2635            {
2636              const char *search_path;
2637    
2638              LT_DLMUTEX_LOCK ();
2639              search_path = user_search_path;
2640              if (search_path)
2641                file = find_file (user_search_path, base_name, &dir);
2642              LT_DLMUTEX_UNLOCK ();
2643    
2644              if (!file)
2645                {
2646                  search_path = getenv (LTDL_SEARCHPATH_VAR);
2647                  if (search_path)
2648                    file = find_file (search_path, base_name, &dir);
2649                }
2650    
2651    #ifdef LTDL_SHLIBPATH_VAR
2652              if (!file)
2653                {
2654                  search_path = getenv (LTDL_SHLIBPATH_VAR);
2655                  if (search_path)
2656                    file = find_file (search_path, base_name, &dir);
2657                }
2658    #endif
2659    #ifdef LTDL_SYSSEARCHPATH
2660              if (!file && sys_search_path)
2661                {
2662                  file = find_file (sys_search_path, base_name, &dir);
2663                }
2664    #endif
2665            }
2666          if (!file)
2667            {
2668              file = fopen (filename, LT_READTEXT_MODE);
2669            }
2670    
2671          /* If we didn't find the file by now, it really isn't there.  Set
2672             the status flag, and bail out.  */
2673          if (!file)
2674            {
2675              LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND));
2676              ++errors;
2677              goto cleanup;
2678            }
2679    
2680          line_len = LT_FILENAME_MAX;
2681          line = LT_EMALLOC (char, line_len);
2682          if (!line)
2683            {
2684              fclose (file);
2685              ++errors;
2686              goto cleanup;
2687            }
2688    
2689          /* read the .la file */
2690          while (!feof (file))
2691            {
2692              if (!fgets (line, line_len, file))
2693                {
2694                  break;
2695                }
2696    
2697              /* Handle the case where we occasionally need to read a line
2698                 that is longer than the initial buffer size.  */
2699              while (line[LT_STRLEN(line) -1] != '\n')
2700                {
2701                  line = LT_DLREALLOC (char, line, line_len *2);
2702                  if (!fgets (&line[line_len -1], line_len +1, file))
2703                    {
2704                      break;
2705                  }                  }
2706                  lists = lists->next;                line_len *= 2;
2707                }
2708    
2709              if (line[0] == '\n' || line[0] == '#')
2710                {
2711                  continue;
2712                }
2713    
2714    #undef  STR_DLNAME
2715    #define STR_DLNAME      "dlname="
2716              if (strncmp (line, STR_DLNAME, sizeof (STR_DLNAME) - 1) == 0)
2717                {
2718                  errors += trim (&dlname, &line[sizeof (STR_DLNAME) - 1]);
2719                }
2720    
2721    #undef  STR_OLD_LIBRARY
2722    #define STR_OLD_LIBRARY "old_library="
2723              else if (strncmp (line, STR_OLD_LIBRARY,
2724                                sizeof (STR_OLD_LIBRARY) - 1) == 0)
2725                {
2726                  errors += trim (&old_name, &line[sizeof (STR_OLD_LIBRARY) - 1]);
2727                }
2728    #undef  STR_LIBDIR
2729    #define STR_LIBDIR      "libdir="
2730              else if (strncmp (line, STR_LIBDIR, sizeof (STR_LIBDIR) - 1) == 0)
2731                {
2732                  errors += trim (&libdir, &line[sizeof(STR_LIBDIR) - 1]);
2733                }
2734    
2735    #undef  STR_DL_DEPLIBS
2736    #define STR_DL_DEPLIBS  "dependency_libs="
2737              else if (strncmp (line, STR_DL_DEPLIBS,
2738                                sizeof (STR_DL_DEPLIBS) - 1) == 0)
2739                {
2740                  errors += trim (&deplibs, &line[sizeof (STR_DL_DEPLIBS) - 1]);
2741                }
2742              else if (strcmp (line, "installed=yes\n") == 0)
2743                {
2744                  installed = 1;
2745                }
2746              else if (strcmp (line, "installed=no\n") == 0)
2747                {
2748                  installed = 0;
2749                }
2750    
2751    #undef  STR_LIBRARY_NAMES
2752    #define STR_LIBRARY_NAMES "library_names="
2753              else if (! dlname && strncmp (line, STR_LIBRARY_NAMES,
2754                                            sizeof (STR_LIBRARY_NAMES) - 1) == 0)
2755                {
2756                  char *last_libname;
2757                  errors += trim (&dlname, &line[sizeof (STR_LIBRARY_NAMES) - 1]);
2758                  if (!errors
2759                      && dlname
2760                      && (last_libname = strrchr (dlname, ' ')) != 0)
2761                    {
2762                      last_libname = lt_estrdup (last_libname + 1);
2763                      if (!last_libname)
2764                        {
2765                          ++errors;
2766                          goto cleanup;
2767                        }
2768                      LT_DLMEM_REASSIGN (dlname, last_libname);
2769                    }
2770                }
2771    
2772              if (errors)
2773                break;
2774            }
2775    
2776          fclose (file);
2777          LT_DLFREE (line);
2778    
2779          /* allocate the handle */
2780          *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1);
2781          if (*phandle == 0)
2782            ++errors;
2783    
2784          if (errors)
2785            {
2786              free_vars (dlname, old_name, libdir, deplibs);
2787              LT_DLFREE (*phandle);
2788              goto cleanup;
2789            }
2790    
2791          assert (*phandle);
2792    
2793          memset (*phandle, 0, sizeof(struct lt_dlhandle_struct));
2794          if (load_deplibs (*phandle, deplibs) == 0)
2795            {
2796              newhandle = *phandle;
2797              /* find_module may replace newhandle */
2798              if (find_module (&newhandle, dir, libdir, dlname, old_name, installed))
2799                {
2800                  unload_deplibs (*phandle);
2801                  ++errors;
2802                }
2803            }
2804          else
2805            {
2806              ++errors;
2807            }
2808    
2809          free_vars (dlname, old_name, libdir, deplibs);
2810          if (errors)
2811            {
2812              LT_DLFREE (*phandle);
2813              goto cleanup;
2814            }
2815    
2816          if (*phandle != newhandle)
2817            {
2818              unload_deplibs (*phandle);
2819            }
2820        }
2821      else
2822        {
2823          /* not a libtool module */
2824          *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1);
2825          if (*phandle == 0)
2826            {
2827              ++errors;
2828              goto cleanup;
2829            }
2830    
2831          memset (*phandle, 0, sizeof (struct lt_dlhandle_struct));
2832          newhandle = *phandle;
2833    
2834          /* If the module has no directory name component, try to find it
2835             first in user_search_path and then other prescribed paths.
2836             Otherwise (or in any case if the module was not yet found) try
2837             opening just the module name as passed.  */
2838          if ((dir || (!find_handle (user_search_path, base_name, &newhandle)
2839                       && !find_handle (getenv (LTDL_SEARCHPATH_VAR), base_name,
2840                                        &newhandle)
2841    #ifdef LTDL_SHLIBPATH_VAR
2842                       && !find_handle (getenv (LTDL_SHLIBPATH_VAR), base_name,
2843                                        &newhandle)
2844    #endif
2845    #ifdef LTDL_SYSSEARCHPATH
2846                       && !find_handle (sys_search_path, base_name, &newhandle)
2847    #endif
2848                       )))
2849            {
2850              if (tryall_dlopen (&newhandle, filename) != 0)
2851                newhandle = 0;
2852          }          }
2853          last_error = file_not_found_error;  
2854          return 1;        if (!newhandle)
2855            {
2856              LT_DLFREE (*phandle);
2857              ++errors;
2858              goto cleanup;
2859            }
2860        }
2861    
2862     register_handle:
2863      LT_DLMEM_REASSIGN (*phandle, newhandle);
2864    
2865      if ((*phandle)->info.ref_count == 0)
2866        {
2867          (*phandle)->info.ref_count        = 1;
2868          LT_DLMEM_REASSIGN ((*phandle)->info.name, name);
2869    
2870          LT_DLMUTEX_LOCK ();
2871          (*phandle)->next          = handles;
2872          handles                   = *phandle;
2873          LT_DLMUTEX_UNLOCK ();
2874        }
2875    
2876      LT_DLMUTEX_SETERROR (saved_error);
2877    
2878     cleanup:
2879      LT_DLFREE (dir);
2880      LT_DLFREE (name);
2881      LT_DLFREE (canonical);
2882    
2883      return errors;
2884  }  }
2885    
2886  static int  lt_dlhandle
2887  presym_close (handle)  scm_lt_dlopen (filename)
2888          lt_dlhandle handle;       const char *filename;
2889  {  {
2890          /* Just to silence gcc -Wall */    lt_dlhandle handle = 0;
2891          handle = 0;  
2892          return 0;    /* Just incase we missed a code path in try_dlopen() that reports
2893         an error, but forgets to reset handle... */
2894      if (try_dlopen (&handle, filename) != 0)
2895        return 0;
2896    
2897      return handle;
2898  }  }
2899    
2900  static lt_ptr_t  /* If the last error messge store was `FILE_NOT_FOUND', then return
2901  presym_sym (handle, symbol)     non-zero.  */
2902          lt_dlhandle handle;  static int
2903          const char *symbol;  file_not_found ()
2904  {  {
2905          lt_dlsymlist *syms = (lt_dlsymlist*)(handle->handle);    const char *error = 0;
2906    
2907          syms++;    LT_DLMUTEX_GETERROR (error);
2908          while (syms->address) {    if (error == LT_DLSTRERROR (FILE_NOT_FOUND))
2909                  if (strcmp(syms->name, symbol) == 0)      return 1;
2910                          return syms->address;  
2911                  syms++;    return 0;
         }  
         last_error = symbol_error;  
         return 0;  
2912  }  }
2913    
2914  static  /* If FILENAME has an ARCHIVE_EXT or SHLIB_EXT extension, try to
2915  lt_dltype_t     open the FILENAME as passed.  Otherwise try appending ARCHIVE_EXT,
2916  presym = { LTDL_TYPE_TOP, 0, presym_init, presym_exit,     and if a file is still not found try again with SHLIB_EXT appended
2917             presym_open, presym_close, presym_sym };     instead.  */
2918    lt_dlhandle
2919    scm_lt_dlopenext (filename)
2920         const char *filename;
2921    {
2922      lt_dlhandle   handle          = 0;
2923      char *        tmp             = 0;
2924      char *        ext             = 0;
2925      int           len;
2926      int           errors          = 0;
2927      int           file_found      = 1; /* until proven otherwise */
2928    
2929      if (!filename)
2930        {
2931          return scm_lt_dlopen (filename);
2932        }
2933    
2934      assert (filename);
2935    
2936      len = LT_STRLEN (filename);
2937      ext = strrchr (filename, '.');
2938    
2939      /* If FILENAME already bears a suitable extension, there is no need
2940         to try appending additional extensions.  */
2941      if (ext && ((strcmp (ext, archive_ext) == 0)
2942    #ifdef LTDL_SHLIB_EXT
2943                  || (strcmp (ext, shlib_ext) == 0)
2944    #endif
2945          ))
2946        {
2947          return scm_lt_dlopen (filename);
2948        }
2949    
2950      /* First try appending ARCHIVE_EXT.  */
2951      tmp = LT_EMALLOC (char, len + LT_STRLEN (archive_ext) + 1);
2952      if (!tmp)
2953        return 0;
2954    
2955      strcpy (tmp, filename);
2956      strcat (tmp, archive_ext);
2957      errors = try_dlopen (&handle, tmp);
2958    
2959      /* If we found FILENAME, stop searching -- whether we were able to
2960         load the file as a module or not.  If the file exists but loading
2961         failed, it is better to return an error message here than to
2962         report FILE_NOT_FOUND when the alternatives (foo.so etc) are not
2963         in the module search path.  */
2964      if (handle || ((errors > 0) && !file_not_found ()))
2965        {
2966          LT_DLFREE (tmp);
2967          return handle;
2968        }
2969    
2970    #ifdef LTDL_SHLIB_EXT
2971      /* Try appending SHLIB_EXT.   */
2972      if (LT_STRLEN (shlib_ext) > LT_STRLEN (archive_ext))
2973        {
2974          LT_DLFREE (tmp);
2975          tmp = LT_EMALLOC (char, len + LT_STRLEN (shlib_ext) + 1);
2976          if (!tmp)
2977            return 0;
2978    
2979          strcpy (tmp, filename);
2980        }
2981      else
2982        {
2983          tmp[len] = LT_EOS_CHAR;
2984        }
2985    
2986      strcat(tmp, shlib_ext);
2987      errors = try_dlopen (&handle, tmp);
2988    
2989      /* As before, if the file was found but loading failed, return now
2990         with the current error message.  */
2991      if (handle || ((errors > 0) && !file_not_found ()))
2992        {
2993          LT_DLFREE (tmp);
2994          return handle;
2995        }
2996    #endif
2997    
2998      /* Still here?  Then we really did fail to locate any of the file
2999         names we tried.  */
3000      LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND));
3001      LT_DLFREE (tmp);
3002      return 0;
3003    }
3004    
 #undef LTDL_TYPE_TOP  
 #define LTDL_TYPE_TOP &presym  
3005    
3006  static char *user_search_path = 0;  int
3007  static lt_dlhandle handles = 0;  lt_argz_insert (pargz, pargz_len, before, entry)
3008  static int initialized = 0;       char **pargz;
3009         size_t *pargz_len;
3010         char *before;
3011         const char *entry;
3012    {
3013      error_t error;
3014    
3015      if ((error = argz_insert (pargz, pargz_len, before, entry)))
3016        {
3017          switch (error)
3018            {
3019            case ENOMEM:
3020              LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY));
3021              break;
3022            default:
3023              LT_DLMUTEX_SETERROR (LT_DLSTRERROR (UNKNOWN));
3024              break;
3025            }
3026          return 1;
3027        }
3028    
3029  static lt_dltype_t *types = LTDL_TYPE_TOP;    return 0;
3030  #undef LTDL_TYPE_TOP  }
3031    
3032  int  int
3033  lt_dlinit LTDL_PARAMS((void))  lt_argz_insertinorder (pargz, pargz_len, entry)
3034  {       char **pargz;
3035          /* initialize libltdl */       size_t *pargz_len;
3036          lt_dltype_t **type = &types;       const char *entry;
3037          int typecount = 0;  {
3038      char *before = 0;
3039    
3040      assert (pargz);
3041      assert (pargz_len);
3042      assert (entry && *entry);
3043    
3044      if (*pargz)
3045        while ((before = argz_next (*pargz, *pargz_len, before)))
3046          {
3047            int cmp = strcmp (entry, before);
3048    
3049            if (cmp < 0)  break;
3050            if (cmp == 0) return 0; /* No duplicates! */
3051          }
3052    
3053      return lt_argz_insert (pargz, pargz_len, before, entry);
3054    }
3055    
3056          if (initialized) {      /* Initialize only at first call. */  int
3057                  initialized++;  scm_lt_argz_insertdir (pargz, pargz_len, dirnam, dp)
3058                  return 0;       char **pargz;
3059         size_t *pargz_len;
3060         const char *dirnam;
3061         struct dirent *dp;
3062    {
3063      char   *buf       = 0;
3064      size_t buf_len    = 0;
3065      char   *end       = 0;
3066      size_t end_offset = 0;
3067      size_t dir_len    = 0;
3068      int    errors     = 0;
3069    
3070      assert (pargz);
3071      assert (pargz_len);
3072      assert (dp);
3073    
3074      dir_len = LT_STRLEN (dirnam);
3075      end     = dp->d_name + LT_D_NAMLEN(dp);
3076    
3077      /* Ignore version numbers.  */
3078      {
3079        char *p;
3080        for (p = end; p -1 > dp->d_name; --p)
3081          if (strchr (".0123456789", p[-1]) == 0)
3082            break;
3083    
3084        if (*p == '.')
3085          end = p;
3086      }
3087    
3088      /* Ignore filename extension.  */
3089      {
3090        char *p;
3091        for (p = end -1; p > dp->d_name; --p)
3092          if (*p == '.')
3093            {
3094              end = p;
3095              break;
3096            }
3097      }
3098    
3099      /* Prepend the directory name.  */
3100      end_offset    = end - dp->d_name;
3101      buf_len       = dir_len + 1+ end_offset;
3102      buf           = LT_EMALLOC (char, 1+ buf_len);
3103      if (!buf)
3104        return ++errors;
3105    
3106      assert (buf);
3107    
3108      strcpy  (buf, dirnam);
3109      strcat  (buf, "/");
3110      strncat (buf, dp->d_name, end_offset);
3111      buf[buf_len] = LT_EOS_CHAR;
3112    
3113      /* Try to insert (in order) into ARGZ/ARGZ_LEN.  */
3114      if (lt_argz_insertinorder (pargz, pargz_len, buf) != 0)
3115        ++errors;
3116    
3117      LT_DLFREE (buf);
3118    
3119      return errors;
3120    }
3121    
3122    static int
3123    list_files_by_dir (dirnam, pargz, pargz_len)
3124         const char *dirnam;
3125         char **pargz;
3126         size_t *pargz_len;
3127    {
3128      DIR   *dirp     = 0;
3129      int    errors   = 0;
3130    
3131      assert (dirnam && *dirnam);
3132      assert (pargz);
3133      assert (pargz_len);
3134      assert (dirnam[LT_STRLEN(dirnam) -1] != '/');
3135    
3136      dirp = opendir (dirnam);
3137      if (dirp)
3138        {
3139          struct dirent *dp = 0;
3140    
3141          while ((dp = readdir (dirp)))
3142            if (dp->d_name[0] != '.')
3143              if (scm_lt_argz_insertdir (pargz, pargz_len, dirnam, dp))
3144                {
3145                  ++errors;
3146                  break;
3147                }
3148    
3149          closedir (dirp);
3150        }
3151      else
3152        ++errors;
3153    
3154      return errors;
3155    }
3156    
3157    
3158    /* If there are any files in DIRNAME, call the function passed in
3159       DATA1 (with the name of each file and DATA2 as arguments).  */
3160    static int
3161    foreachfile_callback (dirname, data1, data2)
3162         char *dirname;
3163         lt_ptr data1;
3164         lt_ptr data2;
3165    {
3166      int (*func) LT_PARAMS((const char *filename, lt_ptr data))
3167            = (int (*) LT_PARAMS((const char *filename, lt_ptr data))) data1;
3168    
3169      int     is_done  = 0;
3170      char   *argz     = 0;
3171      size_t  argz_len = 0;
3172    
3173      if (list_files_by_dir (dirname, &argz, &argz_len) != 0)
3174        goto cleanup;
3175      if (!argz)
3176        goto cleanup;
3177    
3178      {
3179        char *filename = 0;
3180        while ((filename = argz_next (argz, argz_len, filename)))
3181          if ((is_done = (*func) (filename, data2)))
3182            break;
3183      }
3184    
3185     cleanup:
3186      LT_DLFREE (argz);
3187    
3188      return is_done;
3189    }
3190    
3191    
3192    /* Call FUNC for each unique extensionless file in SEARCH_PATH, along
3193       with DATA.  The filenames passed to FUNC would be suitable for
3194       passing to scm_lt_dlopenext.  The extensions are stripped so that
3195       individual modules do not generate several entries (e.g. libfoo.la,
3196       libfoo.so, libfoo.so.1, libfoo.so.1.0.0).  If SEARCH_PATH is NULL,
3197       then the same directories that scm_lt_dlopen would search are examined.  */
3198    int
3199    scm_lt_dlforeachfile (search_path, func, data)
3200         const char *search_path;
3201         int (*func) LT_PARAMS ((const char *filename, lt_ptr data));
3202         lt_ptr data;
3203    {
3204      int is_done = 0;
3205    
3206      if (search_path)
3207        {
3208          /* If a specific path was passed, search only the directories
3209             listed in it.  */
3210          is_done = foreach_dirinpath (search_path, 0,
3211                                       foreachfile_callback, func, data);
3212        }
3213      else
3214        {
3215          /* Otherwise search the default paths.  */
3216          is_done = foreach_dirinpath (user_search_path, 0,
3217                                       foreachfile_callback, func, data);
3218          if (!is_done)
3219            {
3220              is_done = foreach_dirinpath (getenv("LTDL_LIBRARY_PATH"), 0,
3221                                           foreachfile_callback, func, data);
3222          }          }
         handles = 0;  
         user_search_path = 0; /* empty search path */  
3223    
3224          while (*type) {  #ifdef LTDL_SHLIBPATH_VAR
3225                  if ((*type)->mod_init())        if (!is_done)
3226                          *type = (*type)->next; /* Remove it from the list */          {
3227                  else {            is_done = foreach_dirinpath (getenv(LTDL_SHLIBPATH_VAR), 0,
3228                          type = &(*type)->next; /* Keep it */                                         foreachfile_callback, func, data);
                         typecount++;  
                 }  
3229          }          }
3230          if (typecount == 0) {  #endif
3231                  last_error = dlopen_not_supported_error;  #ifdef LTDL_SYSSEARCHPATH
3232                  return 1;        if (!is_done)
3233            {
3234              is_done = foreach_dirinpath (getenv(LTDL_SYSSEARCHPATH), 0,
3235                                           foreachfile_callback, func, data);
3236          }          }
3237          last_error = 0;  #endif
3238          initialized = 1;      }
3239          return 0;  
3240      return is_done;
3241  }  }
3242    
3243  int  int
3244  lt_dlpreload (preloaded)  scm_lt_dlclose (handle)
3245          const lt_dlsymlist *preloaded;       lt_dlhandle handle;
3246  {  {
3247          if (preloaded)    lt_dlhandle cur, last;
3248                  return presym_add_symlist(preloaded);    int errors = 0;
3249          presym_free_symlists();  
3250          if (default_preloaded_symbols)    LT_DLMUTEX_LOCK ();
3251                  return lt_dlpreload(default_preloaded_symbols);  
3252          return 0;    /* check whether the handle is valid */
3253      last = cur = handles;
3254      while (cur && handle != cur)
3255        {
3256          last = cur;
3257          cur = cur->next;
3258        }
3259    
3260      if (!cur)
3261        {
3262          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE));
3263          ++errors;
3264          goto done;
3265        }
3266    
3267      handle->info.ref_count--;
3268    
3269      /* Note that even with resident modules, we must track the ref_count
3270         correctly incase the user decides to reset the residency flag
3271         later (even though the API makes no provision for that at the
3272         moment).  */
3273      if (handle->info.ref_count <= 0 && !LT_DLIS_RESIDENT (handle))
3274        {
3275          lt_user_data data = handle->loader->dlloader_data;
3276    
3277          if (handle != handles)
3278            {
3279              last->next = handle->next;
3280            }
3281          else
3282            {
3283              handles = handle->next;
3284            }
3285    
3286          errors += handle->loader->module_close (data, handle->module);
3287          errors += unload_deplibs(handle);
3288    
3289          LT_DLFREE (handle->info.filename);
3290          LT_DLFREE (handle->info.name);
3291          LT_DLFREE (handle);
3292    
3293          goto done;
3294        }
3295    
3296      if (LT_DLIS_RESIDENT (handle))
3297        {
3298          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CLOSE_RESIDENT_MODULE));
3299          ++errors;
3300        }
3301    
3302     done:
3303      LT_DLMUTEX_UNLOCK ();
3304    
3305      return errors;
3306    }
3307    
3308    lt_ptr
3309    scm_lt_dlsym (handle, symbol)
3310         lt_dlhandle handle;
3311         const char *symbol;
3312    {
3313      int   lensym;
3314      char  lsym[LT_SYMBOL_LENGTH];
3315      char  *sym;
3316      lt_ptr address;
3317      lt_user_data data;
3318    
3319      if (!handle)
3320        {
3321          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE));
3322          return 0;
3323        }
3324    
3325      if (!symbol)
3326        {
3327          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND));
3328          return 0;
3329        }
3330    
3331      lensym = LT_STRLEN (symbol) + LT_STRLEN (handle->loader->sym_prefix)
3332                                            + LT_STRLEN (handle->info.name);
3333    
3334      if (lensym + LT_SYMBOL_OVERHEAD < LT_SYMBOL_LENGTH)
3335        {
3336          sym = lsym;
3337        }
3338      else
3339        {
3340          sym = LT_EMALLOC (char, lensym + LT_SYMBOL_OVERHEAD + 1);
3341          if (!sym)
3342            {
3343              LT_DLMUTEX_SETERROR (LT_DLSTRERROR (BUFFER_OVERFLOW));
3344              return 0;
3345            }
3346        }
3347    
3348      data = handle->loader->dlloader_data;
3349      if (handle->info.name)
3350        {
3351          const char *saved_error;
3352    
3353          LT_DLMUTEX_GETERROR (saved_error);
3354    
3355          /* this is a libtool module */
3356          if (handle->loader->sym_prefix)
3357            {
3358              strcpy(sym, handle->loader->sym_prefix);
3359              strcat(sym, handle->info.name);
3360            }
3361          else
3362            {
3363              strcpy(sym, handle->info.name);
3364            }
3365    
3366          strcat(sym, "_LTX_");
3367          strcat(sym, symbol);
3368    
3369          /* try "modulename_LTX_symbol" */
3370          address = handle->loader->find_sym (data, handle->module, sym);
3371          if (address)
3372            {
3373              if (sym != lsym)
3374                {
3375                  LT_DLFREE (sym);
3376                }
3377              return address;
3378            }
3379          LT_DLMUTEX_SETERROR (saved_error);
3380        }
3381    
3382      /* otherwise try "symbol" */
3383      if (handle->loader->sym_prefix)
3384        {
3385          strcpy(sym, handle->loader->sym_prefix);
3386          strcat(sym, symbol);
3387        }
3388      else
3389        {
3390          strcpy(sym, symbol);
3391        }
3392    
3393      address = handle->loader->find_sym (data, handle->module, sym);
3394      if (sym != lsym)
3395        {
3396          LT_DLFREE (sym);
3397        }
3398    
3399      return address;
3400  }  }
3401    
3402  int  const char *
3403  lt_dlpreload_default (preloaded)  scm_lt_dlerror ()
         const lt_dlsymlist *preloaded;  
3404  {  {
3405          default_preloaded_symbols = preloaded;    const char *error;
3406          return 0;  
3407      LT_DLMUTEX_GETERROR (error);
3408      LT_DLMUTEX_SETERROR (0);
3409    
3410      return error ? error : LT_DLSTRERROR (UNKNOWN);
3411  }  }
3412    
3413  int  int
3414  lt_dlexit LTDL_PARAMS((void))  lt_dlpath_insertdir (ppath, before, dir)
3415  {       char **ppath;
3416          /* shut down libltdl */       char *before;
3417          lt_dltype_t *type = types;       const char *dir;
3418          int     errors;  {
3419              int    errors         = 0;
3420          if (!initialized) {    char  *canonical      = 0;
3421                  last_error = shutdown_error;    char  *argz           = 0;
3422                  return 1;    size_t argz_len       = 0;
3423          }  
3424          if (initialized != 1) { /* shut down only at last call. */    assert (ppath);
3425                  initialized--;    assert (dir && *dir);
3426                  return 0;  
3427          }    if (canonicalize_path (dir, &canonical) != 0)
3428          /* close all modules */      {
3429          errors = 0;        ++errors;
3430          while (handles) {        goto cleanup;
3431                  /* FIXME: what if a module depends on another one? */      }
3432                  if (lt_dlclose(handles))  
3433                          errors++;    assert (canonical && *canonical);
3434          }  
3435          initialized = 0;    /* If *PPATH is empty, set it to DIR.  */
3436          while (type) {    if (*ppath == 0)
3437                  if (type->mod_exit())      {
3438                          errors++;        assert (!before);         /* BEFORE cannot be set without PPATH.  */
3439                  type = type->next;        assert (dir);             /* Without DIR, don't call this function!  */
3440          }  
3441          return errors;        *ppath = lt_estrdup (dir);
3442          if (*ppath == 0)
3443            ++errors;
3444    
3445          return errors;
3446        }
3447    
3448      assert (ppath && *ppath);
3449    
3450      if (argzize_path (*ppath, &argz, &argz_len) != 0)
3451        {
3452          ++errors;
3453          goto cleanup;
3454        }
3455    
3456      /* Convert BEFORE into an equivalent offset into ARGZ.  This only works
3457         if *PPATH is already canonicalized, and hence does not change length
3458         with respect to ARGZ.  We canonicalize each entry as it is added to
3459         the search path, and don't call this function with (uncanonicalized)
3460         user paths, so this is a fair assumption.  */
3461      if (before)
3462        {
3463          assert (*ppath <= before);
3464          assert (before - *ppath <= strlen (*ppath));
3465    
3466          before = before - *ppath + argz;
3467        }
3468    
3469      if (lt_argz_insert (&argz, &argz_len, before, dir) != 0)
3470        {
3471          ++errors;
3472          goto cleanup;
3473        }
3474    
3475      argz_stringify (argz, argz_len, LT_PATHSEP_CHAR);
3476      LT_DLMEM_REASSIGN (*ppath,  argz);
3477    
3478     cleanup:
3479      LT_DLFREE (canonical);
3480      LT_DLFREE (argz);
3481    
3482      return errors;
3483  }  }
3484    
3485  static int  int
3486  tryall_dlopen (handle, filename)  scm_lt_dladdsearchdir (search_dir)
3487          lt_dlhandle *handle;       const char *search_dir;
         const char *filename;  
3488  {  {
3489          lt_dlhandle cur;    int errors = 0;
         lt_dltype_t *type = types;  
         const char *saved_error = last_error;  
           
         /* check whether the module was already opened */  
         cur = handles;  
         while (cur) {  
                 if (!cur->filename && !filename)  
                         break;  
                 if (cur->filename && filename &&  
                     strcmp(cur->filename, filename) == 0)  
                         break;  
                 cur = cur->next;  
         }  
         if (cur) {  
                 cur->usage++;  
                 *handle = cur;  
                 return 0;  
         }  
           
         cur = *handle;  
         if (filename) {  
                 cur->filename = strdup(filename);  
                 if (!cur->filename) {  
                         last_error = memory_error;  
                         return 1;  
                 }  
         } else  
                 cur->filename = 0;  
         while (type) {  
                 if (type->lib_open(cur, filename) == 0)  
                         break;  
                 type = type->next;  
         }  
         if (!type) {  
                 if (cur->filename)  
                         lt_dlfree(cur->filename);  
                 return 1;  
         }  
         cur->type = type;  
         last_error = saved_error;  
         return 0;  
 }  
3490    
3491  static int    if (search_dir && *search_dir)
3492  find_module (handle, dir, libdir, dlname, old_name, installed)      {
3493          lt_dlhandle *handle;        LT_DLMUTEX_LOCK ();
3494          const char *dir;        if (lt_dlpath_insertdir (&user_search_path, 0, search_dir) != 0)
3495          const char *libdir;          ++errors;
3496          const char *dlname;        LT_DLMUTEX_UNLOCK ();
3497          const char *old_name;      }
3498          int installed;  
3499  {    return errors;
         int     error;  
         char    *filename;  
         /* try to open the old library first; if it was dlpreopened,  
            we want the preopened version of it, even if a dlopenable  
            module is available */  
         if (old_name && tryall_dlopen(handle, old_name) == 0)  
                 return 0;  
         /* try to open the dynamic library */  
         if (dlname) {  
                 /* try to open the installed module */  
                 if (installed && libdir) {  
                         filename = (char*)  
                                 lt_dlmalloc(strlen(libdir)+1+strlen(dlname)+1);  
                         if (!filename) {  
                                 last_error = memory_error;  
                                 return 1;  
                         }  
                         strcpy(filename, libdir);  
                         strcat(filename, "/");  
                         strcat(filename, dlname);  
                         error = tryall_dlopen(handle, filename) == 0;  
                         lt_dlfree(filename);  
                         if (error)  
                                 return 0;  
                 }  
                 /* try to open the not-installed module */  
                 if (!installed) {  
                         filename = (char*)  
                                 lt_dlmalloc((dir ? strlen(dir) : 0)  
                                        + strlen(objdir) + strlen(dlname) + 1);  
                         if (!filename) {  
                                 last_error = memory_error;  
                                 return 1;  
                         }  
                         if (dir)  
                                 strcpy(filename, dir);  
                         else  
                                 *filename = 0;  
                         strcat(filename, objdir);  
                         strcat(filename, dlname);  
   
                         error = tryall_dlopen(handle, filename) == 0;  
                         lt_dlfree(filename);  
                         if (error)  
                                 return 0;  
                 }  
                 /* hmm, maybe it was moved to another directory */  
                 {  
                         filename = (char*)  
                                 lt_dlmalloc((dir ? strlen(dir) : 0)  
                                        + strlen(dlname) + 1);  
                         if (dir)  
                                 strcpy(filename, dir);  
                         else  
                                 *filename = 0;  
                         strcat(filename, dlname);  
                         error = tryall_dlopen(handle, filename) == 0;  
                         lt_dlfree(filename);  
                         if (error)  
                                 return 0;  
                 }  
         }  
         last_error = file_not_found_error;  
         return 1;  
3500  }  }
3501    
3502  static lt_ptr_t  int
3503  find_file (basename, search_path, pdir, handle)  scm_lt_dlinsertsearchdir (before, search_dir)
3504          const char *basename;       const char *before;
3505          const char *search_path;       const char *search_dir;
3506          char **pdir;  {
3507          lt_dlhandle *handle;    int errors = 0;
3508  {  
3509          /* when handle != NULL search a library, otherwise a file */    if (before)
3510          /* return NULL on failure, otherwise the file/handle */      {
3511          LT_DLMUTEX_LOCK ();
3512          char    *filename = 0;        if ((before < user_search_path)
3513          int     filenamesize = 0;            || (before >= user_search_path + LT_STRLEN (user_search_path)))
3514          const char *next = search_path;          {
3515          int     lenbase = strlen(basename);            LT_DLMUTEX_UNLOCK ();
3516                      LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_POSITION));
3517          if (!next || !*next) {            return 1;
3518                  last_error = file_not_found_error;          }
3519                  return 0;        LT_DLMUTEX_UNLOCK ();
3520          }      }
3521          while (next) {  
3522                  int lendir;    if (search_dir && *search_dir)
3523                  const char *cur = next;      {
3524          LT_DLMUTEX_LOCK ();
3525                  next = strchr(cur, ':');        if (lt_dlpath_insertdir (&user_search_path,
3526                  if (!next)                                 (char *) before, search_dir) != 0)
3527                          next = cur + strlen(cur);          {
3528                  lendir = next - cur;            ++errors;
                 if (*next == ':')  
                         ++next;  
                 else  
                         next = 0;  
                 if (lendir == 0)  
                         continue;  
                 if (lendir + 1 + lenbase >= filenamesize) {  
                         if (filename)  
                                 lt_dlfree(filename);  
                         filenamesize = lendir + 1 + lenbase + 1;  
                         filename = (char*) lt_dlmalloc(filenamesize);  
                         if (!filename) {  
                                 last_error = memory_error;  
                                 return 0;  
                         }  
                 }  
                 strncpy(filename, cur, lendir);  
                 if (filename[lendir-1] != '/')  
                         filename[lendir++] = '/';  
                 strcpy(filename+lendir, basename);  
                 if (handle) {  
                         if (tryall_dlopen(handle, filename) == 0) {  
                                 lt_dlfree(filename);  
                                 return (lt_ptr_t) handle;  
                         }  
                 } else {  
                         FILE *file = fopen(filename, LTDL_READTEXT_MODE);  
                         fprintf (stderr, "tried %s: %p\n", filename, file);  
                         if (file) {  
                                 if (*pdir)  
                                         lt_dlfree(*pdir);  
                                 filename[lendir] = '\0';  
                                 *pdir = strdup(filename);  
                                 if (!*pdir) {  
                                         /* We could have even avoided the  
                                            strdup, but there would be some  
                                            memory overhead. */  
                                         *pdir = filename;  
                                 } else  
                                         lt_dlfree(filename);  
                                 return (lt_ptr_t) file;  
                         }  
                 }  
3529          }          }
3530          if (filename)        LT_DLMUTEX_UNLOCK ();
3531                  lt_dlfree(filename);      }
3532          last_error = file_not_found_error;  
3533          return 0;    return errors;
3534  }  }
3535    
3536  static int  int
3537  load_deplibs(handle, deplibs)  scm_lt_dlsetsearchpath (search_path)
3538          lt_dlhandle handle;       const char *search_path;
3539          const char *deplibs;  {
3540  {    int   errors      = 0;
3541          /* FIXME: load deplibs */  
3542          handle->depcount = 0;    LT_DLMUTEX_LOCK ();
3543          handle->deplibs = 0;    LT_DLFREE (user_search_path);
3544          /* Just to silence gcc -Wall */    LT_DLMUTEX_UNLOCK ();
3545          deplibs = 0;  
3546          return 0;    if (!search_path || !LT_STRLEN (search_path))
3547        {
3548          return errors;
3549        }
3550    
3551      LT_DLMUTEX_LOCK ();
3552      if (canonicalize_path (search_path, &user_search_path) != 0)
3553        ++errors;
3554      LT_DLMUTEX_UNLOCK ();
3555    
3556      return errors;
3557  }  }
3558    
3559  static int  const char *
3560  unload_deplibs(handle)  scm_lt_dlgetsearchpath ()
         lt_dlhandle handle;  
3561  {  {
3562          /* FIXME: unload deplibs */    const char *saved_path;
3563          /* Just to silence gcc -Wall */  
3564          handle = 0;    LT_DLMUTEX_LOCK ();
3565          return 0;    saved_path = user_search_path;
3566      LT_DLMUTEX_UNLOCK ();
3567    
3568      return saved_path;
3569  }  }
3570    
3571  static inline int  int
3572  trim (dest, str)  scm_lt_dlmakeresident (handle)
3573          char **dest;       lt_dlhandle handle;
         const char *str;  
3574  {  {
3575          /* remove the leading and trailing "'" from str    int errors = 0;
3576             and store the result in dest */  
3577          char *tmp;    if (!handle)
3578          const char *end = strrchr(str, '\'');      {
3579          int len = strlen(str);        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE));
3580          ++errors;
3581          if (*dest)      }
3582                  lt_dlfree(*dest);    else
3583          if (len > 3 && str[0] == '\'') {      {
3584                  tmp = (char*) lt_dlmalloc(end - str);        LT_DLSET_FLAG (handle, LT_DLRESIDENT_FLAG);
3585                  if (!tmp) {      }
3586                          last_error = memory_error;  
3587                          return 1;    return errors;
                 }  
                 strncpy(tmp, &str[1], (end - str) - 1);  
                 tmp[len-3] = '\0';  
                 *dest = tmp;  
         } else  
                 *dest = 0;  
         return 0;  
3588  }  }
3589    
3590  static inline int  int
3591  free_vars(dir, name, dlname, oldname, libdir, deplibs)  scm_lt_dlisresident     (handle)
3592          char *dir;       lt_dlhandle handle;
3593          char *name;  {
3594          char *dlname;    if (!handle)
3595          char *oldname;      {
3596          char *libdir;        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE));
3597          char *deplibs;        return -1;
3598  {      }
3599          if (dir)  
3600                  lt_dlfree(dir);    return LT_DLIS_RESIDENT (handle);
         if (name)  
                 lt_dlfree(name);  
         if (dlname)  
                 lt_dlfree(dlname);  
         if (oldname)  
                 lt_dlfree(oldname);  
         if (libdir)  
                 lt_dlfree(libdir);  
         if (deplibs)  
                 lt_dlfree(deplibs);  
         return 0;  
3601  }  }
3602    
3603  lt_dlhandle  
3604  lt_dlopen (filename)  
3605          const char *filename;  
3606    /* --- MODULE INFORMATION --- */
3607    
3608    const lt_dlinfo *
3609    scm_lt_dlgetinfo (handle)
3610         lt_dlhandle handle;
3611  {  {
3612          lt_dlhandle handle, newhandle;    if (!handle)
3613          const char *basename, *ext;      {
3614          const char *saved_error = last_error;        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE));
3615          char    *dir = 0, *name = 0;        return 0;
3616                }
3617          if (!filename) {  
3618                  handle = (lt_dlhandle) lt_dlmalloc(sizeof(lt_dlhandle_t));    return &(handle->info);
                 if (!handle) {  
                         last_error = memory_error;  
                         return 0;  
                 }  
                 handle->usage = 0;  
                 handle->depcount = 0;  
                 handle->deplibs = 0;  
                 newhandle = handle;  
                 if (tryall_dlopen(&newhandle, 0) != 0) {  
                         lt_dlfree(handle);  
                         return 0;  
                 }  
                 goto register_handle;  
         }  
         basename = strrchr(filename, '/');  
         if (basename) {  
                 basename++;  
                 dir = (char*) lt_dlmalloc(basename - filename + 1);  
                 if (!dir) {  
                         last_error = memory_error;  
                         return 0;  
                 }  
                 strncpy(dir, filename, basename - filename);  
                 dir[basename - filename] = '\0';  
         } else  
                 basename = filename;  
         /* check whether we open a libtool module (.la extension) */  
         ext = strrchr(basename, '.');  
         if (ext && strcmp(ext, ".la") == 0) {  
                 /* this seems to be a libtool module */  
                 FILE    *file;  
                 int     i;  
                 char    *dlname = 0, *old_name = 0;  
                 char    *libdir = 0, *deplibs = 0;  
                 char    *line;  
                 int     error = 0;  
                 /* if we can't find the installed flag, it is probably an  
                    installed libtool archive, produced with an old version  
                    of libtool */  
                 int     installed = 1;  
   
                 /* extract the module name from the file name */  
                 name = (char*) lt_dlmalloc(ext - basename + 1);  
                 if (!name) {  
                         last_error = memory_error;  
                         if (dir)  
                                 lt_dlfree(dir);  
                         return 0;  
                 }  
                 /* canonicalize the module name */  
                 for (i = 0; i < ext - basename; i++)  
                         if (isalnum((int)(basename[i])))  
                                 name[i] = basename[i];  
                         else  
                                 name[i] = '_';  
                 name[ext - basename] = '\0';  
                 /* now try to open the .la file */  
                 file = fopen(filename, LTDL_READTEXT_MODE);  
                 if (!file)  
                         last_error = file_not_found_error;  
                 if (!file && !dir) {  
                         /* try other directories */  
                         file = (FILE*) find_file(basename,  
                                                  user_search_path,  
                                                  &dir, 0);  
                         if (!file)  
                                 file = (FILE*) find_file(basename,  
                                                  getenv("LTDL_LIBRARY_PATH"),  
                                                  &dir, 0);  
 #ifdef LTDL_SHLIBPATH_VAR  
                         if (!file)  
                                 file = (FILE*) find_file(basename,  
                                                  getenv(LTDL_SHLIBPATH_VAR),  
                                                  &dir, 0);  
 #endif  
                 }  
                 if (!file) {  
                         if (name)  
                                 lt_dlfree(name);  
                         if (dir)  
                                 lt_dlfree(dir);  
                         return 0;  
                 }  
                 line = (char*) lt_dlmalloc(LTDL_FILENAME_MAX);  
                 if (!line) {  
                         fclose(file);  
                         last_error = memory_error;  
                         return 0;  
                 }  
                 /* read the .la file */  
                 while (!feof(file)) {  
                         if (!fgets(line, LTDL_FILENAME_MAX, file))  
                                 break;  
                         if (line[0] == '\n' || line[0] == '#')  
                                 continue;  
 #                       undef  STR_DLNAME  
 #                       define STR_DLNAME       "dlname="  
                         if (strncmp(line, STR_DLNAME,  
                                 sizeof(STR_DLNAME) - 1) == 0)  
                                 error = trim(&dlname,  
                                         &line[sizeof(STR_DLNAME) - 1]);  
                         else  
 #                       undef  STR_OLD_LIBRARY  
 #                       define STR_OLD_LIBRARY  "old_library="  
                         if (strncmp(line, STR_OLD_LIBRARY,  
                                 sizeof(STR_OLD_LIBRARY) - 1) == 0)  
                                 error = trim(&old_name,  
                                         &line[sizeof(STR_OLD_LIBRARY) - 1]);  
                         else  
 #                       undef  STR_LIBDIR  
 #                       define STR_LIBDIR       "libdir="  
                         if (strncmp(line, STR_LIBDIR,  
                                 sizeof(STR_LIBDIR) - 1) == 0)  
                                 error = trim(&libdir,  
                                         &line[sizeof(STR_LIBDIR) - 1]);  
                         else  
 #                       undef  STR_DL_DEPLIBS  
 #                       define STR_DL_DEPLIBS   "dl_dependency_libs="  
                         if (strncmp(line, STR_DL_DEPLIBS,  
                                 sizeof(STR_DL_DEPLIBS) - 1) == 0)  
                                 error = trim(&deplibs,  
                                         &line[sizeof(STR_DL_DEPLIBS) - 1]);  
                         else  
                         if (strcmp(line, "installed=yes\n") == 0)  
                                 installed = 1;  
                         else  
                         if (strcmp(line, "installed=no\n") == 0)  
                                 installed = 0;  
                         if (error)  
                                 break;  
                 }  
                 fclose(file);  
                 lt_dlfree(line);  
                 /* allocate the handle */  
                 handle = (lt_dlhandle) lt_dlmalloc(sizeof(lt_dlhandle_t));  
                 if (!handle || error) {  
                         if (handle)  
                                 lt_dlfree(handle);  
                         if (!error)  
                                 last_error = memory_error;  
                         free_vars(name, dir, dlname, old_name, libdir, deplibs);  
                         return 0;  
                 }  
                 handle->usage = 0;  
                 if (load_deplibs(handle, deplibs) == 0) {  
                         newhandle = handle;  
                         /* find_module may replace newhandle */  
                         if (find_module(&newhandle, dir, libdir,  
                                         dlname, old_name, installed)) {  
                                 unload_deplibs(handle);  
                                 error = 1;  
                         }  
                 } else  
                         error = 1;  
                 if (error) {  
                         lt_dlfree(handle);  
                         free_vars(name, dir, dlname, old_name, libdir, deplibs);  
                         return 0;  
                 }  
                 if (handle != newhandle) {  
                         unload_deplibs(handle);  
                 }  
         } else {  
                 /* not a libtool module */  
                 handle = (lt_dlhandle) lt_dlmalloc(sizeof(lt_dlhandle_t));  
                 if (!handle) {  
                         last_error = memory_error;  
                         if (dir)  
                                 lt_dlfree(dir);  
                         return 0;  
                 }  
                 handle->usage = 0;  
                 /* non-libtool modules don't have dependencies */  
                 handle->depcount = 0;  
                 handle->deplibs = 0;  
                 newhandle = handle;  
                 if (tryall_dlopen(&newhandle, filename)  
                     && (dir  
                         || (!find_file(basename, user_search_path,  
                                           0, &newhandle)  
                             && !find_file(basename,  
                                           getenv("LTDL_LIBRARY_PATH"),  
                                           0, &newhandle)  
 #ifdef LTDL_SHLIBPATH_VAR  
                             && !find_file(basename,  
                                           getenv(LTDL_SHLIBPATH_VAR),  
                                           0, &newhandle)  
 #endif  
                                 ))) {  
                         lt_dlfree(handle);  
                         if (dir)  
                                 lt_dlfree(dir);  
                         return 0;  
                 }  
         }  
 register_handle:  
         if (newhandle != handle) {  
                 lt_dlfree(handle);  
                 handle = newhandle;  
         }  
         if (!handle->usage) {  
                 handle->usage = 1;  
                 handle->name = name;  
                 handle->next = handles;  
                 handles = handle;  
         } else if (name)  
                 lt_dlfree(name);  
         if (dir)  
                 lt_dlfree(dir);  
         last_error = saved_error;  
         return handle;  
3619  }  }
3620    
3621  lt_dlhandle  lt_dlhandle
3622  lt_dlopenext (filename)  scm_lt_dlhandle_next (place)
3623          const char *filename;       lt_dlhandle place;
3624  {  {
3625          lt_dlhandle handle;    return place ? place->next : handles;
         char    *tmp;  
         int     len;  
         const char *saved_error = last_error;  
           
         if (!filename)  
                 return lt_dlopen(filename);  
         len = strlen(filename);  
         if (!len) {  
                 last_error = file_not_found_error;  
                 return 0;  
         }  
         /* try the normal file name */  
         handle = lt_dlopen(filename);  
         if (handle)  
                 return handle;  
         /* try "filename.la" */  
         tmp = (char*) lt_dlmalloc(len+4);  
         if (!tmp) {  
                 last_error = memory_error;  
                 return 0;  
         }  
         strcpy(tmp, filename);  
         strcat(tmp, ".la");  
         handle = lt_dlopen(tmp);  
         if (handle) {  
                 last_error = saved_error;  
                 lt_dlfree(tmp);  
                 return handle;  
         }  
 #ifdef LTDL_SHLIB_EXT  
         /* try "filename.EXT" */  
         if (strlen(shlib_ext) > 3) {  
                 lt_dlfree(tmp);  
                 tmp = (char*) lt_dlmalloc(len + strlen(shlib_ext) + 1);  
                 if (!tmp) {  
                         last_error = memory_error;  
                         return 0;  
                 }  
                 strcpy(tmp, filename);  
         } else  
                 tmp[len] = '\0';  
         strcat(tmp, shlib_ext);  
         handle = lt_dlopen(tmp);  
         if (handle) {  
                 last_error = saved_error;  
                 lt_dlfree(tmp);  
                 return handle;  
         }  
 #endif    
         last_error = file_not_found_error;  
         lt_dlfree(tmp);  
         return 0;  
3626  }  }
3627    
3628  int  int
3629  lt_dlclose (handle)  scm_lt_dlforeach (func, data)
3630          lt_dlhandle handle;       int (*func) LT_PARAMS((lt_dlhandle handle, lt_ptr data));
3631         lt_ptr data;
3632  {  {
3633          lt_dlhandle cur, last;    int errors = 0;
3634              lt_dlhandle cur;
3635          /* check whether the handle is valid */  
3636          last = cur = handles;    LT_DLMUTEX_LOCK ();
3637          while (cur && handle != cur) {  
3638                  last = cur;    cur = handles;
3639                  cur = cur->next;    while (cur)
3640          }      {
3641          if (!cur) {        lt_dlhandle tmp = cur;
3642                  last_error = invalid_handle_error;  
3643                  return 1;        cur = cur->next;
3644          }        if ((*func) (tmp, data))
3645          handle->usage--;          {
3646          if (!handle->usage) {            ++errors;
3647                  int     error;            break;
           
                 if (handle != handles)  
                         last->next = handle->next;  
                 else  
                         handles = handle->next;  
                 error = handle->type->lib_close(handle);  
                 error += unload_deplibs(handle);  
                 if (handle->filename)  
                         lt_dlfree(handle->filename);  
                 if (handle->name)  
                         lt_dlfree(handle->name);  
                 lt_dlfree(handle);  
                 return error;  
3648          }          }
3649          return 0;      }
3650    
3651      LT_DLMUTEX_UNLOCK ();
3652    
3653      return errors;
3654  }  }
3655    
3656  lt_ptr_t  lt_dlcaller_id
3657  lt_dlsym (handle, symbol)  scm_lt_dlcaller_register ()
3658          lt_dlhandle handle;  {
3659          const char *symbol;    static lt_dlcaller_id last_caller_id = 0;
3660  {    int result;
3661          int     lensym;  
3662          char    lsym[LTDL_SYMBOL_LENGTH];    LT_DLMUTEX_LOCK ();
3663          char    *sym;    result = ++last_caller_id;
3664          lt_ptr_t address;    LT_DLMUTEX_UNLOCK ();
3665    
3666          if (!handle) {    return result;
3667                  last_error = invalid_handle_error;  }
3668                  return 0;  
3669          }  lt_ptr
3670          if (!symbol) {  scm_lt_dlcaller_set_data (key, handle, data)
3671                  last_error = symbol_error;       lt_dlcaller_id key;
3672                  return 0;       lt_dlhandle handle;
3673          }       lt_ptr data;
3674          lensym = strlen(symbol);  {
3675          if (handle->type->sym_prefix)    int n_elements = 0;
3676                  lensym += strlen(handle->type->sym_prefix);    lt_ptr stale = (lt_ptr) 0;
3677          if (handle->name)    int i;
3678                  lensym += strlen(handle->name);  
3679          if (lensym + LTDL_SYMBOL_OVERHEAD < LTDL_SYMBOL_LENGTH)    /* This needs to be locked so that the caller data can be updated
3680                  sym = lsym;       simultaneously by different threads.  */
3681          else    LT_DLMUTEX_LOCK ();
3682                  sym = (char*) lt_dlmalloc(lensym + LTDL_SYMBOL_OVERHEAD + 1);  
3683          if (!sym) {    if (handle->caller_data)
3684                  last_error = buffer_overflow_error;      while (handle->caller_data[n_elements].key)
3685                  return 0;        ++n_elements;
3686          }  
3687          if (handle->name) {    for (i = 0; i < n_elements; ++i)
3688                  const char *saved_error = last_error;      {
3689                          if (handle->caller_data[i].key == key)
3690                  /* this is a libtool module */          {
3691                  if (handle->type->sym_prefix) {            stale = handle->caller_data[i].data;
3692                          strcpy(sym, handle->type->sym_prefix);            break;
3693                          strcat(sym, handle->name);          }
3694                  } else      }
3695                          strcpy(sym, handle->name);  
3696                  strcat(sym, "_LTX_");    /* Ensure that there is enough room in this handle's caller_data
3697                  strcat(sym, symbol);       array to accept a new element (and an empty end marker).  */
3698                  /* try "modulename_LTX_symbol" */    if (i == n_elements)
3699                  address = handle->type->find_sym(handle, sym);      {
3700                  if (address) {        lt_caller_data *temp
3701                          if (sym != lsym)          = LT_DLREALLOC (lt_caller_data, handle->caller_data, 2+ n_elements);
3702                                  lt_dlfree(sym);  
3703                          return address;        if (!temp)
3704                  }          {
3705                  last_error = saved_error;            stale = 0;
3706              goto done;
3707          }          }
3708          /* otherwise try "symbol" */  
3709          if (handle->type->sym_prefix) {        handle->caller_data = temp;
3710                  strcpy(sym, handle->type->sym_prefix);  
3711                  strcat(sym, symbol);        /* We only need this if we needed to allocate a new caller_data.  */
3712          } else        handle->caller_data[i].key  = key;
3713                  strcpy(sym, symbol);        handle->caller_data[1+ i].key = 0;
3714          address = handle->type->find_sym(handle, sym);      }
3715          if (sym != lsym)  
3716                  lt_dlfree(sym);    handle->caller_data[i].data = data;
3717          return address;  
3718     done:
3719      LT_DLMUTEX_UNLOCK ();
3720    
3721      return stale;
3722  }  }
3723    
3724  const char *  lt_ptr
3725  lt_dlerror LTDL_PARAMS((void))  scm_lt_dlcaller_get_data  (key, handle)
3726         lt_dlcaller_id key;
3727         lt_dlhandle handle;
3728  {  {
3729          const char *error = last_error;    lt_ptr result = (lt_ptr) 0;
3730            
3731          last_error = 0;    /* This needs to be locked so that the caller data isn't updated by
3732          return error;       another thread part way through this function.  */
3733      LT_DLMUTEX_LOCK ();
3734    
3735      /* Locate the index of the element with a matching KEY.  */
3736      {
3737        int i;
3738        for (i = 0; handle->caller_data[i].key; ++i)
3739          {
3740            if (handle->caller_data[i].key == key)
3741              {
3742                result = handle->caller_data[i].data;
3743                break;
3744              }
3745          }
3746      }
3747    
3748      LT_DLMUTEX_UNLOCK ();
3749    
3750      return result;
3751  }  }
3752    
3753    
3754    
3755    /* --- USER MODULE LOADER API --- */
3756    
3757    
3758  int  int
3759  lt_dladdsearchdir (search_dir)  scm_lt_dlloader_add (place, dlloader, loader_name)
3760          const char *search_dir;       lt_dlloader *place;
3761  {       const struct lt_user_dlloader *dlloader;
3762          if (!search_dir || !strlen(search_dir))       const char *loader_name;
3763                  return 0;  {
3764          if (!user_search_path) {    int errors = 0;
3765                  user_search_path = strdup(search_dir);    lt_dlloader *node = 0, *ptr = 0;
3766                  if (!user_search_path) {  
3767                          last_error = memory_error;    if ((dlloader == 0)   /* diagnose null parameters */
3768                          return 1;        || (dlloader->module_open == 0)
3769                  }        || (dlloader->module_close == 0)
3770          } else {        || (dlloader->find_sym == 0))
3771                  char    *new_search_path = (char*)      {
3772                          lt_dlmalloc(strlen(user_search_path) +        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER));
3773                                  strlen(search_dir) + 2); /* ':' + '\0' == 2 */        return 1;
3774                  if (!new_search_path) {      }
3775                          last_error = memory_error;  
3776                          return 1;    /* Create a new dlloader node with copies of the user callbacks.  */
3777                  }    node = LT_EMALLOC (lt_dlloader, 1);
3778                  strcpy(new_search_path, user_search_path);    if (!node)
3779                  strcat(new_search_path, ":");      return 1;
3780                  strcat(new_search_path, search_dir);  
3781                  lt_dlfree(user_search_path);    node->next            = 0;
3782                  user_search_path = new_search_path;    node->loader_name     = loader_name;
3783      node->sym_prefix      = dlloader->sym_prefix;
3784      node->dlloader_exit   = dlloader->dlloader_exit;
3785      node->module_open     = dlloader->module_open;
3786      node->module_close    = dlloader->module_close;
3787      node->find_sym        = dlloader->find_sym;
3788      node->dlloader_data   = dlloader->dlloader_data;
3789    
3790      LT_DLMUTEX_LOCK ();
3791      if (!loaders)
3792        {
3793          /* If there are no loaders, NODE becomes the list! */
3794          loaders = node;
3795        }
3796      else if (!place)
3797        {
3798          /* If PLACE is not set, add NODE to the end of the
3799             LOADERS list. */
3800          for (ptr = loaders; ptr->next; ptr = ptr->next)
3801            {
3802              /*NOWORK*/;
3803            }
3804    
3805          ptr->next = node;
3806        }
3807      else if (loaders == place)
3808        {
3809          /* If PLACE is the first loader, NODE goes first. */
3810          node->next = place;
3811          loaders = node;
3812        }
3813      else
3814        {
3815          /* Find the node immediately preceding PLACE. */
3816          for (ptr = loaders; ptr->next != place; ptr = ptr->next)
3817            {
3818              /*NOWORK*/;
3819            }
3820    
3821          if (ptr->next != place)
3822            {
3823              LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER));
3824              ++errors;
3825            }
3826          else
3827            {
3828              /* Insert NODE between PTR and PLACE. */
3829              node->next = place;
3830              ptr->next  = node;
3831          }          }
3832          return 0;      }
3833    
3834      LT_DLMUTEX_UNLOCK ();
3835    
3836      return errors;
3837  }  }
3838    
3839  int  int
3840  lt_dlsetsearchpath (search_path)  scm_lt_dlloader_remove (loader_name)
3841          const char *search_path;       const char *loader_name;
3842  {  {
3843          if (user_search_path)    lt_dlloader *place = scm_lt_dlloader_find (loader_name);
3844                  lt_dlfree(user_search_path);    lt_dlhandle handle;
3845          user_search_path = 0; /* reset the search path */    int errors = 0;
3846          if (!search_path || !strlen(search_path))  
3847                  return 0;    if (!place)
3848          user_search_path = strdup(search_path);      {
3849          if (!user_search_path)        LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER));
3850                  return 1;        return 1;
3851          return 0;      }
3852    
3853      LT_DLMUTEX_LOCK ();
3854    
3855      /* Fail if there are any open modules which use this loader. */
3856      for  (handle = handles; handle; handle = handle->next)
3857        {
3858          if (handle->loader == place)
3859            {
3860              LT_DLMUTEX_SETERROR (LT_DLSTRERROR (REMOVE_LOADER));
3861              ++errors;
3862              goto done;
3863            }
3864        }
3865    
3866      if (place == loaders)
3867        {
3868          /* PLACE is the first loader in the list. */
3869          loaders = loaders->next;
3870        }
3871      else
3872        {
3873          /* Find the loader before the one being removed. */
3874          lt_dlloader *prev;
3875          for (prev = loaders; prev->next; prev = prev->next)
3876            {
3877              if (!strcmp (prev->next->loader_name, loader_name))
3878                {
3879                  break;
3880                }
3881            }
3882    
3883          place = prev->next;
3884          prev->next = prev->next->next;
3885        }
3886    
3887      if (place->dlloader_exit)
3888        {
3889          errors = place->dlloader_exit (place->dlloader_data);
3890        }
3891    
3892      LT_DLFREE (place);
3893    
3894     done:
3895      LT_DLMUTEX_UNLOCK ();
3896    
3897      return errors;
3898    }
3899    
3900    lt_dlloader *
3901    scm_lt_dlloader_next (place)
3902         lt_dlloader *place;
3903    {
3904      lt_dlloader *next;
3905    
3906      LT_DLMUTEX_LOCK ();
3907      next = place ? place->next : loaders;
3908      LT_DLMUTEX_UNLOCK ();
3909    
3910      return next;
3911  }  }
3912    
3913  const char *  const char *
3914  lt_dlgetsearchpath LTDL_PARAMS((void))  scm_lt_dlloader_name (place)
3915         lt_dlloader *place;
3916  {  {
3917          return user_search_path;    const char *name = 0;
3918    
3919      if (place)
3920        {
3921          LT_DLMUTEX_LOCK ();
3922          name = place ? place->loader_name : 0;
3923          LT_DLMUTEX_UNLOCK ();
3924        }
3925      else
3926        {
3927          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER));
3928        }
3929    
3930      return name;
3931    }
3932    
3933    lt_user_data *
3934    scm_lt_dlloader_data (place)
3935         lt_dlloader *place;
3936    {
3937      lt_user_data *data = 0;
3938    
3939      if (place)
3940        {
3941          LT_DLMUTEX_LOCK ();
3942          data = place ? &(place->dlloader_data) : 0;
3943          LT_DLMUTEX_UNLOCK ();
3944        }
3945      else
3946        {
3947          LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER));
3948        }
3949    
3950      return data;
3951    }
3952    
3953    lt_dlloader *
3954    scm_lt_dlloader_find (loader_name)
3955         const char *loader_name;
3956    {
3957      lt_dlloader *place = 0;
3958    
3959      LT_DLMUTEX_LOCK ();
3960      for (place = loaders; place; place = place->next)
3961        {
3962          if (strcmp (place->loader_name, loader_name) == 0)
3963            {
3964              break;
3965            }
3966        }
3967      LT_DLMUTEX_UNLOCK ();
3968    
3969      return place;
3970  }  }

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26