X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/9ac6d28ab8c29547d9f9365dc8f7cea13c32ef7a..41120e0f595b16387eebfbf731fff70481de1b4b:/src/emacs.c diff --git a/src/emacs.c b/src/emacs.c index 117ce4decd..1f910efe56 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 @@ -106,6 +107,10 @@ extern void moncontrol (int mode); #include #endif +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; @@ -165,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; @@ -393,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; @@ -552,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, @@ -670,9 +671,7 @@ malloc_initialize_hook (void) } malloc_set_state (malloc_state_ptr); -#ifndef XMALLOC_OVERRUN_CHECK free (malloc_state_ptr); -#endif } else { @@ -701,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; @@ -726,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. */ @@ -903,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 @@ -1170,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 (); @@ -1182,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 @@ -1196,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. */ @@ -1417,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 (); @@ -1535,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 (); @@ -1788,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; @@ -2038,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 @@ -2082,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 (); @@ -2172,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 */ @@ -2412,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. */); @@ -2500,7 +2533,8 @@ both `lib-src' (on MS-DOS, `info') and `etc' directories are found within the variable `invocation-directory' or its parent. For example, this is the case when running an uninstalled Emacs executable from its build directory. */); - Vinstallation_directory = Qnil; + if (!Vinstallation_directory) + Vinstallation_directory = Qnil; DEFVAR_LISP ("system-messages-locale", Vsystem_messages_locale, doc: /* System locale for messages. */);