disable GC_all_interior_pointers
[bpt/emacs.git] / src / emacs.c
index 9d070bd..4777044 100644 (file)
@@ -27,6 +27,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <sys/types.h>
 #include <sys/file.h>
 #include <unistd.h>
+#include <libguile.h>
 
 #include <close-stream.h>
 
@@ -80,6 +81,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "composite.h"
 #include "dispextern.h"
 #include "syntax.h"
+#include "sysselect.h"
 #include "systime.h"
 
 #ifdef HAVE_GNUTLS
@@ -105,8 +107,13 @@ extern void moncontrol (int mode);
 #include <sys/personality.h>
 #endif
 
-static const char emacs_version[] = VERSION;
+Lisp_Object symbol_module;
+Lisp_Object function_module;
+Lisp_Object plist_module;
+
+static const char emacs_version[] = PACKAGE_VERSION;
 static const char emacs_copyright[] = COPYRIGHT;
+static const char emacs_bugreport[] = PACKAGE_BUGREPORT;
 
 /* Empty lisp strings.  To avoid having to build any others.  */
 Lisp_Object empty_unibyte_string, empty_multibyte_string;
@@ -135,7 +142,7 @@ static void *malloc_state_ptr;
 /* From glibc, a routine that returns a copy of the malloc internal state.  */
 extern void *malloc_get_state (void);
 /* From glibc, a routine that overwrites the malloc internal state.  */
-extern int malloc_set_state (void*);
+extern int malloc_set_state (void *);
 /* True if the MALLOC_CHECK_ environment variable was set while
    dumping.  Used to work around a bug in glibc's malloc.  */
 static bool malloc_using_checking;
@@ -163,10 +170,6 @@ bool running_asynch_code;
 bool display_arg;
 #endif
 
-/* An address near the bottom of the stack.
-   Tells GC how to save a copy of the stack.  */
-char *stack_bottom;
-
 #if defined (DOUG_LEA_MALLOC) || defined (GNU_LINUX)
 /* The address where the heap starts (from the first sbrk (0) call).  */
 static void *my_heap_start;
@@ -213,7 +216,7 @@ int initial_argc;
 static void sort_args (int argc, char **argv);
 static void syms_of_emacs (void);
 
-/* C89 needs each string be at most 509 characters, so the usage
+/* C99 needs each string to be at most 4095 characters, and the usage
    strings below are split to not overflow this limit.  */
 static char const *const usage_message[] =
   { "\
@@ -324,7 +327,7 @@ abbreviation for a --option.\n\
 Various environment variables and window system resources also affect\n\
 the operation of Emacs.  See the main documentation.\n\
 \n\
-Report bugs to bug-gnu-emacs@gnu.org.  First, please see the Bugs\n\
+Report bugs to " PACKAGE_BUGREPORT ".  First, please see the Bugs\n\
 section of the Emacs manual or the file BUGS.\n"
   };
 
@@ -391,7 +394,7 @@ init_cmdargs (int argc, char **argv, int skip_args, char *original_pwd)
 {
   register int i;
   Lisp_Object name, dir, handler;
-  ptrdiff_t count = SPECPDL_INDEX ();
+  dynwind_begin ();
   Lisp_Object raw_name;
 
   initial_argv = argv;
@@ -550,7 +553,7 @@ init_cmdargs (int argc, char **argv, int skip_args, char *original_pwd)
          = Fcons (build_unibyte_string (argv[i]), Vcommand_line_args);
     }
 
-  unbind_to (count, Qnil);
+  dynwind_end ();
 }
 
 DEFUN ("invocation-name", Finvocation_name, Sinvocation_name, 0, 0, 0,
@@ -668,9 +671,7 @@ malloc_initialize_hook (void)
        }
 
       malloc_set_state (malloc_state_ptr);
-#ifndef XMALLOC_OVERRUN_CHECK
       free (malloc_state_ptr);
-#endif
     }
   else
     {
@@ -699,14 +700,31 @@ close_output_streams (void)
      _exit (EXIT_FAILURE);
 }
 
-/* ARGSUSED */
+static Lisp_Object
+string_from_scheme (Lisp_Object scheme_string)
+{
+  size_t nbytes;
+  char *c_string = scm_to_utf8_stringn (scheme_string, &nbytes);
+  return make_string_from_bytes (c_string,
+                                 scm_c_string_length (scheme_string),
+                                 nbytes);
+}
+
+Lisp_Object xsymbol_fn;
+Lisp_Object symbol_function_fn;
+
+static int main2 (void *, int, char **);
+
 int
 main (int argc, char **argv)
 {
-#if GC_MARK_STACK
-  Lisp_Object dummy;
-#endif
-  char stack_bottom_variable;
+  scm_boot_guile (argc, argv, main2, NULL);
+}
+
+/* ARGSUSED */
+static int
+main2 (void *ignore, int argc, char **argv)
+{
   bool do_initial_setlocale;
   bool dumping;
   int skip_args = 0;
@@ -724,10 +742,6 @@ main (int argc, char **argv)
   /* If we use --chdir, this records the original directory.  */
   char *original_pwd = 0;
 
-#if GC_MARK_STACK
-  stack_base = &dummy;
-#endif
-
 #ifdef G_SLICE_ALWAYS_MALLOC
   /* This is used by the Cygwin build.  It's not needed starting with
      cygwin-1.7.24, but it doesn't do any harm.  */
@@ -901,9 +915,6 @@ main (int argc, char **argv)
     }
 #endif /* HAVE_SETRLIMIT and RLIMIT_STACK */
 
-  /* Record (approximately) where the stack begins.  */
-  stack_bottom = &stack_bottom_variable;
-
   clearerr (stdin);
 
 #ifndef SYSTEM_MALLOC
@@ -1007,7 +1018,7 @@ main (int argc, char **argv)
     {
       int i;
       printf ("Usage: %s [OPTION-OR-FILENAME]...\n", argv[0]);
-      for (i = 0; i < sizeof usage_message / sizeof *usage_message; i++)
+      for (i = 0; i < ARRAYELTS (usage_message); i++)
        fputs (usage_message[i], stdout);
       exit (0);
     }
@@ -1168,7 +1179,31 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
 
   if (!initialized)
     {
+      /* scm_c_module_define (scm_c_resolve_module ("language elisp lexer"), */
+      /*                      "make-lisp-string", */
+      /*                      scm_c_make_gsubr ("make-lisp-string", 1, 0, 0, */
+      /*                                        string_from_scheme)); */
+      (void *) scm_c_resolve_module ("language elisp spec");
+      symbol_module = scm_c_resolve_module ("elisp-symbols");
+      function_module = scm_c_resolve_module ("elisp-functions");
+      plist_module = scm_c_resolve_module ("elisp-plists");
+      scm_set_current_module (scm_c_resolve_module ("guile-user"));
+
       init_alloc_once ();
+
+      scm_c_module_define (scm_c_resolve_module ("language elisp runtime"),
+                           "make-lisp-string",
+                           scm_c_make_gsubr ("make-lisp-string", 1, 0, 0,
+                                             string_from_scheme));
+      scm_c_module_define (scm_c_resolve_module ("language elisp runtime"),
+                           "lisp-string?",
+                           scm_c_make_gsubr ("stringp", 1, 0, 0, Fstringp));
+
+      xsymbol_fn = scm_c_public_ref ("language elisp runtime", "symbol-desc");
+      symbol_function_fn = scm_c_public_ref ("language elisp runtime", "symbol-function");
+
+      init_guile ();
+      init_fns_once ();
       init_obarray ();
       init_eval_once ();
       init_charset_once ();
@@ -1180,6 +1215,20 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
       init_minibuf_once ();    /* Create list of minibuffers.  */
                                /* Must precede init_window_once.  */
 
+      /* Called before syms_of_fileio, because it sets up
+         Qerror_condition.  Called before other symbol-initialization
+         functions because it sets up symbols used by defsubr.  */
+      syms_of_data ();
+
+      scm_call_7 (scm_c_public_ref ("language elisp runtime", "emacs!"),
+                  SYMBOL_FUNCTION (intern ("symbol-value")),
+                  SYMBOL_FUNCTION (intern ("set")),
+                  SYMBOL_FUNCTION (intern ("boundp")),
+                  SYMBOL_FUNCTION (intern ("default-value")),
+                  SYMBOL_FUNCTION (intern ("set-default")),
+                  SYMBOL_FUNCTION (intern ("default-boundp")),
+                  SYMBOL_FUNCTION (intern ("bind-symbol")));
+
       /* Call syms_of_xfaces before init_window_once because that
         function creates Vterminal_frame.  Termcap frames now use
         faces, and the face implementation uses some symbols as
@@ -1194,8 +1243,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
         CANNOT_DUMP is defined.  */
       syms_of_keyboard ();
 
-      /* Called before syms_of_fileio, because it sets up Qerror_condition.  */
-      syms_of_data ();
       syms_of_fns ();     /* Before syms_of_charset which uses hashtables.  */
       syms_of_fileio ();
       /* Before syms_of_coding to initialize Vgc_cons_threshold.  */
@@ -1375,7 +1422,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
   xputenv ("LANG=C");
 #endif
 
-  init_buffer ();      /* Init default directory of main buffer.  */
+  /* Init buffer storage and default directory of main buffer.  */
+  init_buffer (initialized);
 
   init_callproc_1 ();  /* Must precede init_cmdargs and init_sys_modes.  */
 
@@ -1414,7 +1462,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
       syms_of_floatfns ();
 
       syms_of_buffer ();
-      syms_of_bytecode ();
       syms_of_callint ();
       syms_of_casefiddle ();
       syms_of_casetab ();
@@ -1532,8 +1579,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
 #endif /* HAVE_W32NOTIFY */
 #endif /* WINDOWSNT */
 
-      syms_of_profiler ();
-
       keys_of_casefiddle ();
       keys_of_cmds ();
       keys_of_buffer ();
@@ -1785,8 +1830,8 @@ sort_args (int argc, char **argv)
      0 for an option that takes no arguments,
      1 for an option that takes one argument, etc.
      -1 for an ordinary non-option argument.  */
-  int *options = xnmalloc (argc, sizeof *options);
-  int *priority = xnmalloc (argc, sizeof *priority);
+  int *options = xnmalloc_atomic (argc, sizeof *options);
+  int *priority = xnmalloc_atomic (argc, sizeof *priority);
   int to = 1;
   int incoming_used = 1;
   int from;
@@ -1816,7 +1861,7 @@ sort_args (int argc, char **argv)
            }
 
          /* Look for a match with a known old-fashioned option.  */
-         for (i = 0; i < sizeof (standard_args) / sizeof (standard_args[0]); i++)
+         for (i = 0; i < ARRAYELTS (standard_args); i++)
            if (!strcmp (argv[from], standard_args[i].name))
              {
                options[from] = standard_args[i].nargs;
@@ -1838,8 +1883,7 @@ sort_args (int argc, char **argv)
 
              match = -1;
 
-             for (i = 0;
-                  i < sizeof (standard_args) / sizeof (standard_args[0]); i++)
+             for (i = 0; i < ARRAYELTS (standard_args); i++)
                if (standard_args[i].longname
                    && !strncmp (argv[from], standard_args[i].longname,
                                 thislen))
@@ -2036,7 +2080,6 @@ shut_down_emacs (int sig, Lisp_Object stuff)
 
   /* There is a tendency for a SIGIO signal to arrive within exit,
      and cause a SIGHUP because the input descriptor is already closed.  */
-  unrequest_sigio ();
   ignore_sigio ();
 
   /* Do this only if terminating normally, we want glyph matrices
@@ -2080,7 +2123,7 @@ You must run Emacs in batch mode in order to dump it.  */)
 {
   Lisp_Object tem;
   Lisp_Object symbol;
-  ptrdiff_t count = SPECPDL_INDEX ();
+  dynwind_begin ();
 
   check_pure_size ();
 
@@ -2155,13 +2198,8 @@ You must run Emacs in batch mode in order to dump it.  */)
   malloc_state_ptr = malloc_get_state ();
 #endif
 
-#ifdef USE_MMAP_FOR_BUFFERS
-  mmap_set_vars (0);
-#endif
   unexec (SSDATA (filename), !NILP (symfile) ? SSDATA (symfile) : 0);
-#ifdef USE_MMAP_FOR_BUFFERS
-  mmap_set_vars (1);
-#endif
+
 #ifdef DOUG_LEA_MALLOC
   free (malloc_state_ptr);
 #endif
@@ -2175,7 +2213,8 @@ You must run Emacs in batch mode in order to dump it.  */)
 
   Vpurify_flag = tem;
 
-  return unbind_to (count, Qnil);
+  dynwind_end ();
+  return Qnil;
 }
 
 #endif /* not CANNOT_DUMP */
@@ -2415,22 +2454,13 @@ from the parent process and its tty file descriptors.  */)
 void
 syms_of_emacs (void)
 {
+#include "emacs.x"
+
   DEFSYM (Qfile_name_handler_alist, "file-name-handler-alist");
   DEFSYM (Qrisky_local_variable, "risky-local-variable");
   DEFSYM (Qkill_emacs, "kill-emacs");
   DEFSYM (Qkill_emacs_hook, "kill-emacs-hook");
 
-#ifndef CANNOT_DUMP
-  defsubr (&Sdump_emacs);
-#endif
-
-  defsubr (&Skill_emacs);
-
-  defsubr (&Sinvocation_name);
-  defsubr (&Sinvocation_directory);
-  defsubr (&Sdaemonp);
-  defsubr (&Sdaemon_initialized);
-
   DEFVAR_LISP ("command-line-args", Vcommand_line_args,
               doc: /* Args passed by shell to Emacs, as a list of strings.
 Many arguments are deleted from the list as they are processed.  */);
@@ -2460,6 +2490,12 @@ Emacs is running.  */);
               doc: /* String containing the configuration options Emacs was built with.  */);
   Vsystem_configuration_options = build_string (EMACS_CONFIG_OPTIONS);
 
+  DEFVAR_LISP ("system-configuration-features", Vsystem_configuration_features,
+              doc: /* String listing some of the main features this Emacs was compiled with.
+An element of the form \"FOO\" generally means that HAVE_FOO was
+defined during the build.  */);
+  Vsystem_configuration_features = build_string (EMACS_CONFIG_FEATURES);
+
   DEFVAR_BOOL ("noninteractive", noninteractive1,
               doc: /* Non-nil means Emacs is running without interactive terminal.  */);
 
@@ -2537,6 +2573,10 @@ This is nil during initialization.  */);
               doc: /* Version numbers of this version of Emacs.  */);
   Vemacs_version = build_string (emacs_version);
 
+  DEFVAR_LISP ("report-emacs-bug-address", Vreport_emacs_bug_address,
+              doc: /* Address of mailing list for GNU Emacs bugs.  */);
+  Vreport_emacs_bug_address = build_string (emacs_bugreport);
+
   DEFVAR_LISP ("dynamic-library-alist", Vdynamic_library_alist,
     doc: /* Alist of dynamic libraries vs external files implementing them.
 Each element is a list (LIBRARY FILE...), where the car is a symbol