Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994
Free Software Foundation, Inc.
Copyright (C) 1995 Sun Microsystems, Inc.
- Copyright (C) 2000 Ben Wing.
+ Copyright (C) 2000, 2002 Ben Wing.
+ Copyright (C) 2000,2002,2005,2006,2010 MORIOKA Tomohiko.
This file is part of XEmacs.
#include "sysfile.h"
#include "systime.h"
+#ifdef CYGWIN
+#include "syswindows.h"
+#endif
+
#ifdef PDUMP
#include "dumper.h"
#endif
Lisp_Object Vexec_directory, Vconfigure_exec_directory;
Lisp_Object Vlisp_directory, Vconfigure_lisp_directory;
Lisp_Object Vmule_lisp_directory, Vconfigure_mule_lisp_directory;
+Lisp_Object Vutf_2000_lisp_directory, Vconfigure_utf_2000_lisp_directory;
Lisp_Object Vmodule_directory, Vconfigure_module_directory;
Lisp_Object Vsite_module_directory, Vconfigure_site_module_directory;
Lisp_Object Vconfigure_package_path;
#endif
/* Number of bytes of writable memory we can expect to be able to get */
-unsigned int lim_data;
+unsigned long lim_data;
/* WARNING!
or do other non-essential stuff. */
int preparing_for_armageddon;
+/* Nonzero means we're in an unstable situation and need to skip
+ i18n conversions and such during printing. */
+int inhibit_non_essential_printing_operations;
static JMP_BUF run_temacs_catch;
static int run_temacs_argc;
static char **run_temacs_argv;
static char *run_temacs_args;
-static size_t run_temacs_argv_size;
-static size_t run_temacs_args_size;
+static EMACS_INT run_temacs_argv_size;
+static EMACS_INT run_temacs_args_size;
static void shut_down_emacs (int sig, Lisp_Object stuff, int no_auto_save);
+/* ------------------------------- */
+/* low-level debugging functions */
+/* ------------------------------- */
+
+#if defined (WIN32_NATIVE) && defined (DEBUG_XEMACS)
+#define debugging_breakpoint() DebugBreak ()
+#else
+#define debugging_breakpoint()
+#endif
+
+void
+debug_break (void)
+{
+ debugging_breakpoint ();
+}
+
+#if defined (WIN32_NATIVE) || defined (CYGWIN)
+
+/* Return whether all bytes in the specified memory block can be read. */
+int
+debug_can_access_memory (void *ptr, Bytecount len)
+{
+ return !IsBadReadPtr (ptr, len);
+}
+
+#else /* !(defined (WIN32_NATIVE) || defined (CYGWIN)) */
+
+/* #### There must be a better way!!!! */
+
+static JMP_BUF memory_error_jump;
+
+static SIGTYPE
+debug_memory_error (int signum)
+{
+ EMACS_REESTABLISH_SIGNAL (signum, debug_memory_error);
+ EMACS_UNBLOCK_SIGNAL (signum);
+ LONGJMP (memory_error_jump, 1);
+}
+
+/* Return whether all bytes in the specified memory block can be read. */
+int
+debug_can_access_memory (void *ptr, Bytecount len)
+{
+ /* Use volatile to protect variables from being clobbered by longjmp. */
+ SIGTYPE (*volatile old_sigbus) (int);
+ SIGTYPE (*volatile old_sigsegv) (int);
+ volatile int old_errno = errno;
+ volatile int retval = 1;
+
+ if (!SETJMP (memory_error_jump))
+ {
+ old_sigbus =
+ (SIGTYPE (*) (int)) signal (SIGBUS, debug_memory_error);
+ old_sigsegv =
+ (SIGTYPE (*) (int)) signal (SIGSEGV, debug_memory_error);
+
+ if (len > 1)
+ /* If we can, try to avoid problems with super-optimizing compilers
+ that might decide that memcmp (ptr, ptr, len) can be optimized
+ away since its result is always 1. */
+ memcmp (ptr, (char *) ptr + 1, len - 1);
+ else
+ memcmp (ptr, ptr, len);
+ }
+ else
+ retval = 0;
+ signal (SIGBUS, old_sigbus);
+ signal (SIGSEGV, old_sigsegv);
+ errno = old_errno;
+
+ return retval;
+}
+
+#endif /* defined (WIN32_NATIVE) || defined (CYGWIN) */
+
+#ifdef DEBUG_XEMACS
+
+DEFUN ("force-debugging-signal", Fforce_debugging_signal, 0, 1, 0, /*
+Cause XEmacs to enter the debugger.
+On some systems, there may be no way to do this gracefully; if so,
+nothing happens unless ABORT is non-nil, in which case XEmacs will
+ABORT() -- a sure-fire way to immediately get back to the debugger,
+but also a sure-fire way to kill XEmacs (and dump core on Unix
+systems)!
+*/
+ (abort_))
+{
+ debugging_breakpoint ();
+ if (!NILP (abort_))
+ ABORT ();
+ return Qnil;
+}
+
+#endif /* DEBUG_XEMACS */
+
static void
ensure_no_quitting_from_now_on (void)
{
fatal_error_signal (int sig)
{
fatal_error_in_progress++;
+ inhibit_non_essential_printing_operations = 1;
preparing_for_armageddon = 1;
ensure_no_quitting_from_now_on ();
__try
{
fatal_error_in_progress++;
+ inhibit_non_essential_printing_operations = 1;
preparing_for_armageddon = 1;
ensure_no_quitting_from_now_on ();
#endif /* not SYSTEM_MALLOC or HAVE_LIBMCHECK or DOUG_LEA_MALLOC */
noninteractive = 0;
+ inhibit_non_essential_printing_operations = 1;
#ifdef NeXT
/* 19-Jun-1995 -baw
syms_of_postgresql ();
#endif
+#ifdef HAVE_CONCORD
+ syms_of_concord ();
+#endif
+
/* Now create the subtypes for the types that have them.
We do this before the vars_*() because more symbols
may get initialized here. */
structure_type_create_faces ();
structure_type_create_rangetab ();
structure_type_create_hash_table ();
+#ifdef HAVE_CONCORD
+ structure_type_create_concord ();
+#endif
/* Now initialize the image instantiator formats and associated symbols.
Other than the first function below, the functions may
vars_of_postgresql();
#endif
+#ifdef HAVE_CONCORD
+ vars_of_concord ();
+#endif
+
#ifdef HAVE_GPM
vars_of_gpmevent ();
#endif
*/
specifier_vars_of_glyphs ();
+ specifier_vars_of_glyphs_widget ();
specifier_vars_of_gutter ();
#ifdef HAVE_MENUBARS
specifier_vars_of_menubar ();
/* Calls make_lisp_hash_table() and creates a keymap */
complex_vars_of_event_stream ();
+ /* This initializes data-sources of built-in genres */
+#ifdef HAVE_CONCORD
+ complex_vars_of_concord ();
+#endif
+
#ifdef ERROR_CHECK_GC
{
extern int always_gc;
structure_type_create_faces ();
structure_type_create_rangetab ();
structure_type_create_hash_table ();
+#ifdef HAVE_CONCORD
+ structure_type_create_concord ();
+#endif
lstream_type_create ();
#ifdef FILE_CODING
#endif /* QUANTIFY */
initialized = 1;
+ inhibit_non_essential_printing_operations = 0;
/* This never returns. */
initial_command_loop (load_me);
}
if (best < 0)
- abort ();
+ ABORT ();
/* Copy the highest priority remaining option, with its args, to NEW_ARGV. */
new_argv[to++] = argv[best];
quantify_clear_data ();
#endif /* QUANTIFY */
+ inhibit_non_essential_printing_operations = 1;
suppress_early_error_handler_backtrace = 0;
lim_data = 0; /* force reinitialization of this variable */
if (!initialized)
{
#ifdef DOUG_LEA_MALLOC
- mallopt (M_MMAP_MAX, 0);
+ if (mallopt (M_MMAP_MAX, 0) != 1)
+ ABORT();
#endif
run_temacs_argc = 0;
if (! SETJMP (run_temacs_catch))
if (rc != 0)
{
stderr_out ("malloc_set_state failed, rc = %d\n", rc);
- abort ();
+ ABORT ();
}
#if 0
free (malloc_state_ptr);
defined(_NO_MALLOC_WARNING_) || \
(defined(__GLIBC__) && __GLIBC_MINOR__ < 1 && !defined(MULE)) || \
defined(DEBUG_DOUG_LEA_MALLOC)
- mallopt (M_MMAP_MAX, 64);
+ if(mallopt (M_MMAP_MAX, 0) != 1)
+ ABORT();
#endif
#ifdef REL_ALLOC
r_alloc_reinit ();
/* Disable all calls to free() when XEmacs is exiting and it doesn't */
/* matter. */
__free_hook =
-#ifdef __GNUC__ /* prototype of __free_hook varies with glibc version */
+#if defined __GNUC__ || defined __INTEL_COMPILER
+/* prototype of __free_hook varies with glibc version */
(__typeof__ (__free_hook))
#endif
voodoo_free_hook;
#ifdef HAVE_MS_WINDOWS
/* If we displayed a message on the console, then we must allow the
- user to see this message. This may be unnecessary, but can't hurt,
- and we can't necessarily check arg; e.g. xemacs --help kills with
- argument 0. */
- if (mswindows_message_outputted)
+ user to see this message. This may be unnecessary, but can't
+ hurt, and we can't necessarily check arg; e.g. xemacs --help
+ kills with argument 0.
+
+ Don't do this in batch mode, it makes no sense and is more
+ annoying than useful. --andyp */
+ if (mswindows_message_outputted && !noninteractive)
Fmswindows_message_box (build_string ("Messages outputted. XEmacs is exiting."),
Qnil, Qnil);
#endif
#if defined(GNU_MALLOC)
__free_hook =
-#ifdef __GNUC__ /* prototype of __free_hook varies with glibc version */
+#if defined __GNUC__ || defined __INTEL_COMPILER
+/* prototype of __free_hook varies with glibc version */
(__typeof__ (__free_hook))
#endif
voodoo_free_hook;
("Your files have been auto-saved.\n"
"Use `M-x recover-session' to recover them.\n"
"\n"
- "If you have access to the PROBLEMS file that came with your\n"
- "version of XEmacs, please check to see if your crash is described\n"
- "there, as there may be a workaround available.\n"
+ "Your version of XEmacs was distributed with a PROBLEMS file that may describe\n"
+ "your crash, and with luck a workaround. Please check it first, but do report\n"
+ "the crash anyway. "
#ifdef INFODOCK
- "Otherwise, please report this bug by selecting `Report-Bug'\n"
- "in the InfoDock menu.\n"
+ "\n\nPlease report this bug by selecting `Report-Bug' in the InfoDock menu.\n"
+ "*BE SURE* to include the XEmacs configuration from M-x describe-installation,\n"
+ "or the file Installation in the top directory of the build tree.\n"
#else
- "Otherwise, please report this bug by running the send-pr\n"
- "script included with XEmacs, or selecting `Send Bug Report'\n"
- "from the help menu.\n"
- "As a last resort send ordinary email to `crashes@xemacs.org'.\n"
+ "Please report this bug by invoking M-x report-emacs-bug,\n"
+ "or by selecting `Send Bug Report' from the Help menu. If necessary, send\n"
+ "ordinary email to `xemacs-beta@xemacs.org'. *MAKE SURE* to include the XEmacs\n"
+ "configuration from M-x describe-installation, or equivalently the file\n"
+ "Installation in the top of the build tree.\n"
#endif
- "*MAKE SURE* to include the information in the command\n"
- "M-x describe-installation.\n"
#ifndef _MSC_VER
"\n"
- "If at all possible, *please* try to obtain a C stack backtrace;\n"
- "it will help us immensely in determining what went wrong.\n"
- "To do this, locate the core file that was produced as a result\n"
- "of this crash (it's usually called `core' and is located in the\n"
- "directory in which you started the editor, or maybe in your home\n"
- "directory), and type\n"
+ "*Please* try *hard* to obtain a C stack backtrace; without it, we are unlikely\n"
+ "to be able to analyze the problem. Locate the core file produced as a result\n"
+ "of this crash (often called `core' or `core.<process-id>', and located in\n"
+ "the directory in which you started XEmacs or your home directory), and type\n"
"\n"
" gdb "
#endif
stderr_out ("%s%s", dir, name);
}
stderr_out
- (" core\n\n"
- "then type `where' when the debugger prompt comes up.\n"
- "(If you don't have GDB on your system, you might have DBX,\n"
- "or XDB, or SDB. A similar procedure should work for all of\n"
- "these. Ask your system administrator if you need more help.)\n");
+ (" core\n"
+ "\n"
+ "then type `where' at the debugger prompt. No GDB on your system? You may\n"
+ "have DBX, or XDB, or SDB. (Ask your system administrator if you need help.)\n"
+ "If no core file was produced, enable them (often with `ulimit -c unlimited'\n"
+ "in case of future recurrance of the crash.\n");
#endif /* _MSC_VER */
}
/* Ben thinks this function should not exist or be exported to Lisp.
We use it to define split-path-string in subr.el (not!). */
-DEFUN ("split-string-by-char", Fsplit_string_by_char, 1, 2, 0, /*
+DEFUN ("split-string-by-char", Fsplit_string_by_char, 2, 2, 0, /*
Split STRING into a list of substrings originally separated by SEPCHAR.
*/
(string, sepchar))
in one session without having to recompile. */
/* #define ASSERTIONS_DONT_ABORT */
-#ifdef USE_ASSERTIONS
/* This highly dubious kludge ... shut up Jamie, I'm tired of your slagging. */
static int in_assert_failed;
#undef fprintf
#endif
-#undef abort /* avoid infinite #define loop... */
-
#if defined (WIN32_NATIVE) && defined (DEBUG_XEMACS)
#define enter_debugger() DebugBreak ()
#else
/* We are extremely paranoid so we sensibly deal with recursive
assertion failures. */
in_assert_failed++;
+ inhibit_non_essential_printing_operations = 1;
if (in_assert_failed >= 4)
_exit (-1);
enter_debugger ();
#if !defined (ASSERTIONS_DONT_ABORT)
- abort ();
+ abort (); /* The real abort(), this time */
#endif
+ inhibit_non_essential_printing_operations = 0;
in_assert_failed = 0;
}
-#endif /* USE_ASSERTIONS */
#ifdef QUANTIFY
DEFUN ("quantify-start-recording-data", Fquantify_start_recording_data,
DEFSUBR (Fkill_emacs);
DEFSUBR (Fnoninteractive);
+#ifdef DEBUG_XEMACS
+ DEFSUBR (Fforce_debugging_signal);
+#endif
+
#ifdef QUANTIFY
DEFSUBR (Fquantify_start_recording_data);
DEFSUBR (Fquantify_stop_recording_data);
#ifndef XEMACS_CODENAME
#define XEMACS_CODENAME "Noname"
#endif
+#ifdef MULE
+ {
+ char dest[129];
+ char src[64] = XEMACS_CODENAME;
+ unsigned char* sp = (unsigned char*)src;
+ int i = 0, chr;
+
+ while ( (chr = *sp++) && (i < 128) )
+ {
+ if (chr <= 0x7F)
+ dest[i++] = chr;
+ else
+ {
+#ifdef UTF2000
+ dest[i++] = (chr >> 6) | 0xC0;
+ dest[i++] = (chr & 0x3F) | 0x80;
+#else
+ dest[i++] = LEADING_BYTE_LATIN_ISO8859_1;
+ dest[i++] = chr;
+#endif
+ }
+ }
+ dest[i] = 0;
+ Vxemacs_codename = build_string (dest);
+ }
+#else
Vxemacs_codename = build_string (XEMACS_CODENAME);
+#endif
/* Lisp variables which contain command line flags.
Vconfigure_mule_lisp_directory = Qnil;
#endif
+ DEFVAR_LISP ("utf-2000-lisp-directory", &Vutf_2000_lisp_directory /*
+*Directory of UTF-2000 Lisp files that come with XEmacs.
+*/ );
+ Vutf_2000_lisp_directory = Qnil;
+
+ DEFVAR_LISP ("configure-utf-2000-lisp-directory",
+ &Vconfigure_utf_2000_lisp_directory /*
+For internal use by the build procedure only.
+configure's idea of what `utf-2000-lisp-directory' will be.
+*/ );
+#ifdef PATH_UTF2000LOADSEARCH
+ Vconfigure_utf_2000_lisp_directory = Ffile_name_as_directory
+ (build_string ((char *) PATH_UTF2000LOADSEARCH));
+#else
+ Vconfigure_utf_2000_lisp_directory = Qnil;
+#endif
+
DEFVAR_LISP ("module-directory", &Vmodule_directory /*
*Directory of core dynamic modules that come with XEmacs.
*/ );
projects / chise / xemacs-chise.git.1 / blobdiff