X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/1e757eb0a5bab2bdd26de8a6553ee5c2b2e2a381..bc203f9e4311ddb2c6ea12c14ae2dc2f463591c1:/src/emacs.c diff --git a/src/emacs.c b/src/emacs.c index 9d070bda51..4777044215 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -27,6 +27,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include @@ -80,6 +81,7 @@ along with GNU Emacs. If not, see . */ #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 #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