/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- load_after
- load_cc
- load_body
- Scm_VMLoadFromPort
- load_from_port
- Scm_LoadFromPort
- regfilep
- try_suffixes
- Scm_FindFile
- Scm_VMLoad
- load
- Scm_Load
- Scm_GetLoadPath
- Scm_GetDynLoadPath
- break_env_paths
- Scm_AddLoadPath
- get_dynload_initfn
- get_la_val
- find_so_from_la
- Scm_DynLoad
- Scm_Require
- Scm_Provide
- Scm_ProvidedP
- autoload_print
- Scm_MakeAutoload
- Scm_DefineAutoload
- Scm_LoadAutoload
- Scm__InitLoad
1 /*
2 * load.c - load a program
3 *
4 * Copyright (c) 2000-2005 Shiro Kawai, All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 *
33 * $Id: load.c,v 1.103 2005/10/13 08:14:13 shirok Exp $
34 */
35
36 #include <stdlib.h>
37 #include <unistd.h>
38 #include <sys/types.h>
39 #include <sys/stat.h>
40 #include <string.h>
41 #include <ctype.h>
42 #include <fcntl.h>
43 #define LIBGAUCHE_BODY
44 #include "gauche.h"
45 #include "gauche/arch.h"
46 #include "gauche/port.h"
47 #include "gauche/builtin-syms.h"
48
49 #define LOAD_SUFFIX ".scm" /* default load suffix */
50
51 /* for tuning. define this to display load timing info */
52 #undef SHOW_LOAD_TIMINGS
53
54 /*
55 * Load file.
56 */
57
58 /* Static parameters */
59 static struct {
60 /* Load path list */
61 ScmGloc *load_path_rec; /* *load-path* */
62 ScmGloc *dynload_path_rec; /* *dynamic-load-path* */
63 ScmGloc *load_suffixes_rec; /* *load-suffixes* */
64 ScmGloc *cond_features_rec; /* *cond-features* */
65 ScmInternalMutex path_mutex;
66
67 /* Provided features */
68 ScmObj provided; /* List of provided features. */
69 ScmObj providing; /* Alist of features that is being loaded,
70 and the thread that is loading it. */
71 ScmObj waiting; /* Alist of threads that is waiting for
72 a feature to being provided, and the
73 feature that is waited. */
74 ScmInternalMutex prov_mutex;
75 ScmInternalCond prov_cv;
76
77 /* Dynamic linking */
78 ScmObj dso_suffixes;
79 ScmObj dso_list; /* List of dynamically loaded objects. */
80 ScmInternalMutex dso_mutex;
81 } ldinfo = { (ScmGloc*)&ldinfo, }; /* trick to put ldinfo in .data section */
82
83 /* keywords used for load and load-from-port surbs */
84 static ScmObj key_paths = SCM_UNBOUND;
85 static ScmObj key_error_if_not_found = SCM_UNBOUND;
86 static ScmObj key_environment = SCM_UNBOUND;
87 static ScmObj key_macro = SCM_UNBOUND;
88 static ScmObj key_ignore_coding = SCM_UNBOUND;
89
90 /*--------------------------------------------------------------------
91 * Scm_LoadFromPort
92 *
93 * The most basic function in the load()-family. Read an expression
94 * from the given port and evaluates it repeatedly, until it reaches
95 * EOF. Then the port is closed. The port is locked by the calling
96 * thread until the operation terminates.
97 *
98 * The result of the last evaluation remains on VM.
99 *
100 * No matter how the load terminates, either normal or abnormal,
101 * the port is closed, and the current module is restored to the
102 * one when load is called.
103 *
104 * FLAGS argument is ignored for now, but reserved for future
105 * extension. SCM_LOAD_QUIET_NOFILE and SCM_LOAD_IGNORE_CODING
106 * won't have any effect for LoadFromPort; see Scm_Load below.
107 *
108 * TODO: if we're using coding-aware port, how should we propagate
109 * locking into the wrapped (original) port?
110 */
111
112 struct load_packet {
113 ScmPort *port;
114 ScmModule *prev_module;
115 ScmReadContext ctx;
116 ScmObj prev_port;
117 ScmObj prev_history;
118 ScmObj prev_next;
119 int prev_situation;
120 };
121
122 /* Clean up */
123 static ScmObj load_after(ScmObj *args, int nargs, void *data)
124 {
125 struct load_packet *p = (struct load_packet *)data;
126 ScmVM *vm = Scm_VM();
127
128 #ifdef SHOW_LOAD_TIMINGS
129 struct timeval t0;
130 gettimeofday(&t0, NULL);
131 fprintf(stdout, "%10u)\n",
132 t0.tv_sec*1000000+t0.tv_usec,
133 Scm_GetStringConst(SCM_STRING(Scm_PortName(p->port))));
134 #endif /*SHOW_LOAD_TIMINGS*/
135
136 Scm_ClosePort(p->port);
137 PORT_UNLOCK(p->port);
138 Scm_SelectModule(p->prev_module);
139 vm->load_port = p->prev_port;
140 vm->load_history = p->prev_history;
141 vm->load_next = p->prev_next;
142 vm->evalSituation = p->prev_situation;
143 return SCM_UNDEFINED;
144 }
145
146 /* C-continuation of the loading */
147 static ScmObj load_cc(ScmObj result, void **data)
148 {
149 struct load_packet *p = (struct load_packet*)(data[0]);
150 ScmObj expr = Scm_ReadWithContext(SCM_OBJ(p->port), &(p->ctx));
151
152 if (!SCM_EOFP(expr)) {
153 Scm_VMPushCC(load_cc, data, 1);
154 return Scm_VMEval(expr, SCM_FALSE);
155 } else {
156 return SCM_TRUE;
157 }
158 }
159
160 static ScmObj load_body(ScmObj *args, int nargs, void *data)
161 {
162 return load_cc(SCM_NIL, &data);
163 }
164
165 ScmObj Scm_VMLoadFromPort(ScmPort *port, ScmObj next_paths,
166 ScmObj env, int flags)
167 {
168 struct load_packet *p;
169 ScmObj port_info;
170 ScmVM *vm = Scm_VM();
171 ScmModule *module = vm->module;
172
173 /* Sanity check */
174 if (!SCM_IPORTP(port))
175 Scm_Error("input port required, but got: %S", port);
176 if (SCM_PORT_CLOSED_P(port))
177 Scm_Error("port already closed: %S", port);
178 if (SCM_MODULEP(env)) {
179 module = SCM_MODULE(env);
180 } else if (!SCM_UNBOUNDP(env) && !SCM_FALSEP(env)) {
181 Scm_Error("bad load environment (must be a module or #f): %S", env);
182 }
183
184 p = SCM_NEW(struct load_packet);
185 p->port = port;
186 p->prev_module = vm->module;
187 p->prev_port = vm->load_port;
188 p->prev_history = vm->load_history;
189 p->prev_next = vm->load_next;
190 p->prev_situation = vm->evalSituation;
191
192 SCM_READ_CONTEXT_INIT(&(p->ctx));
193 p->ctx.flags = SCM_READ_LITERAL_IMMUTABLE | SCM_READ_SOURCE_INFO;
194 if (SCM_VM_RUNTIME_FLAG_IS_SET(vm, SCM_CASE_FOLD)) {
195 p->ctx.flags |= SCM_READ_CASE_FOLD;
196 }
197
198 vm->load_next = next_paths;
199 vm->load_port = SCM_OBJ(port);
200 vm->module = module;
201 vm->evalSituation = SCM_VM_LOADING;
202 if (SCM_PORTP(p->prev_port)) {
203 port_info = SCM_LIST2(p->prev_port,
204 Scm_MakeInteger(Scm_PortLine(SCM_PORT(p->prev_port))));
205 } else {
206 port_info = SCM_LIST1(SCM_FALSE);
207 }
208 vm->load_history = Scm_Cons(port_info, vm->load_history);
209
210 PORT_LOCK(port, vm);
211 return Scm_VMDynamicWindC(NULL, load_body, load_after, p);
212 }
213
214 /* Scheme subr (load-from-port subr &keyword paths environment) */
215 static ScmObj load_from_port(ScmObj *args, int argc, void *data)
216 {
217 ScmPort *port;
218 ScmObj paths, env;
219 int flags = 0;
220
221 if (!SCM_IPORTP(args[0])) {
222 Scm_Error("input port required, but got %S", args[0]);
223 }
224 port = SCM_PORT(args[0]);
225 paths = Scm_GetKeyword(key_paths, args[1], SCM_FALSE);
226 env = Scm_GetKeyword(key_environment, args[1], SCM_FALSE);
227 return Scm_VMLoadFromPort(port, paths, env, flags);
228 }
229
230 static SCM_DEFINE_STRING_CONST(load_from_port_NAME, "load-from-port", 14, 14);
231 static SCM_DEFINE_SUBR(load_from_port_STUB, 1, 1,
232 SCM_OBJ(&load_from_port_NAME), load_from_port,
233 NULL, NULL);
234
235 void Scm_LoadFromPort(ScmPort *port, int flags)
236 {
237 Scm_Apply(SCM_OBJ(&load_from_port_STUB), SCM_LIST1(SCM_OBJ(port)));
238 }
239
240 /*---------------------------------------------------------------------
241 * Scm_FindFile
242 *
243 * Core function to search specified file from the search path *PATH.
244 * Search rules are:
245 *
246 * (1) If given filename begins with "/", "./" or "../", the file is
247 * searched.
248 * (2) If given filename begins with "~", unix-style username
249 * expansion is done, then the resulting file is searched.
250 * (3) Otherwise, the file is searched for each directory in
251 * *load-path*.
252 *
253 * If a file is found, it's pathname is returned. *PATH is modified
254 * to contain the remains of *load-path*, which can be used again to
255 * find next matching filename.
256 * If SUFFIXES is given, filename is assumed not to have suffix,
257 * and suffixes listed in SUFFIXES are tried one by one.
258 * The element in SUFFIXES is directly appended to the FILENAME;
259 * so usually it begins with dot.
260 */
261
262 static int regfilep(ScmObj path)
263 {
264 struct stat statbuf;
265 int r = stat(Scm_GetStringConst(SCM_STRING(path)), &statbuf);
266 if (r < 0) return FALSE;
267 return S_ISREG(statbuf.st_mode);
268 }
269
270 static ScmObj try_suffixes(ScmObj base, ScmObj suffixes)
271 {
272 ScmObj sp, fpath;
273 if (regfilep(base)) return base;
274 SCM_FOR_EACH(sp, suffixes) {
275 fpath = Scm_StringAppend2(SCM_STRING(base), SCM_STRING(SCM_CAR(sp)));
276 if (regfilep(fpath)) return fpath;
277 }
278 return SCM_FALSE;
279 }
280
281 ScmObj Scm_FindFile(ScmString *filename, ScmObj *paths,
282 ScmObj suffixes, int flags)
283 {
284 u_int size;
285 const char *ptr = Scm_GetStringContent(filename, &size, NULL, NULL);
286 int use_load_paths = TRUE;
287 ScmObj file = SCM_OBJ(filename), fpath = SCM_FALSE;
288
289 if (size == 0) Scm_Error("bad filename to load: \"\"");
290 if (*ptr == '~') {
291 file = Scm_NormalizePathname(filename, SCM_PATH_EXPAND);
292 use_load_paths = FALSE;
293 } else if (*ptr == '/'
294 || (*ptr == '.' && *(ptr+1) == '/')
295 || (*ptr == '.' && *(ptr+1) == '.' && *(ptr+2) == '/')
296 #if defined(__CYGWIN__) || defined(__MINGW32__)
297 /* support for wicked legacy DOS drive letter */
298 || (isalpha(*ptr) && *(ptr+1) == ':')
299 #endif /* __CYGWIN__ || __MINGW32__ */
300 ) {
301 use_load_paths = FALSE;
302 }
303
304 if (use_load_paths) {
305 ScmObj lpath;
306 SCM_FOR_EACH(lpath, *paths) {
307 if (!SCM_STRINGP(SCM_CAR(lpath))) {
308 Scm_Warn("*load-path* contains invalid element: %S", *paths);
309 }
310 fpath = Scm_StringAppendC(SCM_STRING(SCM_CAR(lpath)), "/", 1, 1);
311 fpath = Scm_StringAppend2(SCM_STRING(fpath), SCM_STRING(file));
312 fpath = try_suffixes(fpath, suffixes);
313 if (!SCM_FALSEP(fpath)) break;
314 }
315 if (SCM_PAIRP(lpath)) {
316 *paths = SCM_CDR(lpath);
317 return SCM_OBJ(fpath);
318 } else if (!(flags&SCM_LOAD_QUIET_NOFILE)) {
319 Scm_Error("cannot find file %S in *load-path* %S", file, *paths);
320 } else {
321 *paths = SCM_NIL;
322 }
323 } else {
324 *paths = SCM_NIL;
325 fpath = try_suffixes(file, suffixes);
326 if (!SCM_FALSEP(fpath)) return fpath;
327 if (!(flags&SCM_LOAD_QUIET_NOFILE)) {
328 Scm_Error("cannot find file %S to load", file);
329 }
330 }
331 return SCM_FALSE;
332 }
333
334 /*---------------------------------------------------------------------
335 * Scm_Load
336 *
337 * Scheme's load().
338 *
339 * filename - name of the file. can be sans suffix.
340 * load_paths - list of pathnames or #f. If #f, system's load path
341 * is used.
342 * env - a module where the forms are evaluated, or #f.
343 * If #f, the current module is used.
344 * flags - combination of bit flags
345 * SCM_LOAD_QUIET_NOFILE, SCM_LOAD_IGNORE_CODING
346 */
347
348 ScmObj Scm_VMLoad(ScmString *filename, ScmObj load_paths,
349 ScmObj env, int flags)
350 {
351 ScmObj port, truename, suffixes;
352 ScmVM *vm = Scm_VM();
353 int errorp = !(flags&SCM_LOAD_QUIET_NOFILE);
354 int ignore_coding = flags&SCM_LOAD_IGNORE_CODING;
355
356 suffixes = SCM_GLOC_GET(ldinfo.load_suffixes_rec);
357 if (!SCM_PAIRP(load_paths)) load_paths = Scm_GetLoadPath();
358 truename = Scm_FindFile(filename, &load_paths, suffixes, flags);
359 if (SCM_FALSEP(truename)) return SCM_FALSE;
360
361 #ifdef SHOW_LOAD_TIMINGS
362 {
363 struct timeval t0;
364 gettimeofday(&t0, NULL);
365 fprintf(stdout, "(\"%s\" %10u\n",
366 Scm_GetStringConst(SCM_STRING(truename)),
367 t0.tv_sec*1000000+t0.tv_usec);
368 }
369 #endif /*SHOW_LOAD_TIMINGS*/
370 if (SCM_VM_RUNTIME_FLAG_IS_SET(vm, SCM_LOAD_VERBOSE)) {
371 int len = Scm_Length(vm->load_history);
372 SCM_PUTZ(";;", 2, SCM_CURERR);
373 while (len-- > 0) SCM_PUTC(' ', SCM_CURERR);
374 Scm_Printf(SCM_CURERR, "Loading %A...\n", truename);
375 }
376
377 port = Scm_OpenFilePort(Scm_GetStringConst(SCM_STRING(truename)),
378 O_RDONLY, SCM_PORT_BUFFER_FULL, 0);
379 if (SCM_FALSEP(port)) {
380 if (errorp) Scm_Error("file %S exists, but couldn't open.", truename);
381 else return SCM_FALSE;
382 }
383 if (!ignore_coding) {
384 port = Scm_MakeCodingAwarePort(SCM_PORT(port));
385 }
386 return Scm_VMLoadFromPort(SCM_PORT(port), load_paths, env, flags);
387 }
388
389 /* Scheme subr (%load filename &keyword paths error-if-not-found
390 environment aware-coding) */
391 static ScmObj load(ScmObj *args, int argc, void *data)
392 {
393 ScmString *file;
394 ScmObj paths, env;
395 int flags = 0;
396
397 if (!SCM_STRINGP(args[0])) {
398 Scm_Error("string required, but got %S", args[0]);
399 }
400 file = SCM_STRING(args[0]);
401 paths = Scm_GetKeyword(key_paths, args[1], SCM_FALSE);
402 env = Scm_GetKeyword(key_environment, args[1], SCM_FALSE);
403 if (SCM_FALSEP(Scm_GetKeyword(key_error_if_not_found, args[1], SCM_TRUE)))
404 flags |= SCM_LOAD_QUIET_NOFILE;
405 if (!SCM_FALSEP(Scm_GetKeyword(key_ignore_coding, args[1], SCM_FALSE)))
406 flags |= SCM_LOAD_IGNORE_CODING;
407 return Scm_VMLoad(file, paths, env, flags);
408 }
409
410 static SCM_DEFINE_STRING_CONST(load_NAME, "load", 4, 4);
411 static SCM_DEFINE_SUBR(load_STUB, 1, 1, SCM_OBJ(&load_NAME), load, NULL, NULL);
412
413
414 int Scm_Load(const char *cpath, int flags)
415 {
416 ScmObj r, f = SCM_MAKE_STR_COPYING(cpath);
417 ScmObj options = SCM_NIL;
418
419 if (flags&SCM_LOAD_QUIET_NOFILE) {
420 options = Scm_Cons(key_error_if_not_found,
421 Scm_Cons(SCM_FALSE, options));
422 }
423 if (flags&SCM_LOAD_IGNORE_CODING) {
424 options = Scm_Cons(key_ignore_coding,
425 Scm_Cons(SCM_TRUE, options));
426 }
427
428 r = Scm_Apply(SCM_OBJ(&load_STUB), Scm_Cons(f, options));
429 return !SCM_FALSEP(r);
430 }
431
432 /*
433 * Utilities
434 */
435
436 ScmObj Scm_GetLoadPath(void)
437 {
438 ScmObj paths;
439 (void)SCM_INTERNAL_MUTEX_LOCK(ldinfo.path_mutex);
440 paths = Scm_CopyList(ldinfo.load_path_rec->value);
441 (void)SCM_INTERNAL_MUTEX_UNLOCK(ldinfo.path_mutex);
442 return paths;
443 }
444
445 ScmObj Scm_GetDynLoadPath(void)
446 {
447 ScmObj paths;
448 (void)SCM_INTERNAL_MUTEX_LOCK(ldinfo.path_mutex);
449 paths = Scm_CopyList(ldinfo.dynload_path_rec->value);
450 (void)SCM_INTERNAL_MUTEX_UNLOCK(ldinfo.path_mutex);
451 return paths;
452 }
453
454 static ScmObj break_env_paths(const char *envname)
455 {
456 const char *e = getenv(envname);
457 #ifndef __MINGW32__
458 char delim = ':';
459 #else /*__MINGW32__*/
460 char delim = ';';
461 #endif /*__MINGW32__*/
462
463 if (e == NULL) {
464 return SCM_NIL;
465 } else if (Scm_IsSugid()) {
466 /* don't trust env when setugid'd */
467 return SCM_NIL;
468 } else {
469 return Scm_StringSplitByChar(SCM_STRING(SCM_MAKE_STR_COPYING(e)),
470 delim);
471 }
472 }
473
474 /* Add CPATH to the current list of load path. The path is
475 * added before the current list, unless AFTERP is true.
476 * The existence of CPATH is not checked.
477 *
478 * Besides load paths, existence of directories CPATH/$ARCH and
479 * CPATH/../$ARCH is checked, where $ARCH is the system architecture
480 * signature, and if found, it is added to the dynload_path. If
481 * no such directory is found, CPATH itself is added to the dynload_path.
482 */
483 ScmObj Scm_AddLoadPath(const char *cpath, int afterp)
484 {
485 ScmObj spath = SCM_MAKE_STR_COPYING(cpath);
486 ScmObj dpath;
487 ScmObj r;
488 struct stat statbuf;
489
490 /* check dynload path */
491 dpath = Scm_StringAppendC(SCM_STRING(spath), "/", 1, 1);
492 dpath = Scm_StringAppendC(SCM_STRING(dpath), Scm_HostArchitecture(),-1,-1);
493 if (stat(Scm_GetStringConst(SCM_STRING(dpath)), &statbuf) < 0
494 || !S_ISDIR(statbuf.st_mode)) {
495 dpath = Scm_StringAppendC(SCM_STRING(spath), "/../", 4, 4);
496 dpath = Scm_StringAppendC(SCM_STRING(dpath), Scm_HostArchitecture(),-1,-1);
497 if (stat(Scm_GetStringConst(SCM_STRING(dpath)), &statbuf) < 0
498 || !S_ISDIR(statbuf.st_mode)) {
499 dpath = spath;
500 }
501 }
502
503 (void)SCM_INTERNAL_MUTEX_LOCK(ldinfo.path_mutex);
504 if (!SCM_PAIRP(ldinfo.load_path_rec->value)) {
505 ldinfo.load_path_rec->value = SCM_LIST1(spath);
506 } else if (afterp) {
507 ldinfo.load_path_rec->value =
508 Scm_Append2(ldinfo.load_path_rec->value, SCM_LIST1(spath));
509 } else {
510 ldinfo.load_path_rec->value = Scm_Cons(spath, ldinfo.load_path_rec->value);
511 }
512 r = ldinfo.load_path_rec->value;
513
514 if (!SCM_PAIRP(ldinfo.dynload_path_rec->value)) {
515 ldinfo.dynload_path_rec->value = SCM_LIST1(dpath);
516 } else if (afterp) {
517 ldinfo.dynload_path_rec->value =
518 Scm_Append2(ldinfo.dynload_path_rec->value, SCM_LIST1(dpath));
519 } else {
520 ldinfo.dynload_path_rec->value =
521 Scm_Cons(dpath, ldinfo.dynload_path_rec->value);
522 }
523 (void)SCM_INTERNAL_MUTEX_UNLOCK(ldinfo.path_mutex);
524
525 return r;
526 }
527
528 /*------------------------------------------------------------------
529 * Dynamic link
530 */
531
532 /* The API to load object file dynamically differ among platforms.
533 * We include the platform-dependent implementations (dl_*.c) that
534 * provides a common API:
535 *
536 * void *dl_open(const char *pathname)
537 * Dynamically loads the object file specified by PATHNAME,
538 * and returns its handle. On failure, returns NULL.
539 *
540 * PATHNAME is guaranteed to contain directory names, so this function
541 * doesn't need to look it up in the search paths.
542 * The caller also checks whether pathname is already loaded or not,
543 * so this function doesn't need to worry about duplicate loads.
544 *
545 * This function should have the semantics equivalent to the
546 * RTLD_NOW|RTLD_GLOBAL of dlopen().
547 *
548 * We don't call with NULL as PATHNAME; dlopen() returns the handle
549 * of the calling program itself in such a case, but we never need that
550 * behavior.
551 *
552 * ScmDynloadInitFn dl_sym(void *handle, const char *symbol)
553 * Finds the address of SYMBOL in the dl_openModule()-ed module
554 * HANDLE.
555 *
556 * void dl_close(void *handle)
557 * Closes the opened module. This can only be called when we couldn't
558 * find the initialization function in the module; once the initialization
559 * function is called, we don't have a safe way to remove the module.
560 *
561 * const char *dl_error(void)
562 * Returns the last error occurred on HANDLE in the dl_* function.
563 *
564 * Notes:
565 * - The caller takes care of mutex so that dl_ won't be called from
566 * more than one thread at a time, and no other thread calls
567 * dl_* functions between dl_open and dl_error (so that dl_open
568 * can store the error info in global variable).
569 *
570 * Since this API assumes the caller does a lot of work, the implementation
571 * should be much simpler than implementing fully dlopen()-compatible
572 * functions.
573 */
574
575 typedef void (*ScmDynLoadInitFn)(void);
576
577 /* NB: we rely on dlcompat library for dlopen instead of using dl_darwin.c
578 for now; Boehm GC requires dlopen when compiled with pthread, so there's
579 not much point to avoid dlopen here. */
580 #if defined(HAVE_DLOPEN)
581 #include "dl_dlopen.c"
582 #elif defined(__MINGW32__)
583 #include "dl_win.c"
584 #else
585 #include "dl_dummy.c"
586 #endif
587
588 /* Derives initialization function name from the module file name.
589 This function _always_ appends underscore before the symbol.
590 The dynamic loader first tries the symbol without underscore,
591 then tries with underscore. */
592 #define DYNLOAD_PREFIX "_Scm_Init_"
593
594 static const char *get_dynload_initfn(const char *filename)
595 {
596 const char *head, *tail, *s;
597 char *name, *d;
598
599 head = strrchr(filename, '/');
600 if (head == NULL) head = filename;
601 else head++;
602 tail = strchr(head, '.');
603 if (tail == NULL) tail = filename + strlen(filename);
604
605 name = SCM_NEW_ATOMIC2(char *, sizeof(DYNLOAD_PREFIX) + tail - head);
606 strcpy(name, DYNLOAD_PREFIX);
607 for (s = head, d = name + sizeof(DYNLOAD_PREFIX) - 1; s < tail; s++, d++) {
608 if (isalnum(*s)) *d = tolower(*s);
609 else *d = '_';
610 }
611 *d = '\0';
612 return name;
613 }
614
615 #if 0
616 /* Aux fn to get a parameter value from *.la file line */
617 static const char *get_la_val(const char *start)
618 {
619 const char *end;
620 if (start[0] == '\'') start++;
621 end = strrchr(start, '\'');
622 if (end) {
623 char *p = SCM_NEW_ATOMIC2(char*, (end-start+1));
624 memcpy(p, start, (end-start));
625 p[end-start] = '\0';
626 return (const char*)p;
627 } else {
628 return start;
629 }
630 }
631
632 /* We found libtool *.la file. Retrieve DSO path from it.
633 This routine make some assumption on .la file. I couldn't
634 find a formal specification of .la file format. */
635 static ScmObj find_so_from_la(ScmString *lafile)
636 {
637 ScmObj f = Scm_OpenFilePort(Scm_GetStringConst(lafile),
638 O_RDONLY, SCM_PORT_BUFFER_FULL, 0);
639 const char *dlname = NULL, *libdir = NULL;
640 int installed = FALSE;
641
642 for (;;) {
643 const char *cline;
644 ScmObj line = Scm_ReadLineUnsafe(SCM_PORT(f));
645 if (SCM_EOFP(line)) break;
646 cline = Scm_GetStringConst(SCM_STRING(line));
647 if (strncmp(cline, "dlname=", sizeof("dlname=")-1) == 0) {
648 dlname = get_la_val(cline+sizeof("dlname=")-1);
649 continue;
650 }
651 if (strncmp(cline, "libdir=", sizeof("libdir=")-1) == 0) {
652 libdir = get_la_val(cline+sizeof("libdir=")-1);
653 continue;
654 }
655 if (strncmp(cline, "installed=yes", sizeof("installed=yes")-1) == 0) {
656 installed = TRUE;
657 continue;
658 }
659 }
660 Scm_ClosePort(SCM_PORT(f));
661 if (!dlname) return SCM_FALSE;
662 if (installed && libdir) {
663 ScmObj path = Scm_StringAppendC(SCM_STRING(SCM_MAKE_STR(libdir)),
664 "/", 1, 1);
665 path = Scm_StringAppend2(SCM_STRING(path),
666 SCM_STRING(SCM_MAKE_STR(dlname)));
667 /*Scm_Printf(SCM_CURERR, "Z=%S\n", path);*/
668 if (regfilep(path)) return path;
669 } else {
670 ScmObj dir = Scm_DirName(lafile);
671 ScmObj path = Scm_StringAppendC(SCM_STRING(dir),
672 "/" SCM_LIBTOOL_OBJDIR "/",
673 sizeof("/" SCM_LIBTOOL_OBJDIR "/")-1,
674 sizeof("/" SCM_LIBTOOL_OBJDIR "/")-1);
675 path = Scm_StringAppend2(SCM_STRING(path),
676 SCM_STRING(SCM_MAKE_STR(dlname)));
677 /*Scm_Printf(SCM_CURERR, "T=%S\n", path);*/
678 if (regfilep(path)) return path;
679 }
680 return SCM_FALSE;
681 }
682 #endif
683
684 /* Dynamically load the specified object by FILENAME.
685 FILENAME must not contain the system's suffix (.so, for example).
686 */
687 ScmObj Scm_DynLoad(ScmString *filename, ScmObj initfn, int export_)
688 {
689 ScmObj reqname, truename, load_paths = Scm_GetDynLoadPath();
690 void *handle;
691 ScmDynLoadInitFn func;
692 const char *cpath, *initname, *err = NULL;
693 enum {
694 DLERR_NONE, /* no error */
695 DLERR_DLOPEN, /* failure in dlopen */
696 DLERR_NOINITFN, /* failure in finding initfn */
697 } errtype = DLERR_NONE;
698
699 truename = Scm_FindFile(filename, &load_paths, ldinfo.dso_suffixes, TRUE);
700 if (SCM_FALSEP(truename)) {
701 Scm_Error("can't find dlopen-able module %S", filename);
702 }
703 reqname = truename; /* save requested name */
704 cpath = Scm_GetStringConst(SCM_STRING(truename));
705
706 #if 0
707 if ((suff = strrchr(cpath, '.')) && strcmp(suff, ".la") == 0) {
708 truename = find_so_from_la(SCM_STRING(truename));
709 if (SCM_FALSEP(truename)) {
710 Scm_Error("couldn't find dlopen-able module from libtool archive file %s", cpath);
711 }
712 cpath = Scm_GetStringConst(SCM_STRING(truename));
713 }
714 #endif
715
716 if (SCM_STRINGP(initfn)) {
717 ScmObj _initfn = Scm_StringAppend2(SCM_STRING(Scm_MakeString("_", 1, 1, 0)),
718 SCM_STRING(initfn));
719 initname = Scm_GetStringConst(SCM_STRING(_initfn));
720 } else {
721 /* NB: we use requested name to derive initfn name, instead of
722 the one given in libtool .la file. For example, on cygwin,
723 the actual DLL that libtool library libfoo.la points to is
724 named cygfoo.dll; we still want Scm_Init_libfoo in that case,
725 not Scm_Init_cygfoo. */
726 initname = get_dynload_initfn(Scm_GetStringConst(SCM_STRING(reqname)));
727 }
728
729 (void)SCM_INTERNAL_MUTEX_LOCK(ldinfo.dso_mutex);
730 if (!SCM_FALSEP(Scm_Member(truename, ldinfo.dso_list, SCM_CMP_EQUAL))) {
731 /* already loaded */
732 goto cleanup;
733 }
734 SCM_UNWIND_PROTECT {
735 ScmVM *vm = Scm_VM();
736 if (SCM_VM_RUNTIME_FLAG_IS_SET(vm, SCM_LOAD_VERBOSE)) {
737 int len = Scm_Length(vm->load_history);
738 SCM_PUTZ(";;", 2, SCM_CURERR);
739 while (len-- > 0) SCM_PUTC(' ', SCM_CURERR);
740 Scm_Printf(SCM_CURERR, "Dynamically Loading %s...\n", cpath);
741 }
742 } SCM_WHEN_ERROR {
743 (void)SCM_INTERNAL_MUTEX_UNLOCK(ldinfo.dso_mutex);
744 SCM_NEXT_HANDLER;
745 } SCM_END_PROTECT;
746 handle = dl_open(cpath);
747 if (handle == NULL) {
748 err = dl_error();
749 errtype = DLERR_DLOPEN;
750 goto cleanup;
751 }
752 /* initname always has '_'. We first try without '_' */
753 func = dl_sym(handle, initname+1);
754 if (func == NULL) {
755 func = (void(*)(void))dl_sym(handle, initname);
756 if (func == NULL) {
757 dl_close(handle);
758 errtype = DLERR_NOINITFN;
759 goto cleanup;
760 }
761 }
762 /* TODO: if the module initialization function fails,
763 there's no safe way to unload the module, and we
764 can't load the same module again. We're stuck to
765 the broken module. This has to be addressed. */
766 SCM_UNWIND_PROTECT {
767 func();
768 } SCM_WHEN_ERROR {
769 (void)SCM_INTERNAL_MUTEX_UNLOCK(ldinfo.dso_mutex);
770 SCM_NEXT_HANDLER;
771 } SCM_END_PROTECT;
772 ldinfo.dso_list = Scm_Cons(truename, ldinfo.dso_list);
773 cleanup:
774 (void)SCM_INTERNAL_MUTEX_UNLOCK(ldinfo.dso_mutex);
775 switch (errtype) {
776 case DLERR_DLOPEN:
777 if (err == NULL) {
778 Scm_Error("failed to link %S dynamically", filename);
779 } else {
780 Scm_Error("failed to link %S dynamically: %s", filename, err);
781 }
782 /*NOTREACHED*/
783 case DLERR_NOINITFN:
784 Scm_Error("dynamic linking of %S failed: couldn't find initialization function %s", filename, initname);
785 /*NOTREACHED*/
786 case DLERR_NONE:
787 break;
788 }
789 return SCM_TRUE;
790 }
791
792 /*------------------------------------------------------------------
793 * Require and provide
794 */
795
796 /* STk's require takes a string. SLIB's require takes a symbol.
797 For now, I allow only a string. */
798 /* Note that require and provide is recognized at compile time. */
799
800 /* [Preventing Race Condition]
801 *
802 * Besides the list of provided features (ldinfo.provided), the
803 * system keeps two kind of global assoc list for transient information.
804 *
805 * ldinfo.providing keeps a list of (<feature> . <thread>), where
806 * <thread> is currently loading a file for <feature>.
807 * ldinfo.waiting keeps a list of (<thread> . <feature>), where
808 * <thread> is waiting for <feature> to be provided.
809 *
810 * Scm_Require first checks ldinfo.provided list; if the feature is
811 * already provided, no problem; just return.
812 * If not, ldinfo.providing is searched. If the feature is being provided
813 * by some other thread, the calling thread pushes itself onto
814 * ldinfo.waiting list and waits for the feature to be provided.
815 *
816 * There may be a case that the feature dependency forms a loop because
817 * of bug. An error should be signaled in such a case, rather than going
818 * to deadlock. So, when the calling thread finds the required feature
819 * is in the ldinfo.providing alist, it checks the waiting chain of
820 * features, and no threads are waiting for a feature being provided by
821 * the calling thread.
822 */
823
824 ScmObj Scm_Require(ScmObj feature)
825 {
826 ScmObj filename;
827 ScmVM *vm = Scm_VM();
828 ScmObj provided, providing, p, q;
829 int loop = FALSE;
830
831 if (!SCM_STRINGP(feature)) {
832 Scm_Error("require: string expected, but got %S\n", feature);
833 }
834
835 (void)SCM_INTERNAL_MUTEX_LOCK(ldinfo.prov_mutex);
836 do {
837 provided = Scm_Member(feature, ldinfo.provided, SCM_CMP_EQUAL);
838 if (!SCM_FALSEP(provided)) break;
839 providing = Scm_Assoc(feature, ldinfo.providing, SCM_CMP_EQUAL);
840 if (SCM_FALSEP(providing)) break;
841
842 /* Checks for dependency loop */
843 p = providing;
844 SCM_ASSERT(SCM_PAIRP(p));
845 if (SCM_CDR(p) == SCM_OBJ(vm)) {
846 loop = TRUE;
847 break;
848 }
849
850 for (;;) {
851 q = Scm_Assoc(SCM_CDR(p), ldinfo.waiting, SCM_CMP_EQ);
852 if (SCM_FALSEP(q)) break;
853 SCM_ASSERT(SCM_PAIRP(q));
854 p = Scm_Assoc(SCM_CDR(q), ldinfo.providing, SCM_CMP_EQUAL);
855 SCM_ASSERT(SCM_PAIRP(p));
856 if (SCM_CDR(p) == SCM_OBJ(vm)) {
857 loop = TRUE;
858 break;
859 }
860 }
861 if (loop) break;
862 ldinfo.waiting = Scm_Acons(SCM_OBJ(vm), feature, ldinfo.waiting);
863 (void)SCM_INTERNAL_COND_WAIT(ldinfo.prov_cv, ldinfo.prov_mutex);
864 ldinfo.waiting = Scm_AssocDeleteX(SCM_OBJ(vm), ldinfo.waiting, SCM_CMP_EQ);
865 continue;
866 } while (0);
867 if (!loop && SCM_FALSEP(provided)) {
868 ldinfo.providing = Scm_Acons(feature, SCM_OBJ(vm), ldinfo.providing);
869 }
870 (void)SCM_INTERNAL_MUTEX_UNLOCK(ldinfo.prov_mutex);
871
872 if (loop) Scm_Error("a loop is detected in the require dependency involving feature %S", feature);
873 if (!SCM_FALSEP(provided)) return SCM_TRUE;
874 SCM_UNWIND_PROTECT {
875 filename = Scm_StringAppendC(SCM_STRING(feature), ".scm", 4, 4);
876 Scm_Load(Scm_GetStringConst(SCM_STRING(filename)), 0);
877 } SCM_WHEN_ERROR {
878 (void)SCM_INTERNAL_MUTEX_LOCK(ldinfo.prov_mutex);
879 ldinfo.providing = Scm_AssocDeleteX(feature, ldinfo.providing, SCM_CMP_EQUAL);
880 (void)SCM_INTERNAL_COND_SIGNAL(ldinfo.prov_cv);
881 (void)SCM_INTERNAL_MUTEX_UNLOCK(ldinfo.prov_mutex);
882 SCM_NEXT_HANDLER;
883 } SCM_END_PROTECT;
884 (void)SCM_INTERNAL_MUTEX_LOCK(ldinfo.prov_mutex);
885 ldinfo.providing = Scm_AssocDeleteX(feature, ldinfo.providing, SCM_CMP_EQUAL);
886 (void)SCM_INTERNAL_COND_SIGNAL(ldinfo.prov_cv);
887 (void)SCM_INTERNAL_MUTEX_UNLOCK(ldinfo.prov_mutex);
888 return SCM_TRUE;
889 }
890
891 ScmObj Scm_Provide(ScmObj feature)
892 {
893 if (!SCM_STRINGP(feature))
894 Scm_Error("provide: string expected, but got %S\n", feature);
895 (void)SCM_INTERNAL_MUTEX_LOCK(ldinfo.prov_mutex);
896 if (SCM_FALSEP(Scm_Member(feature, ldinfo.provided, SCM_CMP_EQUAL))) {
897 ldinfo.provided = Scm_Cons(feature, ldinfo.provided);
898 }
899 if (!SCM_FALSEP(Scm_Member(feature, ldinfo.providing, SCM_CMP_EQUAL))) {
900 ldinfo.providing = Scm_DeleteX(feature, ldinfo.providing, SCM_CMP_EQUAL);
901 }
902 (void)SCM_INTERNAL_COND_SIGNAL(ldinfo.prov_cv);
903 (void)SCM_INTERNAL_MUTEX_UNLOCK(ldinfo.prov_mutex);
904 return feature;
905 }
906
907 int Scm_ProvidedP(ScmObj feature)
908 {
909 int r;
910 (void)SCM_INTERNAL_MUTEX_LOCK(ldinfo.prov_mutex);
911 r = !SCM_FALSEP(Scm_Member(feature, ldinfo.provided, SCM_CMP_EQUAL));
912 (void)SCM_INTERNAL_MUTEX_UNLOCK(ldinfo.prov_mutex);
913 return r;
914 }
915
916 /*------------------------------------------------------------------
917 * Autoload
918 */
919
920 static void autoload_print(ScmObj obj, ScmPort *out, ScmWriteContext *ctx)
921 {
922 Scm_Printf(out, "#<autoload %A::%A (%A)>",
923 SCM_AUTOLOAD(obj)->module->name,
924 SCM_AUTOLOAD(obj)->name, SCM_AUTOLOAD(obj)->path);
925 }
926
927 SCM_DEFINE_BUILTIN_CLASS_SIMPLE(Scm_AutoloadClass, autoload_print);
928
929 ScmObj Scm_MakeAutoload(ScmModule *where,
930 ScmSymbol *name,
931 ScmString *path,
932 ScmSymbol *import_from)
933 {
934 ScmAutoload *adata = SCM_NEW(ScmAutoload);
935 SCM_SET_CLASS(adata, SCM_CLASS_AUTOLOAD);
936 adata->name = name;
937 adata->module = where;
938 adata->path = path;
939 adata->import_from = import_from;
940 adata->loaded = FALSE;
941 adata->value = SCM_UNBOUND;
942 (void)SCM_INTERNAL_MUTEX_INIT(adata->mutex);
943 (void)SCM_INTERNAL_COND_INIT(adata->cv);
944 adata->locker = NULL;
945 return SCM_OBJ(adata);
946 }
947
948 void Scm_DefineAutoload(ScmModule *where,
949 ScmObj file_or_module,
950 ScmObj list)
951 {
952 ScmString *path = NULL;
953 ScmSymbol *import_from = NULL;
954 ScmObj ep;
955
956 if (SCM_STRINGP(file_or_module)) {
957 path = SCM_STRING(file_or_module);
958 } else if (SCM_SYMBOLP(file_or_module)) {
959 import_from = SCM_SYMBOL(file_or_module);
960 path = SCM_STRING(Scm_ModuleNameToPath(import_from));
961 } else {
962 Scm_Error("autoload: string or symbol required, but got %S",
963 file_or_module);
964 }
965 SCM_FOR_EACH(ep, list) {
966 ScmObj entry = SCM_CAR(ep);
967 if (SCM_SYMBOLP(entry)) {
968 Scm_Define(where, SCM_SYMBOL(entry),
969 Scm_MakeAutoload(where, SCM_SYMBOL(entry),
970 path, import_from));
971 } else if (SCM_PAIRP(entry)
972 && SCM_EQ(key_macro, SCM_CAR(entry))
973 && SCM_PAIRP(SCM_CDR(entry))
974 && SCM_SYMBOLP(SCM_CADR(entry))) {
975 ScmSymbol *sym = SCM_SYMBOL(SCM_CADR(entry));
976 ScmObj autoload = Scm_MakeAutoload(where, sym, path, import_from);
977 Scm_Define(where, sym,
978 Scm_MakeMacroAutoload(sym, SCM_AUTOLOAD(autoload)));
979 } else {
980 Scm_Error("autoload: bad autoload symbol entry: %S", entry);
981 }
982 }
983 }
984
985
986 ScmObj Scm_LoadAutoload(ScmAutoload *adata)
987 {
988 int error = FALSE;
989 ScmModule *prev_module;
990 ScmVM *vm = Scm_VM();
991
992 /* check if some other thread already loaded this before attempt to lock */
993 if (adata->loaded) {
994 return adata->value;
995 }
996
997 /* obtain the right to load this autoload */
998 (void)SCM_INTERNAL_MUTEX_LOCK(adata->mutex);
999 do {
1000 if (adata->loaded) break;
1001 if (adata->locker == NULL) {
1002 adata->locker = vm;
1003 } else if (adata->locker == vm) {
1004 /* bad circular dependency */
1005 error = TRUE;
1006 } else if (adata->locker->state == SCM_VM_TERMINATED) {
1007 /* the loading thread have died prematurely.
1008 let's take over the task. */
1009 adata->locker = vm;
1010 } else {
1011 (void)SCM_INTERNAL_COND_WAIT(adata->cv, adata->mutex);
1012 continue;
1013 }
1014 } while (0);
1015 SCM_INTERNAL_MUTEX_UNLOCK(adata->mutex);
1016 if (adata->loaded) {
1017 /* ok, somebody did the work for me. just use the result. */
1018 return adata->value;
1019 }
1020
1021 if (error) {
1022 adata->locker = NULL;
1023 SCM_INTERNAL_COND_SIGNAL(adata->cv);
1024 Scm_Error("Circular autoload dependency involving %S::%S\n",
1025 adata->module, adata->name);
1026 }
1027
1028 prev_module = vm->module;
1029 SCM_UNWIND_PROTECT {
1030 vm->module = adata->module;
1031 Scm_Require(SCM_OBJ(adata->path));
1032 vm->module = prev_module;
1033
1034 if (adata->import_from) {
1035 /* autoloaded file defines import_from module. we need to
1036 import the binding individually. */
1037 ScmModule *m = Scm_FindModule(adata->import_from,
1038 SCM_FIND_MODULE_QUIET);
1039 ScmGloc *f, *g;
1040 if (m == NULL) {
1041 Scm_Error("Trying to autoload module %S from file %S, but the file doesn't define such a module",
1042 adata->import_from, adata->path);
1043 }
1044 f = Scm_FindBinding(SCM_MODULE(m), adata->name, FALSE);
1045 g = Scm_FindBinding(adata->module, adata->name, FALSE);
1046 SCM_ASSERT(f != NULL);
1047 SCM_ASSERT(g != NULL);
1048 adata->value = SCM_GLOC_GET(f);
1049 if (SCM_UNBOUNDP(adata->value) || SCM_AUTOLOADP(adata->value)) {
1050 Scm_Error("Autoloaded symbol %S is not defined in the module %S",
1051 adata->name, adata->import_from);
1052 }
1053 SCM_GLOC_SET(g, adata->value);
1054 } else {
1055 /* Normal import. The binding must have been inserted to
1056 adata->module */
1057 ScmGloc *g = Scm_FindBinding(adata->module, adata->name, FALSE);
1058 SCM_ASSERT(g != NULL);
1059 adata->value = SCM_GLOC_GET(g);
1060 if (SCM_UNBOUNDP(adata->value) || SCM_AUTOLOADP(adata->value)) {
1061 Scm_Error("Autoloaded symbol %S is not defined in the file %S",
1062 adata->name, adata->path);
1063 }
1064 }
1065 } SCM_WHEN_ERROR {
1066 adata->locker = NULL;
1067 vm->module = prev_module;
1068 SCM_INTERNAL_COND_SIGNAL(adata->cv);
1069 SCM_NEXT_HANDLER;
1070 } SCM_END_PROTECT;
1071
1072 adata->loaded = TRUE;
1073 adata->locker = NULL;
1074 SCM_INTERNAL_COND_SIGNAL(adata->cv);
1075 return adata->value;
1076 }
1077
1078 /*------------------------------------------------------------------
1079 * Initialization
1080 */
1081
1082 void Scm__InitLoad(void)
1083 {
1084 ScmModule *m = Scm_SchemeModule();
1085 ScmObj init_load_path, init_dynload_path, init_load_suffixes,
1086 init_cond_features, t;
1087
1088 init_load_path = t = SCM_NIL;
1089 SCM_APPEND(init_load_path, t, break_env_paths("GAUCHE_LOAD_PATH"));
1090 SCM_APPEND1(init_load_path, t, Scm_SiteLibraryDirectory());
1091 SCM_APPEND1(init_load_path, t, Scm_LibraryDirectory());
1092
1093 init_dynload_path = t = SCM_NIL;
1094 SCM_APPEND(init_dynload_path, t, break_env_paths("GAUCHE_DYNLOAD_PATH"));
1095 SCM_APPEND1(init_dynload_path, t, Scm_SiteArchitectureDirectory());
1096 SCM_APPEND1(init_dynload_path, t, Scm_ArchitectureDirectory());
1097
1098 init_load_suffixes = t = SCM_NIL;
1099 SCM_APPEND1(init_load_suffixes, t, SCM_MAKE_STR(LOAD_SUFFIX));
1100
1101 init_cond_features = t = SCM_NIL;
1102 SCM_APPEND1(init_cond_features, t, SCM_LIST1(SCM_SYM_GAUCHE));
1103 #ifdef __MINGW32__
1104 SCM_APPEND1(init_cond_features, t, SCM_LIST1(SCM_SYM_GAUCHE_WINDOWS));
1105 #endif /*__MINGW32__*/
1106 #if defined(GAUCHE_CHAR_ENCODING_EUC_JP)
1107 SCM_APPEND1(init_cond_features, t, SCM_LIST1(SCM_SYM_GAUCHE_EUCJP));
1108 #elif defined(GAUCHE_CHAR_ENCODING_SJIS)
1109 SCM_APPEND1(init_cond_features, t, SCM_LIST1(SCM_SYM_GAUCHE_SJIS));
1110 #elif defined(GAUCHE_CHAR_ENCODING_UTF8)
1111 SCM_APPEND1(init_cond_features, t, SCM_LIST1(SCM_SYM_GAUCHE_UTF8));
1112 #else
1113 SCM_APPEND1(init_cond_features, t, SCM_LIST1(SCM_SYM_GAUCHE_NONE));
1114 #endif
1115
1116 (void)SCM_INTERNAL_MUTEX_INIT(ldinfo.path_mutex);
1117 (void)SCM_INTERNAL_MUTEX_INIT(ldinfo.prov_mutex);
1118 (void)SCM_INTERNAL_COND_INIT(ldinfo.prov_cv);
1119 (void)SCM_INTERNAL_MUTEX_INIT(ldinfo.dso_mutex);
1120
1121 key_paths = SCM_MAKE_KEYWORD("paths");
1122 key_error_if_not_found = SCM_MAKE_KEYWORD("error-if-not-found");
1123 key_environment = SCM_MAKE_KEYWORD("environment");
1124 key_macro = SCM_MAKE_KEYWORD("macro");
1125 key_ignore_coding = SCM_MAKE_KEYWORD("ignore-coding");
1126
1127 SCM_DEFINE(m, "load-from-port", SCM_OBJ(&load_from_port_STUB));
1128 SCM_DEFINE(m, "load", SCM_OBJ(&load_STUB));
1129
1130 #define DEF(rec, sym, val) \
1131 rec = SCM_GLOC(Scm_Define(m, SCM_SYMBOL(sym), val))
1132
1133 DEF(ldinfo.load_path_rec, SCM_SYM_LOAD_PATH, init_load_path);
1134 DEF(ldinfo.dynload_path_rec, SCM_SYM_DYNAMIC_LOAD_PATH, init_dynload_path);
1135 DEF(ldinfo.load_suffixes_rec, SCM_SYM_LOAD_SUFFIXES, init_load_suffixes);
1136 DEF(ldinfo.cond_features_rec, SCM_SYM_COND_FEATURES, init_cond_features);
1137
1138 ldinfo.provided =
1139 SCM_LIST5(SCM_MAKE_STR("srfi-2"), /* and-let* */
1140 SCM_MAKE_STR("srfi-6"), /* string ports (builtin) */
1141 SCM_MAKE_STR("srfi-8"), /* receive (builtin) */
1142 SCM_MAKE_STR("srfi-10"), /* #, (builtin) */
1143 SCM_MAKE_STR("srfi-17") /* set! (builtin) */
1144 );
1145 ldinfo.providing = SCM_NIL;
1146 ldinfo.waiting = SCM_NIL;
1147 ldinfo.dso_suffixes = SCM_LIST2(SCM_MAKE_STR(".la"),
1148 SCM_MAKE_STR("." SHLIB_SO_SUFFIX));
1149 ldinfo.dso_list = SCM_NIL;
1150 }