Free Software Foundation, Inc.
Copyright (C) 1995 Sun Microsystems, Inc.
Copyright (C) 2000, 2002 Ben Wing.
- Copyright (C) 2004 Steve Youngs.
+ Copyright (C) 2004, 2015 Steve Youngs.
This file is part of SXEmacs
#include "sysdep.h"
#include "syssignal.h" /* Always include before systty.h */
-#include "ui/systty.h"
+#include "ui/TTY/systty.h"
#include "sysfile.h"
#include "systime.h"
# endif
#endif /* HAVE_BDWGC */
-#if defined (HEAP_IN_DATA) && !defined(PDUMP)
-void report_sheap_usage(int die_if_pure_storage_exceeded);
-#endif
-
#if !defined (SYSTEM_MALLOC) && !defined (DOUG_LEA_MALLOC)
extern void *(*__malloc_hook) (size_t);
extern void *(*__realloc_hook) (void *, size_t);
Lisp_Object Vconfigure_info_path;
Lisp_Object Vinternal_error_checking;
Lisp_Object Vmail_lock_methods, Vconfigure_mail_lock_method;
-Lisp_Object Vpath_separator;
+Lisp_Object Vpath_separator, Vuser_packages_topdir;
/* The default base directory SXEmacs is installed under. */
Lisp_Object Vconfigure_exec_prefix_directory, Vconfigure_prefix_directory;
variable. */
const char *display_use;
+/* Directory specified on the command line for user packages
+ (early-packages). We cannot use a Lisp symbol here because Lisp
+ symbols may not be initialised at the time that we set this. */
+const char *user_pkgd;
+int upkgd = 0;
+
/* If non-zero, then the early error handler will only print the error
message and exit. */
int suppress_early_error_handler_backtrace;
However, unexpected exits occur in a few different ways:
-- a memory access violation or other hardware-generated exception
- occurs. This is the worst possible problem to deal with, because
- the fault can occur while SXEmacs is in any state whatsoever, even
- quite unstable ones. As a result, we need to be *extremely* careful
- what we do.
+ occurs. This is the worst possible problem to deal with, because
+ the fault can occur while SXEmacs is in any state whatsoever, even
+ quite unstable ones. As a result, we need to be *extremely* careful
+ what we do.
-- we are using one X display (or if we've used more, we've closed the
- others already), and some hardware or other problem happens and
- suddenly we've lost our connection to the display. In this situation,
+ others already), and some hardware or other problem happens and
+ suddenly we've lost our connection to the display. In this situation,
things are not so dire as in the last one; our code itself isn't
trashed, so we can continue execution as normal, after having set
things up so that we can exit at the appropriate time. Our exit
old_sigsegv =
(SIGTYPE(*)(int))signal(SIGSEGV, debug_memory_error);
#endif
- /*
- * Examine memory pool at PTR, trying to cheat
- * compiler's optimisations.
- */
- while (len-- > 0) {
- dummy_char = ((char*)ptr)[len];
+ /*
+ * Examine memory pool at PTR, trying to cheat
+ * compiler's optimisations.
+ */
+ while (len-- > 0) {
+ dummy_char = ((char*)ptr)[len];
}
} else {
retval = 0;
REGISTER int i;
for (i = argc - 1; i >= 0; i--) {
- if (i != 0 && i <= skip_args)
- continue;
+ if (i != 0 && i <= skip_args)
+ continue;
- result = Fcons(build_ext_string(argv[i], Qcommand_argument_encoding), result);
+ result = Fcons(build_ext_string(argv[i], Qcommand_argument_encoding), result);
}
return result;
}
/* set up the program call */
xstrncpy(mdocfile,
(char*)XSTRING_DATA(Vexec_directory),
- XSTRING_LENGTH(Vexec_directory));
- xstrncpy(mdocfile+XSTRING_LENGTH(Vexec_directory),
- make_docfile_prog, countof(make_docfile_prog));
+ sizeof(mdocfile));
+ xstrncpy(mdocfile+edlen,
+ make_docfile_prog, sizeof(mdocfile)-edlen);
/* find the --make-docfile option */
for (p = v; *p; p++) {
{
/* return the stack size limit */
#if defined HAVE_GETRLIMIT64
- struct rlimit64 foo;
- (void)getrlimit64(RLIMIT_STACK, &foo);
+ struct rlimit64 rlim;
+ (void)getrlimit64(RLIMIT_STACK, &rlim);
#elif defined HAVE_GETRLIMIT
- struct rlimit foo;
- (void)getrlimit(RLIMIT_STACK, &foo);
+ struct rlimit rlim;
+ (void)getrlimit(RLIMIT_STACK, &rlim);
#else
/* bollocks, maybe just a small one? 64k? */
- struct {size_t rlim_cur;} foo = {65536};
+ struct {size_t rlim_cur;} rlim = {65536};
#endif
- return foo.rlim_cur;
+ return rlim.rlim_cur;
}
/* Handle the -sd/--show-dump-id switch, which means show the hex
dump_id and quit */
- if (argmatch(argv, argc,
- "-sd", "--show-dump-id",
- 9, NULL, &skip_args)) {
+ if (argmatch(argv, argc, "-show-dump-id", "--show-dump-id", 9,
+ NULL, &skip_args)
+ || argmatch(argv, argc, "-sd", 0, 3, NULL, &skip_args)) {
#ifdef PDUMP
printf("%08x\n", dump_id);
#else
{
char *term;
if (argmatch
- (argv, argc, "-t", "--terminal", 4, &term, &skip_args)) {
+ (argv, argc, "-terminal", "--terminal", 4, &term, &skip_args)
+ || argmatch(argv, argc, "-t", 0, 2, &term, &skip_args)) {
+ int tdesc = -1;
+#ifdef HAVE_TTYNAME
+ stderr_out("Opening for terminal usage %s (current: %s)\n", term, ttyname(0));
+#else
+ stderr_out("Opening for terminal usage %s\n", term, ttyname(0));
+#endif
+#ifdef HAVE_DUP2
+ tdesc = raw_open(term, O_RDWR | OPEN_BINARY, 2);
+ if (tdesc < 0)
+ fatal("%s: %s", term, strerror(errno));
+ /* Request dup into fd 0 */
+ if ( dup2(tdesc,0) < 0 )
+ fatal("%s: %s", term, strerror(errno));
+ stderr_out("Dup(0) ok\n");
+ /* Requesr dup into fd 1 */
+ if ( dup2(tdesc,1) < 0 )
+ fatal("%s: %s", term, strerror(errno));
+ close(tdesc);
+#else
close(0);
close(1);
- if (open(term, O_RDWR | OPEN_BINARY, 2) < 0)
+ tdesc = raw_open(term, O_RDWR | OPEN_BINARY, 2);
+ if (tdesc < 0)
fatal("%s: %s", term, strerror(errno));
- if( dup(0) < 0)
+ assert(tdesc==0);
+ tdesc = dup(0);
+ if ( tdesc < 0) {
fatal("dup failed %s: %s", term, strerror(errno));
- if (!isatty(0))
+ }
+ assert(tdesc==1);
+#endif
+#ifdef HAVE_ISATTY
+ if (!isatty(0)) {
fatal("%s: not a tty", term);
-
-#if 0
- stderr_out("Using %s", ttyname(0));
+ }
#endif
- stderr_out("Using %s", term);
- inhibit_window_system = 1; /* -t => -nw */
+#ifdef HAVE_TTYNAME
+ stderr_out("Using tty %s\n", ttyname(0));
+#else
+ stderr_out("Using %tty s\n", term);
+#endif
+ inhibit_window_system = 1; /* -t => -nw
+ * */
}
}
/* Handle the --no-dump-file/-nd switch, which means don't
* load the dump file (ignored when not using pdump) */
- if (argmatch(argv, argc, "-nd", "--no-dump-file", 7,
- NULL, &skip_args)) {
+ if (argmatch(argv, argc, "-no-dump-file", "--no-dump-file", 7,
+ NULL, &skip_args)
+ || argmatch(argv, argc, "-nd", 0, 3, NULL, &skip_args)) {
nodumpfile = 1;
}
- if (argmatch(argv, argc, "-ct", "--color-terminal", 5,
- NULL, &skip_args)) {
+ if (argmatch(argv, argc, "-color-terminal", "--color-terminal", 5,
+ NULL, &skip_args)
+ || argmatch(argv, argc, "-ct", 0, 3, NULL, &skip_args)) {
assume_colorterm = 1;
}
/* Handle -nw switch */
- if (argmatch(argv, argc, "-nw", "--no-windows", 6, NULL, &skip_args))
+ if (argmatch(argv, argc, "-no-windows", "--no-windows", 6, NULL,
+ &skip_args)
+ || argmatch(argv, argc, "-nw", 0, 3, NULL, &skip_args)) {
inhibit_window_system = 1;
+ }
/* Handle the -batch switch, which means don't do interactive display */
if (argmatch(argv, argc, "-batch", "--batch", 5, NULL, &skip_args)) {
11, NULL, &skip_args))
debug_paths = 1;
+ /* Handle -user-pkgs-directory */
+ char *pkgd;
+ if (argmatch(argv, argc, "-user-pkgs-directory", "--user-pkgs-directory",
+ 11, &pkgd, &skip_args)) {
+ user_pkgd = pkgd;
+ upkgd = 1;
+ }
+
/* Partially handle -no-autoloads, -no-early-packages and -vanilla.
Packages */
/* are searched prior to the rest of the command line being parsed in */
/* Partially handle the -version and -help switches: they imply -batch,
but are not removed from the list. */
- if (argmatch(argv, argc, "-help", "--help", 3, NULL, &skip_args))
+ if (argmatch(argv, argc, "-help", "--help", 3, NULL, &skip_args)
+ || argmatch(argv, argc, "-h", 0, 2, NULL, &skip_args))
noninteractive = 1, skip_args--;
if (argmatch(argv, argc, "-version", "--version", 3, NULL, &skip_args)
display_use = "tty";
#ifndef HAVE_TTY
- if (inhibit_window_system)
+ if (inhibit_window_system && !noninteractive)
fatal("Sorry, this SXEmacs was not compiled with TTY support");
#endif
#endif
#ifdef HAVE_LIBFFI
- vars_of_ffi();
+ vars_of_ffi();
#endif
vars_of_dllist();
reinit_complex_vars_of_minibuf();
#ifdef HAVE_LIBFFI
- reinit_vars_of_ffi();
+ reinit_vars_of_ffi();
#endif
#if defined USE_STATIC_ASE && USE_STATIC_ASE
of this stuff involves querying the current environment and needs
to be done both at dump time and at run time. */
+ /* user-packages-topdir (early-packages) */
+ if (upkgd == 0) {
+ Vuser_packages_topdir = Qnil;
+ } else {
+ Vuser_packages_topdir = Ffile_name_as_directory
+ (build_string(user_pkgd));
+ }
+
init_initial_directory(); /* get the directory to use for the
"*scratch*" buffer, etc. */
if (NILP(Vinvocation_directory))
Vinvocation_directory = Vinvocation_name;
+ /* kick double /s as we want a standard posix name */
+ for (unsigned char *p = XSTRING_DATA(Vinvocation_name),
+ *q = p; ((*q = *p));) {
+ if (*q++ == '/') {
+ while (*++p == '/');
+ } else {
+ p++;
+ }
+ }
+
Vinvocation_name =
Ffile_name_nondirectory(Vinvocation_directory);
Vinvocation_directory =
{"-no-autoloads", "--no-autoloads", 50, 0},
{"-no-site-file", "--no-site-file", 40, 0},
{"-no-early-packages", "--no-early-packages", 35, 0},
+ /* -user-pkgs-directory is actually handled in main_1() and
+ not in startup.el. It is listed here because of the
+ priority given to this arg. */
+ {"-user-pkgs-directory", "--user-pkgs-directory", 30, 1},
{"-u", "--user", 30, 1},
{"-user", 0, 30, 1},
{"-debug-init", "--debug-init", 20, 0},
(int nargs, Lisp_Object * args))
{
int ac;
- const Extbyte *wampum;
+ const Extbyte *wampum = NULL;
int namesize;
int total_len;
Lisp_Object orig_invoc_name = Fcar(Vcommand_line_args);
TO_EXTERNAL_FORMAT(LISP_STRING, orig_invoc_name,
ALLOCA, (wampum, namesize), Qnative);
+ if ( wampum == NULL )
+ error("Could not transcode invocation name");
+
namesize++;
for (ac = 0, total_len = namesize; ac < nargs; ac++) {
CHECK_STRING(args[ac]);
+ wampum_all[ac]=NULL;
TO_EXTERNAL_FORMAT(LISP_STRING, args[ac],
ALLOCA, (wampum_all[ac], wampum_all_len[ac]),
Qnative);
+ if(wampum_all[ac]==NULL) {
+ error("Could not transcode arguments");
+ }
wampum_all_len[ac]++;
total_len += wampum_all_len[ac];
}
unbind_to(0, Qnil); /* this closes loadup.el */
purify_flag = 0;
run_temacs_argc = nargs + 1;
-#if defined (HEAP_IN_DATA) && !defined(PDUMP)
- report_sheap_usage(0);
-#endif
LONGJMP(run_temacs_catch, 1);
return Qnil; /* not reached; warning suppression */
}
int
main(int argc, char **argv, char **envp)
{
- int volatile vol_argc = argc;
- char **volatile vol_argv = argv;
- char **volatile vol_envp = envp;
- /* This is hairy. We need to compute where the SXEmacs binary was invoked
- from because temacs initialization requires it to find the lisp
- directories. The code that recomputes the path is guarded by the
- restarted flag. There are three possible paths I've found so far
- through this:
-
- temacs -- When running temacs for basic build stuff, the first main_1
- will be the only one invoked. It must compute the path else there
- will be a very ugly bomb in startup.el (can't find obvious location
- for doc-directory data-directory, etc.).
-
- temacs w/ run-temacs on the command line -- This is run to bytecompile
- all the out of date dumped lisp. It will execute both of the main_1
- calls and the second one must not touch the first computation because
- argc/argv are hosed the second time through.
-
- sxemacs -- Only the second main_1 is executed. The invocation path must
- computed but this only matters when running in place or when running
- as a login shell.
-
- As a bonus for straightening this out, SXEmacs can now be run in place
- as a login shell. This never used to work.
-
- As another bonus, we can now guarantee that
- (concat invocation-directory invocation-name) contains the filename
- of the SXEmacs binary we are running. This can now be used in a
- definite test for out of date dumped files. -slb */
- int restarted = 0;
+ int volatile vol_argc = argc;
+ char **volatile vol_argv = argv;
+ char **volatile vol_envp = envp;
+ /* This is hairy. We need to compute where the SXEmacs binary
+ was invoked from because temacs initialization requires it
+ to find the lisp directories. The code that recomputes the
+ path is guarded by the restarted flag. There are three
+ possible paths I've found so far through this:
+
+ temacs -- When running temacs for basic build stuff, the
+ first main_1 will be the only one invoked. It must compute
+ the path else there will be a very ugly bomb in startup.el
+ (can't find obvious location for doc-directory
+ data-directory, etc.).
+
+ temacs w/ run-temacs on the command line -- This is run to
+ bytecompile all the out of date dumped lisp. It will
+ execute both of the main_1 calls and the second one must
+ not touch the first computation because argc/argv are hosed
+ the second time through.
+
+ sxemacs -- Only the second main_1 is executed. The
+ invocation path must computed but this only matters when
+ running in place or when running as a login shell.
+
+ As a bonus for straightening this out, SXEmacs can now be
+ run in place as a login shell. This never used to work.
+
+ As another bonus, we can now guarantee that (concat
+ invocation-directory invocation-name) contains the filename
+ of the SXEmacs binary we are running. This can now be used
+ in a definite test for out of date dumped files. -slb
+ */
+
+ int restarted = 0;
+
+ int arg;
+ assert(vol_argv[0] != NULL || vol_argv[0][0] != '\0');
+ assert(argc >= 1);
+ for( arg=1; arg < argc; arg++ ) {
+ assert(vol_argv[arg] != NULL);
+ }
+ assert(vol_argv[argc] == NULL);
+
#ifdef QUANTIFY
- quantify_stop_recording_data();
- quantify_clear_data();
+ quantify_stop_recording_data();
+ 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 */
+ inhibit_non_essential_printing_operations = 1;
+ suppress_early_error_handler_backtrace = 0;
+ lim_data = 0; /* force reinitialization of this variable */
- /* Lisp_Object must fit in a word; check VALBITS and GCTYPEBITS */
- assert(sizeof(Lisp_Object) == sizeof(void *));
+ /* Lisp_Object must fit in a word; check VALBITS and GCTYPEBITS */
+ assert(sizeof(Lisp_Object) == sizeof(void *));
#ifdef LINUX_SBRK_BUG
- sbrk(1);
+ sbrk(1);
#endif
/* defined in alloc.c */
init_bdwgc();
- if (!initialized) {
+ if (!initialized) {
#ifdef DOUG_LEA_MALLOC
- if (mallopt(M_MMAP_MAX, 0) != 1)
- abort();
-#endif
- run_temacs_argc = 0;
- if (!SETJMP(run_temacs_catch)) {
- main_1(vol_argc, vol_argv, vol_envp, 0);
- }
- /* run-emacs-from-temacs called */
- restarted = 1;
- vol_argc = run_temacs_argc;
- vol_argv = run_temacs_argv;
+ if (mallopt(M_MMAP_MAX, 0) != 1)
+ abort();
+#endif
+ run_temacs_argc = 0;
+ if (!SETJMP(run_temacs_catch)) {
+ main_1(vol_argc, vol_argv, vol_envp, 0);
+ }
+ /* run-emacs-from-temacs called */
+ restarted = 1;
+ vol_argc = run_temacs_argc;
+ vol_argv = run_temacs_argv;
#ifdef _SCO_DS
- /* This makes absolutely no sense to anyone involved. There are
- several people using this stuff. We've compared versions on
- everything we can think of. We can find no difference.
- However, on both my systems environ is a plain old global
- variable initialized to zero. _environ is the one that
- contains pointers to the actual environment.
-
- Since we can't figure out the difference (and we're hours
- away from a release), this takes a very cowardly approach and
- is bracketed with both a system specific preprocessor test
- and a runtime "do you have this problem" test
-
- 06/20/96 robertl@dgii.com */
- {
- extern char **_environ;
- if ((unsigned)environ == 0)
- environ = _environ;
- }
+ /* This makes absolutely no sense to anyone involved. There are
+ several people using this stuff. We've compared versions on
+ everything we can think of. We can find no difference.
+ However, on both my systems environ is a plain old global
+ variable initialized to zero. _environ is the one that
+ contains pointers to the actual environment.
+
+ Since we can't figure out the difference (and we're hours
+ away from a release), this takes a very cowardly approach and
+ is bracketed with both a system specific preprocessor test
+ and a runtime "do you have this problem" test
+
+ 06/20/96 robertl@dgii.com */
+ {
+ extern char **_environ;
+ if ((unsigned)environ == 0)
+ environ = _environ;
+ }
#endif /* _SCO_DS */
- vol_envp = environ;
- }
+ vol_envp = environ;
+ }
#if defined (RUN_TIME_REMAP) && ! defined (PDUMP)
- else
- /* obviously no-one uses this because where it was before initialized was
- *always* true */
- run_time_remap(argv[0]);
+ else
+ /* obviously no-one uses this because where it was before initialized was
+ *always* true */
+ run_time_remap(argv[0]);
#endif
#ifdef DOUG_LEA_MALLOC
- if (initialized && (malloc_state_ptr != NULL)) {
- int rc = malloc_set_state(malloc_state_ptr);
- if (rc != 0) {
- stderr_out("malloc_set_state failed, rc = %d\n",
- rc);
- abort();
- }
+ if (initialized && (malloc_state_ptr != NULL)) {
+ int rc = malloc_set_state(malloc_state_ptr);
+ if (rc != 0) {
+ stderr_out("malloc_set_state failed, rc = %d\n",
+ rc);
+ abort();
+ }
#if 0
- free(malloc_state_ptr);
+ free(malloc_state_ptr);
#endif
/* mmap works in glibc-2.1, glibc-2.0 (Non-Mule only)
* and Linux libc5 */
#if (defined(__GLIBC__) && __GLIBC_MINOR__ >= 1) || \
- defined(_NO_MALLOC_WARNING_) || \
- (defined(__GLIBC__) && __GLIBC_MINOR__ < 1 && !defined(MULE)) || \
- defined(DEBUG_DOUG_LEA_MALLOC)
- if (mallopt(M_MMAP_MAX, 0) != 1)
- abort();
+ defined(_NO_MALLOC_WARNING_) || \
+ (defined(__GLIBC__) && __GLIBC_MINOR__ < 1 && !defined(MULE)) || \
+ defined(DEBUG_DOUG_LEA_MALLOC)
+ if (mallopt(M_MMAP_MAX, 0) != 1)
+ abort();
#endif
#ifdef REL_ALLOC
- r_alloc_reinit();
+ r_alloc_reinit();
#endif
- }
+ }
#endif /* DOUG_LEA_MALLOC */
- run_temacs_argc = -1;
+ run_temacs_argc = -1;
- main_1(vol_argc, vol_argv, vol_envp, restarted);
+ main_1(vol_argc, vol_argv, vol_envp, restarted);
return 0; /* unreached */
}
/* various system shared libraries have been built and linked with */
/* GCC >= 2.8. -slb */
#if defined(GNU_MALLOC)
+#if defined(HAVE_MORECORE_HOOK)
static void voodoo_free_hook(void *mem)
{
+ /* If it no longer works, we'll know about it. For now there is really no
+ good alternatic. Shut the warning off
+ */
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
+
/* Disable all calls to free() when SXEmacs is exiting and it doesn't */
/* matter. */
__free_hook =
(__typeof__(__free_hook))
#endif
voodoo_free_hook;
+#pragma GCC diagnostic pop
}
+#endif
#endif /* GNU_MALLOC */
DEFUN("kill-emacs", Fkill_emacs, 0, 1, "P", /*
shut_down_emacs(0, STRINGP(arg) ? arg : Qnil, 0);
#if defined(GNU_MALLOC)
+#if defined(HAVE_MORECORE_HOOK)
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
__free_hook =
#if defined __GNUC__ || defined __INTEL_COMPILER
/* prototype of __free_hook varies with glibc version */
(__typeof__(__free_hook))
#endif
voodoo_free_hook;
+#pragma GCC diagnostic pop
+#endif
#endif
exit(INTP(arg) ? XINT(arg) : 0);
opurify = purify_flag;
purify_flag = 0;
-#if defined (HEAP_IN_DATA) && !defined(PDUMP)
- report_sheap_usage(1);
-#endif
-
clear_message();
fflush(stderr);
garbage_collect_1();
#ifdef PDUMP
+ SXE_SET_UNUSED(symfile_ext);
pdump(filename_ext);
#else
(':' or whatever). */
Lisp_Object decode_path(/*const*/ char *path)
{
- Bytecount newlen;
- Bufbyte *newpath;
+ Bytecount newlen = 0;
+ Bufbyte *newpath = NULL;
if (!path)
return Qnil;
decode_env_path(), but it looks dubious here. Does any code
depend on decode_path("") returning nil instead of an empty
string? */
- if (!newlen)
+ if (!newlen || !newpath)
return Qnil;
return split_string_by_emchar_1(newpath, newlen, SEPCHAR);
#define enter_debugger()
+void debug_backtrace();
+
void
assert_failed(const char *file, int line, const char *expr)
{
inhibit_site_modules = 1;
#endif
+ DEFVAR_LISP("user-packages-topdir", &Vuser_packages_topdir /*
+Top of the user's local package hierarchy.
+This is normally computed at run-time, but may be set via the
+`-user-pkgs-directory' command line argument.
+ */ );
+
DEFVAR_INT("emacs-priority", &emacs_priority /*
Priority for SXEmacs to run at.
This value is effective only if set before SXEmacs is dumped,