root/src/core.c

/* [<][>][^][v][top][bottom][index][help] */

DEFINITIONS

This source file includes following definitions.
  1. oom_handler
  2. Scm_Init
  3. Scm_RegisterDL
  4. gc_sentinel
  5. Scm_GCSentinel
  6. Scm_RegisterFinalizer
  7. Scm_UnregisterFinalizer
  8. finalizable
  9. Scm_VMFinalizerRun
  10. Scm_AddCleanupHandler
  11. Scm_DeleteCleanupHandler
  12. Scm_Exit
  13. Scm_Cleanup
  14. Scm_Panic
  15. Scm_Abort
  16. Scm_HostArchitecture
  17. Scm_LibraryDirectory
  18. Scm_ArchitectureDirectory
  19. Scm_SiteLibraryDirectory
  20. Scm_SiteArchitectureDirectory
  21. 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__*/

/* [<][>][^][v][top][bottom][index][help] */