/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- oom_handler
- Scm_Init
- Scm_RegisterDL
- gc_sentinel
- Scm_GCSentinel
- Scm_RegisterFinalizer
- Scm_UnregisterFinalizer
- finalizable
- Scm_VMFinalizerRun
- Scm_AddCleanupHandler
- Scm_DeleteCleanupHandler
- Scm_Exit
- Scm_Cleanup
- Scm_Panic
- Scm_Abort
- Scm_HostArchitecture
- Scm_LibraryDirectory
- Scm_ArchitectureDirectory
- Scm_SiteLibraryDirectory
- Scm_SiteArchitectureDirectory
- main
1 /*
2 * core.c - core kernel interface
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: core.c,v 1.69 2005/11/02 06:03:26 shirok Exp $
34 */
35
36 #include <stdlib.h>
37 #include <unistd.h>
38 #define LIBGAUCHE_BODY
39 #include "gauche.h"
40 #include "gauche/arch.h"
41 #include "gauche/paths.h"
42
43 /*
44 * out-of-memory handler. this will be called by GC.
45 */
46
47 static GC_PTR oom_handler(size_t bytes)
48 {
49 Scm_Panic("out of memory (%d). aborting...", bytes);
50 return NULL; /* dummy */
51 }
52
53 /*=============================================================
54 * Program initialization
55 */
56
57 extern void Scm__InitModule(void);
58 extern void Scm__InitSymbol(void);
59 extern void Scm__InitKeyword(void);
60 extern void Scm__InitNumber(void);
61 extern void Scm__InitChar(void);
62 extern void Scm__InitClass(void);
63 extern void Scm__InitExceptions(void);
64 extern void Scm__InitPort(void);
65 extern void Scm__InitWrite(void);
66 extern void Scm__InitCompaux(void);
67 extern void Scm__InitMacro(void);
68 extern void Scm__InitLoad(void);
69 extern void Scm__InitProc(void);
70 extern void Scm__InitRegexp(void);
71 extern void Scm__InitRead(void);
72 extern void Scm__InitSignal(void);
73 extern void Scm__InitSystem(void);
74 extern void Scm__InitCode(void);
75 extern void Scm__InitVM(void);
76 extern void Scm__InitRepl(void);
77 extern void Scm__InitParameter(void);
78 extern void Scm__InitAutoloads(void);
79
80 extern void Scm_Init_stdlib(ScmModule *);
81 extern void Scm_Init_extlib(ScmModule *);
82 extern void Scm_Init_syslib(ScmModule *);
83 extern void Scm_Init_moplib(ScmModule *);
84 extern void Scm_Init_intlib(ScmModule *);
85
86 extern void Scm_Init_scmlib(void);
87 extern void Scm_Init_compile(void);
88 extern void Scm_Init_objlib(void);
89
90 static void finalizable(void);
91
92
93 #ifdef GAUCHE_USE_PTHREADS
94 /* a trick to make sure the gc thread object is linked */
95 static int (*ptr_pthread_create)(void) = NULL;
96 #endif
97
98 /*
99 * Entry point of initlalizing Gauche runtime
100 */
101 void Scm_Init(const char *signature)
102 {
103 /* make sure the main program links the same version of libgauche */
104 if (strcmp(signature, GAUCHE_SIGNATURE) != 0) {
105 Scm_Panic("libgauche version mismatch: libgauche %s, expected %s",
106 GAUCHE_SIGNATURE, signature);
107 }
108
109 /* Some platforms require this. It is harmless if GC is
110 already initialized, so we call it here just in case. */
111 GC_init();
112
113 /* Set up GC parameters. We need to call finalizers at the safe
114 point of VM loop, so we disable auto finalizer invocation, and
115 ask GC to call us back when finalizers are queued. */
116 GC_oom_fn = oom_handler;
117 GC_finalize_on_demand = TRUE;
118 GC_finalizer_notifier = finalizable;
119
120 /* Initialize components. The order is important, for some components
121 rely on the other components to be initialized. */
122 Scm__InitSymbol();
123 Scm__InitModule();
124 Scm__InitKeyword();
125 Scm__InitNumber();
126 Scm__InitChar();
127 Scm__InitClass();
128 Scm__InitExceptions();
129 Scm__InitProc();
130 Scm__InitPort();
131 Scm__InitWrite();
132 Scm__InitCode();
133 Scm__InitVM();
134 Scm__InitParameter();
135 Scm__InitMacro();
136 Scm__InitLoad();
137 Scm__InitRegexp();
138 Scm__InitRead();
139 Scm__InitSignal();
140 Scm__InitSystem();
141 Scm__InitRepl();
142
143 Scm_Init_stdlib(Scm_SchemeModule());
144 Scm_Init_extlib(Scm_GaucheModule());
145 Scm_Init_syslib(Scm_GaucheModule());
146 Scm_Init_moplib(Scm_GaucheModule());
147 Scm_Init_intlib(Scm_GaucheInternalModule());
148
149 Scm_Init_scmlib();
150 Scm_Init_compile();
151 Scm_Init_objlib();
152
153 Scm__InitCompaux();
154
155 Scm_SelectModule(Scm_GaucheModule());
156 Scm__InitAutoloads();
157
158 Scm_SelectModule(Scm_UserModule());
159
160 #ifdef GAUCHE_USE_PTHREADS
161 /* a trick to make sure the gc thread object is linked */
162 ptr_pthread_create = (int (*)(void))GC_pthread_create;
163 #endif
164 }
165
166 /*=============================================================
167 * GC utilities
168 */
169
170 /*
171 * External API to register root set in dynamically loaded library.
172 * Boehm GC doesn't do this automatically on some platforms.
173 *
174 * NB: The scheme we're using to find bss area (by Scm__bss{start|end})
175 * is getting less effective, since more platforms are adopting the
176 * linker that rearranges bss variables. The extensions should not
177 * keep GC_MALLOCED pointer into the bss variable.
178 */
179 void Scm_RegisterDL(void *data_start, void *data_end,
180 void *bss_start, void *bss_end)
181 {
182 if (data_start < data_end) {
183 GC_add_roots((GC_PTR)data_start, (GC_PTR)data_end);
184 }
185 if (bss_start < bss_end) {
186 GC_add_roots((GC_PTR)bss_start, (GC_PTR)bss_end);
187 }
188 }
189
190 /*
191 * Useful routine for debugging, to check if an object is inadvertently
192 * collected.
193 */
194 static void gc_sentinel(ScmObj obj, void *data)
195 {
196 Scm_Printf(SCM_CURERR, "WARNING: object %s(%p) is inadvertently collected\n", (char *)data, obj);
197 }
198
199 void Scm_GCSentinel(void *obj, const char *name)
200 {
201 Scm_RegisterFinalizer(SCM_OBJ(obj), gc_sentinel, (void*)name);
202 }
203
204
205 /*=============================================================
206 * Finalization. Scheme finalizers are added as NO_ORDER.
207 */
208 void Scm_RegisterFinalizer(ScmObj z, ScmFinalizerProc finalizer, void *data)
209 {
210 GC_finalization_proc ofn; GC_PTR ocd;
211 GC_REGISTER_FINALIZER_NO_ORDER(z, (GC_finalization_proc)finalizer,
212 data, &ofn, &ocd);
213 }
214
215 void Scm_UnregisterFinalizer(ScmObj z)
216 {
217 GC_finalization_proc ofn; GC_PTR ocd;
218 GC_REGISTER_FINALIZER_NO_ORDER(z, (GC_finalization_proc)NULL, NULL,
219 &ofn, &ocd);
220 }
221
222 /* GC calls this back when finalizers are queued */
223 void finalizable(void)
224 {
225 ScmVM *vm = Scm_VM();
226 vm->queueNotEmpty |= SCM_VM_FINQ_MASK;
227 }
228
229 /* Called from VM loop. Queue is not empty. */
230 ScmObj Scm_VMFinalizerRun(ScmVM *vm)
231 {
232 GC_invoke_finalizers();
233 vm->queueNotEmpty &= ~SCM_VM_FINQ_MASK;
234 return SCM_UNDEFINED;
235 }
236
237 /*=============================================================
238 * Program cleanup & termination
239 */
240
241 struct cleanup_handler_rec {
242 void (*handler)(void *data);
243 void *data;
244 struct cleanup_handler_rec *next;
245 };
246
247 static struct {
248 int dirty; /* Flag to avoid cleaning up more than once. */
249 struct cleanup_handler_rec *handlers;
250 } cleanup = { TRUE, NULL };
251
252 /* Add cleanup handler. Returns an opaque handle, which can be
253 passed to DeleteCleanupHandler. */
254 void *Scm_AddCleanupHandler(void (*h)(void *d), void *d)
255 {
256 struct cleanup_handler_rec *r = SCM_NEW(struct cleanup_handler_rec);
257 r->handler = h;
258 r->data = d;
259 r->next = cleanup.handlers;
260 cleanup.handlers = r;
261 return r;
262 }
263
264 /* Delete cleanup handler. HANDLE should be an opaque pointer
265 returned from Scm_AddCleanupHandler, but it won't complain if
266 other pointer is given. */
267 void Scm_DeleteCleanupHandler(void *handle)
268 {
269 struct cleanup_handler_rec *x = NULL, *y = cleanup.handlers;
270 while (y) {
271 if (y == handle) {
272 if (x == NULL) {
273 cleanup.handlers = y->next;
274 } else {
275 x->next = y->next;
276 }
277 break;
278 }
279 }
280 }
281
282 /* Scm_Cleanup and Scm_Exit
283 Usually calling Scm_Exit is the easiest way to terminate Gauche
284 application safely. If the application wants to continue operation
285 after shutting down the Scheme part, however, it can call Scm_Cleanup().
286 */
287
288 void Scm_Exit(int code)
289 {
290 Scm_Cleanup();
291 exit(code);
292 }
293
294 void Scm_Cleanup(void)
295 {
296 ScmVM *vm = Scm_VM();
297 ScmObj hp;
298 struct cleanup_handler_rec *ch;
299
300 if (!cleanup.dirty) return;
301 cleanup.dirty = FALSE;
302
303 /* Execute pending dynamic handlers */
304 SCM_FOR_EACH(hp, vm->handlers) {
305 vm->handlers = SCM_CDR(hp);
306 Scm_Apply(SCM_CDAR(hp), SCM_NIL);
307 }
308
309 /* Call the C-registered cleanup handlers. */
310 for (ch = cleanup.handlers; ch; ch = ch->next) {
311 ch->handler(ch->data);
312 }
313
314 /* Flush Scheme ports. */
315 Scm_FlushAllPorts(TRUE);
316 }
317
318 void Scm_Panic(const char *msg, ...)
319 {
320 va_list args;
321 va_start(args, msg);
322 vfprintf(stderr, msg, args);
323 va_end(args);
324 fputc('\n', stderr);
325 fflush(stderr);
326 _exit(1);
327 }
328
329 /* Use this for absolute emergency. Newline is not attached to msg. */
330 void Scm_Abort(const char *msg)
331 {
332 int size = strlen(msg);
333 write(2, msg, size); /* this may return an error, but we don't care */
334 _exit(1);
335 }
336
337 /*=============================================================
338 * Inspect the configuration
339 *
340 */
341
342 const char *Scm_HostArchitecture(void)
343 {
344 return GAUCHE_ARCH;
345 }
346
347 #ifndef PATH_MAX
348 #define PATH_MAX 4096
349 #endif
350
351 ScmObj Scm_LibraryDirectory(void)
352 {
353 static ScmObj dir = SCM_FALSE;
354 if (SCM_FALSEP(dir)) {
355 char buf[PATH_MAX];
356 Scm_GetLibraryDirectory(buf, PATH_MAX, Scm_Error);
357 dir = Scm_MakeString(buf, -1, -1,
358 SCM_MAKSTR_COPYING|SCM_MAKSTR_IMMUTABLE);
359 }
360 return dir;
361 }
362
363 ScmObj Scm_ArchitectureDirectory(void)
364 {
365 static ScmObj dir = SCM_FALSE;
366 if (SCM_FALSEP(dir)) {
367 char buf[PATH_MAX];
368 Scm_GetArchitectureDirectory(buf, PATH_MAX, Scm_Error);
369 dir = Scm_MakeString(buf, -1, -1,
370 SCM_MAKSTR_COPYING|SCM_MAKSTR_IMMUTABLE);
371 }
372 return dir;
373 }
374
375 ScmObj Scm_SiteLibraryDirectory(void)
376 {
377 static ScmObj dir = SCM_FALSE;
378 if (SCM_FALSEP(dir)) {
379 char buf[PATH_MAX];
380 Scm_GetSiteLibraryDirectory(buf, PATH_MAX, Scm_Error);
381 dir = Scm_MakeString(buf, -1, -1,
382 SCM_MAKSTR_COPYING|SCM_MAKSTR_IMMUTABLE);
383 }
384 return dir;
385 }
386
387 ScmObj Scm_SiteArchitectureDirectory(void)
388 {
389 static ScmObj dir = SCM_FALSE;
390 if (SCM_FALSEP(dir)) {
391 char buf[PATH_MAX];
392 Scm_GetSiteArchitectureDirectory(buf, PATH_MAX, Scm_Error);
393 dir = Scm_MakeString(buf, -1, -1,
394 SCM_MAKSTR_COPYING|SCM_MAKSTR_IMMUTABLE);
395 }
396 return dir;
397 }
398
399 /*
400 * When creating DLL under Cygwin, we need the following dummy main()
401 * or we get "undefined reference _WinMain@16" error.
402 * (See cygwin FAQ, http://cygwin.com/faq/)
403 */
404 #ifdef __CYGWIN__
405 int main(void)
406 {
407 return 0;
408 }
409 #endif /*__CYGWIN__*/