libguile/init.c

   1 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
   2  *   2004, 2006, 2009, 2010, 2011, 2012, 2013,
   3  *   2014 Free Software Foundation, Inc.
   4  *
   5  * This library is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU Lesser General Public License
   7  * as published by the Free Software Foundation; either version 3 of
   8  * the License, or (at your option) any later version.
   9  *
  10  * This library is distributed in the hope that it will be useful, but
  11  * WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * Lesser General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU Lesser General Public
  16  * License along with this library; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  18  * 02110-1301 USA
  19  */
  20
  21
  22 \f
  23 /* Include the headers for just about everything.
  24    We call all their initialization functions.  */
  25
  26 #ifdef HAVE_CONFIG_H
  27 #  include <config.h>
  28 #endif
  29
  30 #include <stdlib.h>
  31 #include <stdio.h>
  32 #include <sys/stat.h>
  33 #include <fcntl.h>
  34 #include <gmp.h>
  35
  36 #include "libguile/_scm.h"
  37
  38 /* Everybody has an init function.  */
  39 #include "libguile/alist.h"
  40 #include "libguile/arbiters.h"
  41 #include "libguile/async.h"
  42 #include "libguile/backtrace.h"
  43 #include "libguile/bitvectors.h"
  44 #include "libguile/boolean.h"
  45 #include "libguile/bytevectors.h"
  46 #include "libguile/chars.h"
  47 #include "libguile/control.h"
  48 #include "libguile/continuations.h"
  49 #include "libguile/debug.h"
  50 #ifdef GUILE_DEBUG_MALLOC
  51 #include "libguile/debug-malloc.h"
  52 #endif
  53 #include "libguile/deprecation.h"
  54 #include "libguile/dynl.h"
  55 #include "libguile/dynwind.h"
  56 #include "libguile/eq.h"
  57 #include "libguile/error.h"
  58 #include "libguile/eval.h"
  59 #include "libguile/evalext.h"
  60 #include "libguile/expand.h"
  61 #include "libguile/feature.h"
  62 #include "libguile/filesys.h"
  63 #include "libguile/finalizers.h"
  64 #include "libguile/fluids.h"
  65 #include "libguile/fports.h"
  66 #include "libguile/frames.h"
  67 #include "libguile/gc.h"
  68 #include "libguile/generalized-arrays.h"
  69 #include "libguile/generalized-vectors.h"
  70 #include "libguile/goops.h"
  71 #include "libguile/gsubr.h"
  72 #include "libguile/hash.h"
  73 #include "libguile/hashtab.h"
  74 #include "libguile/hooks.h"
  75 #include "libguile/gettext.h"
  76 #include "libguile/i18n.h"
  77 #include "libguile/instructions.h"
  78 #include "libguile/ioext.h"
  79 #include "libguile/keywords.h"
  80 #include "libguile/list.h"
  81 #include "libguile/load.h"
  82 #include "libguile/macros.h"
  83 #include "libguile/mallocs.h"
  84 #include "libguile/memoize.h"
  85 #include "libguile/modules.h"
  86 #include "libguile/net_db.h"
  87 #include "libguile/numbers.h"
  88 #include "libguile/loader.h"
  89 #include "libguile/objprop.h"
  90 #include "libguile/options.h"
  91 #include "libguile/pairs.h"
  92 #include "libguile/poll.h"
  93 #include "libguile/ports.h"
  94 #include "libguile/posix.h"
  95 #ifdef ENABLE_REGEX
  96 #include "libguile/regex-posix.h"
  97 #endif
  98 #include "libguile/print.h"
  99 #include "libguile/procprop.h"
 100 #include "libguile/procs.h"
 101 #include "libguile/programs.h"
 102 #include "libguile/promises.h"
 103 #include "libguile/array-map.h"
 104 #include "libguile/random.h"
 105 #include "libguile/rdelim.h"
 106 #include "libguile/read.h"
 107 #include "libguile/rw.h"
 108 #include "libguile/scmsigs.h"
 109 #include "libguile/script.h"
 110 #include "libguile/simpos.h"
 111 #include "libguile/smob.h"
 112 #include "libguile/socket.h"
 113 #include "libguile/sort.h"
 114 #include "libguile/srcprop.h"
 115 #include "libguile/stackchk.h"
 116 #include "libguile/stacks.h"
 117 #include "libguile/stime.h"
 118 #include "libguile/strings.h"
 119 #include "libguile/srfi-1.h"
 120 #include "libguile/srfi-4.h"
 121 #include "libguile/srfi-13.h"
 122 #include "libguile/srfi-14.h"
 123 #include "libguile/srfi-60.h"
 124 #include "libguile/strorder.h"
 125 #include "libguile/strports.h"
 126 #include "libguile/struct.h"
 127 #include "libguile/symbols.h"
 128 #include "libguile/throw.h"
 129 #include "libguile/arrays.h"
 130 #include "libguile/trees.h"
 131 #include "libguile/values.h"
 132 #include "libguile/variable.h"
 133 #include "libguile/vectors.h"
 134 #include "libguile/version.h"
 135 #include "libguile/vm.h"
 136 #include "libguile/vports.h"
 137 #include "libguile/guardians.h"
 138 #include "libguile/extensions.h"
 139 #include "libguile/uniform.h"
 140 #include "libguile/deprecated.h"
 141
 142 #include "libguile/init.h"
 143 #include "libguile/private-options.h"
 144
 145 #ifdef HAVE_STRING_H
 146 #include <string.h>
 147 #endif
 148 #include <unistd.h>
 149
 150
 151 \f
 152 /* initializing standard and current I/O ports */
 153
 154 typedef struct
 155 {
 156   int fdes;
 157   char *mode;
 158 } stream_body_data;
 159
 160 /* proc to be called in scope of exception handler stream_handler. */
 161 static SCM
 162 stream_body (void *data)
 163 {
 164   stream_body_data *body_data = (stream_body_data *) data;
 165   SCM port = scm_fdes_to_port (body_data->fdes, body_data->mode, SCM_BOOL_F);
 166   scm_set_port_revealed_x (port, SCM_INUM1);
 167   return port;
 168 }
 169
 170 /* exception handler for stream_body.  */
 171 static SCM
 172 stream_handler (void *data SCM_UNUSED,
 173                 SCM tag SCM_UNUSED,
 174                 SCM throw_args SCM_UNUSED)
 175 {
 176   return SCM_BOOL_F;
 177 }
 178
 179 /* Convert a file descriptor to a port, using scm_fdes_to_port.
 180    - set the revealed count for FILE's file descriptor to 1, so
 181    that fdes won't be closed when the port object is GC'd.
 182    - catch exceptions: allow Guile to be able to start up even
 183    if it has been handed bogus stdin/stdout/stderr.  replace the
 184    bad ports with void ports.  */
 185 static SCM
 186 scm_standard_stream_to_port (int fdes, char *mode)
 187 {
 188   SCM port;
 189   stream_body_data body_data;
 190
 191   body_data.fdes = fdes;
 192   body_data.mode = mode;
 193   port = scm_internal_catch (SCM_BOOL_T, stream_body, &body_data,
 194                              stream_handler, NULL);
 195   if (scm_is_false (port))
 196     port = scm_void_port (mode);
 197   return port;
 198 }
 199
 200 /* Create standard ports from stdin, stdout, and stderr.  */
 201 static void
 202 scm_init_standard_ports ()
 203 {
 204   /* From the SCSH manual:
 205
 206      It can be useful to turn I/O buffering off in some cases, for
 207      example when an I/O stream is to be shared by multiple
 208      subprocesses.  For this reason, scsh allocates an unbuffered port
 209      for file descriptor 0 at start-up time.
 210
 211      Because shells frequently share stdin with subprocesses, if the
 212      shell does buffered reads, it might ``steal'' input intended for
 213      a subprocess.  For this reason, all shells, including sh, csh,
 214      and scsh, read stdin unbuffered.  Applications that can tolerate
 215      buffered input on stdin can reset \ex{(current-input-port)} to
 216      block buffering for higher performance.  */
 217
 218   scm_set_current_input_port
 219     (scm_standard_stream_to_port (0, isatty (0) ? "r0" : "r"));
 220   scm_set_current_output_port
 221     (scm_standard_stream_to_port (1, isatty (1) ? "w0" : "w"));
 222   scm_set_current_error_port
 223     (scm_standard_stream_to_port (2, isatty (2) ? "w0" : "w"));
 224   scm_set_current_warning_port (scm_current_error_port ());
 225 }
 226
 227
 228 \f
 229 /* Loading the startup Scheme files.  */
 230
 231 /* The boot code "ice-9/boot-9" is only loaded by scm_boot_guile when
 232    this is false.  The unexec code uses this, to keep ice_9 from being
 233    loaded into dumped guile executables.  */
 234 int scm_ice_9_already_loaded = 0;
 235
 236 void
 237 scm_load_startup_files ()
 238 {
 239   /* We want a path only containing directories from GUILE_LOAD_PATH,
 240      SCM_SITE_DIR and SCM_LIBRARY_DIR when searching for the site init
 241      file, so we do this before loading Ice-9.  */
 242   SCM init_path =
 243     scm_sys_search_load_path (scm_from_locale_string ("init.scm"));
 244
 245   /* Load Ice-9.  */
 246   if (!scm_ice_9_already_loaded)
 247     {
 248       scm_c_primitive_load_path ("ice-9/boot-9");
 249
 250       /* Load the init.scm file.  */
 251       if (scm_is_true (init_path))
 252         scm_primitive_load (init_path);
 253     }
 254 }
 255
 256 \f
 257 /* The main init code.  */
 258
 259 #ifdef _UNICOS
 260 typedef int setjmp_type;
 261 #else
 262 typedef long setjmp_type;
 263 #endif
 264
 265 /* All the data needed to invoke the main function.  */
 266 struct main_func_closure
 267 {
 268   /* the function to call */
 269   void (*main_func)(void *closure, int argc, char **argv);
 270   void *closure;                /* dummy data to pass it */
 271   int argc;
 272   char **argv;                  /* the argument list it should receive */
 273 };
 274
 275 static void *invoke_main_func(void *body_data);
 276
 277
 278 /* Fire up the Guile Scheme interpreter.
 279
 280    Call MAIN_FUNC, passing it CLOSURE, ARGC, and ARGV.  MAIN_FUNC
 281    should do all the work of the program (initializing other packages,
 282    reading user input, etc.) before returning.  When MAIN_FUNC
 283    returns, call exit (EXIT_FAILURE); this function never returns.
 284    If you want some other exit value, MAIN_FUNC may call exit itself.
 285
 286    scm_boot_guile arranges for program-arguments to return the strings
 287    given by ARGC and ARGV.  If MAIN_FUNC modifies ARGC/ARGV, should
 288    call scm_set_program_arguments with the final list, so Scheme code
 289    will know which arguments have been processed.
 290
 291    scm_boot_guile establishes a catch-all catch handler which prints
 292    an error message and exits the process.  This means that Guile
 293    exits in a coherent way when system errors occur and the user isn't
 294    prepared to handle it.  If the user doesn't like this behavior,
 295    they can establish their own universal catcher to shadow this one.
 296
 297    Why must the caller do all the real work from MAIN_FUNC?  The
 298    garbage collector assumes that all local variables of type SCM will
 299    be above scm_boot_guile's stack frame on the stack.  If you try to
 300    manipulate SCM values after this function returns, it's the luck of
 301    the draw whether the GC will be able to find the objects you
 302    allocate.  So, scm_boot_guile function exits, rather than
 303    returning, to discourage people from making that mistake.  */
 304
 305
 306 void
 307 scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure)
 308 {
 309   void *res;
 310   struct main_func_closure c;
 311
 312   c.main_func = main_func;
 313   c.closure = closure;
 314   c.argc = argc;
 315   c.argv = argv;
 316
 317   res = scm_with_guile (invoke_main_func, &c);
 318
 319   /* If the caller doesn't want this, they should exit from main_func
 320      themselves.
 321   */
 322   if (res == NULL)
 323     exit (EXIT_FAILURE);
 324   else
 325     exit (EXIT_SUCCESS);
 326 }
 327
 328 static void *
 329 invoke_main_func (void *body_data)
 330 {
 331   struct main_func_closure *closure = (struct main_func_closure *) body_data;
 332
 333   scm_i_set_boot_program_arguments (closure->argc, closure->argv);
 334   (*closure->main_func) (closure->closure, closure->argc, closure->argv);
 335
 336   scm_restore_signals ();
 337
 338   /* This tick gives any pending
 339    * asyncs a chance to run.  This must be done after
 340    * the call to scm_restore_signals.
 341    */
 342   SCM_ASYNC_TICK;
 343
 344   /* Indicate success by returning non-NULL.
 345    */
 346   return (void *)1;
 347 }
 348
 349 scm_i_pthread_mutex_t scm_i_init_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 350 int scm_initialized_p = 0;
 351
 352 static void *
 353 really_cleanup_for_exit (void *unused)
 354 {
 355   scm_flush_all_ports ();
 356   return NULL;
 357 }
 358
 359 static void
 360 cleanup_for_exit ()
 361 {
 362   if (scm_i_pthread_mutex_trylock (&scm_i_init_mutex) == 0)
 363     scm_i_pthread_mutex_unlock (&scm_i_init_mutex);
 364   else
 365     {
 366       fprintf (stderr, "Cannot exit gracefully when init is in progress; aborting.\n");
 367       abort ();
 368     }
 369
 370   /* This function might be called in non-guile mode, so we need to
 371      enter it temporarily.
 372   */
 373   scm_with_guile (really_cleanup_for_exit, NULL);
 374 }
 375
 376 void
 377 scm_i_init_guile (void *base)
 378 {
 379   if (scm_initialized_p)
 380     return;
 381
 382   scm_storage_prehistory ();
 383   scm_threads_prehistory (base);  /* requires storage_prehistory */
 384   scm_weak_table_prehistory ();        /* requires storage_prehistory */
 385 #ifdef GUILE_DEBUG_MALLOC
 386   scm_debug_malloc_prehistory ();
 387 #endif
 388   scm_symbols_prehistory ();      /* requires weak_table_prehistory */
 389   scm_modules_prehistory ();
 390   scm_init_array_handle ();
 391   scm_bootstrap_bytevectors ();   /* Requires array-handle */
 392   scm_bootstrap_instructions ();
 393   scm_bootstrap_loader ();
 394   scm_bootstrap_programs ();
 395   scm_bootstrap_vm ();
 396   scm_register_r6rs_ports ();
 397   scm_register_foreign ();
 398   scm_register_foreign_object ();
 399   scm_register_srfi_1 ();
 400   scm_register_srfi_60 ();
 401   scm_register_poll ();
 402
 403   scm_init_strings ();            /* Requires array-handle */
 404   scm_init_struct ();             /* Requires strings */
 405   scm_smob_prehistory ();
 406   scm_init_variable ();
 407   scm_init_continuations ();      /* requires smob_prehistory */
 408   scm_init_root ();               /* requires continuations */
 409   scm_init_threads ();            /* requires smob_prehistory */
 410   scm_init_gsubr ();
 411   scm_init_thread_procs ();       /* requires gsubrs */
 412   scm_init_procprop ();
 413   scm_init_alist ();
 414   scm_init_arbiters ();           /* requires smob_prehistory */
 415   scm_init_async ();              /* requires smob_prehistory */
 416   scm_init_boolean ();
 417   scm_init_chars ();
 418 #ifdef GUILE_DEBUG_MALLOC
 419   scm_init_debug_malloc ();
 420 #endif
 421   scm_init_dynwind ();            /* requires smob_prehistory */
 422   scm_init_eq ();
 423   scm_init_error ();
 424   scm_init_finalizers ();
 425   scm_init_fluids ();
 426   scm_init_control ();            /* requires fluids */
 427   scm_init_feature ();
 428   scm_init_backtrace ();
 429   scm_init_fports ();
 430   scm_init_strports ();
 431   scm_init_ports ();
 432   scm_init_hash ();
 433   scm_init_hashtab ();
 434   scm_init_deprecation ();
 435   scm_init_objprop ();
 436   scm_init_promises ();         /* requires smob_prehistory */
 437   scm_init_hooks ();            /* Requires smob_prehistory */
 438   scm_init_stime ();
 439   scm_init_gc ();               /* Requires hooks and `get_internal_run_time' */
 440   scm_init_gc_protect_object ();  /* requires threads_prehistory */
 441   scm_init_gettext ();
 442   scm_init_ioext ();
 443   scm_init_keywords ();    /* Requires smob_prehistory */
 444   scm_init_fports_keywords ();
 445   scm_init_list ();
 446   scm_init_random ();      /* Requires smob_prehistory */
 447   scm_init_macros ();      /* Requires smob_prehistory and random */
 448   scm_init_mallocs ();     /* Requires smob_prehistory */
 449   scm_init_modules ();     /* Requires smob_prehistory */
 450   scm_init_numbers ();
 451   scm_init_options ();
 452   scm_init_pairs ();
 453   scm_init_filesys ();     /* Requires smob_prehistory */
 454 #ifdef HAVE_POSIX
 455   scm_init_posix ();
 456 #endif
 457 #ifdef ENABLE_REGEX
 458   scm_init_regex_posix (); /* Requires smob_prehistory */
 459 #endif
 460   scm_init_procs ();
 461   scm_init_scmsigs ();
 462 #ifdef HAVE_NETWORKING
 463   scm_init_net_db ();
 464   scm_init_socket ();
 465 #endif
 466   scm_init_sort ();
 467   scm_init_srcprop ();     /* requires smob_prehistory */
 468   scm_init_stackchk ();
 469
 470   scm_init_generalized_arrays ();
 471   scm_init_generalized_vectors ();
 472   scm_init_vectors ();  /* Requires array-handle, */
 473   scm_init_uniform ();
 474   scm_init_bitvectors ();  /* Requires smob_prehistory, array-handle */
 475   scm_init_srfi_4 ();  /* Requires smob_prehistory, array-handle */
 476   scm_init_arrays ();    /* Requires smob_prehistory, array-handle */
 477   scm_init_array_map ();
 478
 479   scm_init_frames ();   /* Requires smob_prehistory */
 480   scm_init_stacks ();   /* Requires strings, struct, frames */
 481   scm_init_symbols ();
 482   scm_init_values ();   /* Requires struct */
 483   scm_init_load ();     /* Requires strings */
 484   scm_init_print ();    /* Requires strings, struct, smob */
 485   scm_init_read ();
 486   scm_init_strorder ();
 487   scm_init_srfi_13 ();
 488   scm_init_srfi_14 ();  /* Requires smob_prehistory */
 489   scm_init_throw ();    /* Requires smob_prehistory */
 490   scm_init_trees ();
 491   scm_init_version ();
 492   scm_init_weak_set ();
 493   scm_init_weak_table ();
 494   scm_init_weak_vectors ();
 495   scm_init_guardians (); /* requires smob_prehistory */
 496   scm_init_vports ();
 497   scm_init_standard_ports ();  /* Requires fports */
 498   scm_init_expand ();   /* Requires structs */
 499   scm_init_memoize ();  /* Requires smob_prehistory */
 500   scm_init_eval ();     /* Requires smob_prehistory */
 501   scm_init_load_path ();
 502   scm_init_eval_in_scheme ();
 503   scm_init_evalext ();
 504   scm_init_debug ();    /* Requires macro smobs */
 505   scm_init_simpos ();
 506 #if HAVE_MODULES
 507   scm_init_dynamic_linking (); /* Requires smob_prehistory */
 508 #endif
 509   scm_bootstrap_i18n ();
 510   scm_init_script ();
 511
 512   scm_init_goops ();
 513
 514 #if SCM_ENABLE_DEPRECATED == 1
 515   scm_i_init_deprecated ();
 516 #endif
 517
 518   scm_initialized_p = 1;
 519
 520   scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
 521
 522   scm_init_rdelim ();
 523   scm_init_rw ();
 524   scm_init_extensions ();
 525
 526   atexit (cleanup_for_exit);
 527   scm_load_startup_files ();
 528   scm_init_load_should_auto_compile ();
 529
 530   /* Capture the dynamic state after loading boot-9, so that new threads end up
 531      in the guile-user module. */
 532   scm_init_threads_default_dynamic_state ();
 533
 534   /* Finally, cause finalizers to run in a separate thread.  */
 535   scm_init_finalizer_thread ();
 536 }
 537
 538 /*
 539   Local Variables:
 540   c-file-style: "gnu"
 541   End:
 542 */