#include <stdio.h>
#include <string.h>
+#include <ctype.h>
#ifndef LISP_FEATURE_WIN32
#include <libgen.h>
#endif
#include <sys/file.h>
#include <sys/param.h>
#include <sys/stat.h>
-#include <signal.h>
+#include "runtime.h"
#ifndef LISP_FEATURE_WIN32
#include <sched.h>
#endif
#include <errno.h>
#include <locale.h>
+#include <limits.h>
#if defined(SVR4) || defined(__linux__)
#include <time.h>
#endif
+#if !(defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD))
#include "signal.h"
+#endif
#include "runtime.h"
-#include "alloc.h"
#include "vars.h"
#include "globals.h"
#include "os.h"
+#include "interr.h"
+#include "alloc.h"
#include "interrupt.h"
#include "arch.h"
#include "gc.h"
-#include "interr.h"
#include "validate.h"
#include "core.h"
#include "save.h"
#endif
#ifndef SBCL_HOME
-#define SBCL_HOME "/usr/local/lib/sbcl/"
+#define SBCL_HOME SBCL_PREFIX"/lib/sbcl/"
#endif
#ifdef LISP_FEATURE_HPUX
\f
/* SIGINT handler that invokes the monitor (for when Lisp isn't up to it) */
static void
-sigint_handler(int signal, siginfo_t *info, void *void_context)
+sigint_handler(int signal, siginfo_t *info, os_context_t *context)
{
lose("\nSIGINT hit at 0x%08lX\n",
- (unsigned long) *os_context_pc_addr(void_context));
+ (unsigned long) *os_context_pc_addr(context));
}
/* (This is not static, because we want to be able to call it from
sigint_init(void)
{
SHOW("entering sigint_init()");
- install_handler(SIGINT, sigint_handler);
+ install_handler(SIGINT, sigint_handler, 1);
SHOW("leaving sigint_init()");
}
\f
return copied_string(filename);
}
}
+
+#ifndef LISP_FEATURE_WIN32
+char *
+copied_realpath(const char *pathname)
+{
+ char *messy, *tidy;
+ size_t len;
+
+ /* realpath() supposedly can't be counted on to always return
+ * an absolute path, so we prepend the cwd to relative paths */
+ messy = NULL;
+ if (pathname[0] != '/') {
+ messy = successful_malloc(PATH_MAX + 1);
+ if (getcwd(messy, PATH_MAX + 1) == NULL) {
+ free(messy);
+ return NULL;
+ }
+ len = strlen(messy);
+ snprintf(messy + len, PATH_MAX + 1 - len, "/%s", pathname);
+ }
+
+ tidy = successful_malloc(PATH_MAX + 1);
+ if (realpath((messy ? messy : pathname), tidy) == NULL) {
+ free(messy);
+ free(tidy);
+ return NULL;
+ }
+
+ return tidy;
+}
+#endif /* LISP_FEATURE_WIN32 */
\f
/* miscellaneous chattiness */
--userinit <filename> Per-user init-file to use instead of default.\n\
--no-sysinit Inhibit processing of any system-wide init-file.\n\
--no-userinit Inhibit processing of any per-user init-file.\n\
+ --disable-debugger Invoke sb-ext:disable-debugger.\n\
+ --noprint Run a Read-Eval Loop without printing results.\n\
+ --script [<filename>] Skip #! line, disable debugger, avoid verbosity.\n\
+ --quit Exit with code 0 after option processing.\n\
+ --non-interactive Sets both --quit and --disable-debugger.\n\
+Common toplevel options that are processed in order:\n\
+ --eval <form> Form to eval when processing this option.\n\
+ --load <filename> File to load when processing this option.\n\
\n\
User options are not processed by SBCL. All runtime options must\n\
appear before toplevel options, and all toplevel options must\n\
It is mostly in the public domain; some portions are provided under\n\
BSD-style licenses. See the CREDITS and COPYING files in the\n\
distribution for more information.\n\
-", SBCL_VERSION_STRING);
+"
+#ifdef LISP_FEATURE_WIN32
+"\n\
+WARNING: the Windows port is fragile, particularly for multithreaded\n\
+code. Unfortunately, the development team currently lacks the time\n\
+and resources this platform demands.\n\
+"
+#endif
+, SBCL_VERSION_STRING);
}
/* Look for a core file to load, first in the directory named by the
return core;
}
+/* Try to find the path to an executable from argv[0], this is only
+ * used when os_get_runtime_executable_path() returns NULL */
+#ifdef LISP_FEATURE_WIN32
+char *
+search_for_executable(const char *argv0)
+{
+ return NULL;
+}
+#else /* LISP_FEATURE_WIN32 */
+char *
+search_for_executable(const char *argv0)
+{
+ char *search, *start, *end, *buf;
+
+ /* If argv[0] contains a slash then it's probably an absolute path
+ * or relative to the current directory, so check if it exists. */
+ if (strchr(argv0, '/') != NULL && access(argv0, F_OK) == 0)
+ return copied_realpath(argv0);
+
+ /* Bail on an absolute path which doesn't exist */
+ if (argv0[0] == '/')
+ return NULL;
+
+ /* Otherwise check if argv[0] exists relative to any directory in PATH */
+ search = getenv("PATH");
+ if (search == NULL)
+ return NULL;
+ search = copied_string(search);
+ buf = successful_malloc(PATH_MAX + 1);
+ for (start = search; (end = strchr(start, ':')) != NULL; start = end + 1) {
+ *end = '\0';
+ snprintf(buf, PATH_MAX + 1, "%s/%s", start, argv0);
+ if (access(buf, F_OK) == 0) {
+ free(search);
+ search = copied_realpath(buf);
+ free(buf);
+ return search;
+ }
+ }
+ /* The above for-loop fails to process the last part of PATH if PATH does
+ * not end with ':'. We may consider appending an extra ':' to the end of
+ * SEARCH. -- houjingyi 2013-05-24 */
+ if (start != NULL && *start != '\0') {
+ snprintf(buf, PATH_MAX + 1, "%s/%s", start, argv0);
+ if (access(buf, F_OK) == 0) {
+ free(search);
+ search = copied_realpath(buf);
+ free(buf);
+ return search;
+ }
+ }
+
+ free(search);
+ free(buf);
+ return NULL;
+}
+#endif /* LISP_FEATURE_WIN32 */
+
+size_t
+parse_size_arg(char *arg, char *arg_name)
+{
+ char *tail, *power_name;
+ size_t power, res;
+
+ res = strtoul(arg, &tail, 0);
+
+ if (arg == tail) {
+ lose("%s argument is not a number: %s", arg_name, arg);
+ } else if (tail[0]) {
+ int i, size;
+ power_name = copied_string(tail);
+ size = strlen(power_name);
+ for (i=0; i<size; i++)
+ power_name[i] = toupper(power_name[i]);
+ } else {
+ power = 20;
+ power_name = NULL;
+ }
+ if (power_name) {
+ if ((0==strcmp("KB", power_name)) ||
+ (0==strcmp("KIB", power_name))) {
+ power = 10;
+ } else if ((0==strcmp("MB", power_name)) ||
+ (0==strcmp("MIB", power_name))) {
+ power = 20;
+ } else if ((0==strcmp("GB", power_name)) ||
+ (0==strcmp("GIB", power_name))) {
+ power = 30;
+ } else {
+ lose("%s argument has an unknown suffix: %s", arg_name, tail);
+ }
+ free(power_name);
+ }
+ if ((res <= 0) ||
+ (res >= (SIZE_MAX >> power))) {
+ lose("%s argument is out of range: %s", arg_name, arg);
+ }
+ res <<= power;
+ return res;
+}
+
char **posix_argv;
char *core_string;
struct runtime_options *runtime_options;
+char *saved_runtime_path = NULL;
+#if defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD)
+void pthreads_win32_init();
+#endif
+
+void print_locale_variable(const char *name)
+{
+ char *value = getenv(name);
+
+ if (value) {
+ fprintf(stderr, "\n %s=%s", name, value);
+ }
+}
+
+void setup_locale()
+{
+ if(setlocale(LC_ALL, "") == NULL) {
+#ifndef LISP_FEATURE_WIN32
+
+ fprintf(stderr, "WARNING: Setting locale failed.\n");
+ fprintf(stderr, " Check the following variables for correct values:");
+
+ if (setlocale(LC_CTYPE, "") == NULL) {
+ print_locale_variable("LC_ALL");
+ print_locale_variable("LC_CTYPE");
+ print_locale_variable("LANG");
+ }
+
+ if (setlocale(LC_MESSAGES, "") == NULL) {
+ print_locale_variable("LC_MESSAGES");
+ }
+ if (setlocale(LC_COLLATE, "") == NULL) {
+ print_locale_variable("LC_COLLATE");
+ }
+ if (setlocale(LC_MONETARY, "") == NULL) {
+ print_locale_variable("LC_MONETARY");
+ }
+ if (setlocale(LC_NUMERIC, "") == NULL) {
+ print_locale_variable("LC_NUMERIC");
+ }
+ if (setlocale(LC_TIME, "") == NULL) {
+ print_locale_variable("LC_TIME");
+ }
+ fprintf(stderr, "\n");
+
+#endif
+ }
+}
+
\f
int
main(int argc, char *argv[], char *envp[])
/* other command line options */
boolean noinform = 0;
boolean end_runtime_options = 0;
+ boolean disable_lossage_handler_p = 0;
lispobj initial_function;
const char *sbcl_home = getenv("SBCL_HOME");
- interrupt_init();
- block_blockable_signals();
+#if defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD)
+ os_preinit();
+ pthreads_win32_init();
+#endif
- setlocale(LC_ALL, "");
+ interrupt_init();
+ block_blockable_signals(0, 0);
runtime_options = NULL;
+ /* Save the argv[0] derived runtime path in case
+ * os_get_runtime_executable_path(1) isn't able to get an
+ * externally-usable path later on. */
+ saved_runtime_path = search_for_executable(argv[0]);
+
/* Check early to see if this executable has an embedded core,
* which also populates runtime_options if the core has runtime
* options */
- runtime_path = os_get_runtime_executable_path();
- if (runtime_path) {
- os_vm_offset_t offset = search_for_embedded_core(runtime_path);
+ runtime_path = os_get_runtime_executable_path(0);
+ if (runtime_path || saved_runtime_path) {
+ os_vm_offset_t offset = search_for_embedded_core(
+ runtime_path ? runtime_path : saved_runtime_path);
if (offset != -1) {
embedded_core_offset = offset;
- core = runtime_path;
+ core = (runtime_path ? runtime_path :
+ copied_string(saved_runtime_path));
} else {
- free(runtime_path);
+ if (runtime_path)
+ free(runtime_path);
}
}
* TOPLEVEL-INIT sees the option. */
noinform = 1;
end_runtime_options = 1;
+ disable_lossage_handler_p = 1;
+ lose_on_corruption_p = 1;
break;
} else if (0 == strcmp(arg, "--noinform")) {
noinform = 1;
++argi;
if (argi >= argc)
lose("missing argument for --dynamic-space-size");
- errno = 0;
- dynamic_space_size = strtol(argv[argi++], 0, 0) << 20;
- if (errno)
- lose("argument to --dynamic-space-size is not a number");
+ dynamic_space_size = parse_size_arg(argv[argi++],
+ "--dynamic-space-size");
# ifdef MAX_DYNAMIC_SPACE_END
- if (!((DYNAMIC_SPACE_START < DYNAMIC_SPACE_START+dynamic_space_size) &&
- (DYNAMIC_SPACE_START+dynamic_space_size <= MAX_DYNAMIC_SPACE_END)))
- lose("specified --dynamic-space-size too large");
+ if (!((DYNAMIC_SPACE_START <
+ DYNAMIC_SPACE_START+dynamic_space_size) &&
+ (DYNAMIC_SPACE_START+dynamic_space_size <=
+ MAX_DYNAMIC_SPACE_END))) {
+ char* suffix = "";
+ char* size = argv[argi-1];
+ if (!strchr(size, 'B') && !strchr(size, 'b')) {
+ suffix = " [MB]";
+ }
+ lose("--dynamic-space-size argument %s%s is too large, max %lu KB",
+ size, suffix,
+ (MAX_DYNAMIC_SPACE_END-DYNAMIC_SPACE_START) / 1024);
+ }
# endif
} else if (0 == strcmp(arg, "--control-stack-size")) {
++argi;
if (argi >= argc)
lose("missing argument for --control-stack-size");
errno = 0;
- thread_control_stack_size = strtol(argv[argi++], 0, 0) << 20;
- if (errno)
- lose("argument to --control-stack-size is not a number");
+ thread_control_stack_size = parse_size_arg(argv[argi++], "--control-stack-size");
} else if (0 == strcmp(arg, "--debug-environment")) {
int n = 0;
printf("; Commandline arguments:\n");
++n;
}
++argi;
+ } else if (0 == strcmp(arg, "--disable-ldb")) {
+ disable_lossage_handler_p = 1;
+ ++argi;
+ } else if (0 == strcmp(arg, "--lose-on-corruption")) {
+ lose_on_corruption_p = 1;
+ ++argi;
} else if (0 == strcmp(arg, "--end-runtime-options")) {
end_runtime_options = 1;
++argi;
break;
+ } else if (0 == strcmp(arg, "--merge-core-pages")) {
+ ++argi;
+ merge_core_pages = 1;
+ } else if (0 == strcmp(arg, "--no-merge-core-pages")) {
+ ++argi;
+ merge_core_pages = 0;
+ } else if (0 == strcmp(arg, "--default-merge-core-pages")) {
+ ++argi;
+ merge_core_pages = -1;
} else {
/* This option was unrecognized as a runtime option,
* so it must be a toplevel option or a user option,
/* Align down to multiple of page_table page size, and to the appropriate
* stack alignment. */
- dynamic_space_size &= ~(PAGE_BYTES-1);
- thread_control_stack_size &= ~(CONTROL_STACK_ALIGNMENT_BYTES-1);
+ dynamic_space_size &= ~(sword_t)(PAGE_BYTES-1);
+#ifdef LISP_FEATURE_GENCGC
+ dynamic_space_size &= ~(sword_t)(GENCGC_CARD_BYTES-1);
+#endif
+ thread_control_stack_size &= ~(sword_t)(CONTROL_STACK_ALIGNMENT_BYTES-1);
/* Preserve the runtime options for possible future core saving */
runtime_options->dynamic_space_size = dynamic_space_size;
* systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
* it must follow os_init(). -- WHN 2000-01-26 */
os_init(argv, envp);
+ dyndebug_init(); /* after os_init: do not print output before execve */
arch_init();
gc_init();
validate();
+ setup_locale();
+
/* If no core file was specified, look for one. */
if (!core) {
core = search_for_core();
fflush(stdout);
}
-#if defined(SVR4) || defined(__linux__)
+ if (embedded_core_offset == 0) {
+ /* Here we make a last attempt at recognizing an embedded core,
+ * so that a file with an embedded core is a valid argument to
+ * --core. We take care that any decisions on special behaviour
+ * (suppressed banner, embedded options) have already been made
+ * before we reach this block, so that there is no observable
+ * difference between "embedded" and "bare" images given to
+ * --core. */
+ os_vm_offset_t offset = search_for_embedded_core(core);
+ if (offset != -1)
+ embedded_core_offset = offset;
+ }
+
+#if defined(SVR4) || defined(__linux__) || defined(__NetBSD__)
tzset();
#endif
define_var("nil", NIL, 1);
define_var("t", T, 1);
- enable_lossage_handler();
+ if (!disable_lossage_handler_p)
+ enable_lossage_handler();
globals_init();
if (initial_function == NIL) {
lose("couldn't find initial function\n");
}
+#ifdef LISP_FEATURE_SB_DYNAMIC_CORE
+ os_link_runtime();
+#endif
#ifdef LISP_FEATURE_HPUX
- /* -1 = CLOSURE_FUN_OFFSET, 23 = SIMPLE_FUN_CODE_OFFSET, we are not in LANGUAGE_ASSEMBLY
- so we cant reach them. */
+ /* -1 = CLOSURE_FUN_OFFSET, 23 = SIMPLE_FUN_CODE_OFFSET, we are
+ * not in LANGUAGE_ASSEMBLY so we cant reach them. */
return_from_lisp_stub = (void *) ((char *)*((unsigned long *)
((char *)initial_function + -1)) + 23);
#endif
FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
(unsigned long)initial_function));
-#ifdef LISP_FEATURE_WIN32
- fprintf(stderr, "\n\
-This is experimental prerelease support for the Windows platform: use\n\
-at your own risk. \"Your Kitten of Death awaits!\"\n");
- fflush(stdout);
- fflush(stderr);
-#endif
create_initial_thread(initial_function);
- lose("CATS. CATS ARE NICE.\n");
+ lose("unexpected return from initial thread in main()\n");
return 0;
}
projects / sbcl.git / blobdiff