* yet.
*/
+#include <malloc.h>
#include <stdio.h>
#include <sys/param.h>
#include <sys/file.h>
+#include <io.h>
#include "sbcl.h"
#include "./signal.h"
#include "os.h"
#include "interrupt.h"
#include "interr.h"
#include "lispregs.h"
-#include "monitor.h"
+#include "runtime.h"
#include "alloc.h"
#include "genesis/primitive-objects.h"
#include <sys/time.h>
#include <sys/stat.h>
#include <unistd.h>
+#include <shlobj.h>
#include <excpt.h>
/* the simple case first */
os_vm_address_t real_addr;
if (!(real_addr = VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE))) {
- perror("VirtualAlloc");
+ fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
return 0;
}
}
if (!VirtualQuery(addr, &mem_info, sizeof mem_info)) {
- perror("VirtualQuery");
+ fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
return 0;
}
}
if (!VirtualAlloc(addr, len, (mem_info.State == MEM_RESERVE)? MEM_COMMIT: MEM_RESERVE, PAGE_EXECUTE_READWRITE)) {
- perror("VirtualAlloc");
+ fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
return 0;
}
os_invalidate(os_vm_address_t addr, os_vm_size_t len)
{
if (!VirtualFree(addr, len, MEM_DECOMMIT)) {
- perror("VirtualFree");
+ fprintf(stderr, "VirtualFree: 0x%lx.\n", GetLastError());
}
}
{
os_vm_size_t count;
+#if 0
fprintf(stderr, "os_map: %d, 0x%x, %p, 0x%x.\n", fd, offset, addr, len);
fflush(stderr);
+#endif
if (!VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE)) {
- perror("VirtualAlloc");
+ fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
lose("os_map: VirtualAlloc failure");
}
}
boolean
+is_linkage_table_addr(os_vm_address_t addr)
+{
+ return in_range_p(addr, LINKAGE_TABLE_SPACE_START, LINKAGE_TABLE_SPACE_END);
+}
+
+boolean
is_valid_lisp_addr(os_vm_address_t addr)
{
struct thread *th;
struct lisp_exception_frame *exception_frame)
{
if (*((char *)context->Eip + 1) == trap_ContextRestore) {
- /*
- * This is the cleanup for what is immediately below, and
+ /* This is the cleanup for what is immediately below, and
* for the generic exception handling further below. We
* have to memcpy() the original context (emulated sigtrap
- * or normal exception) over our context and resume it.
- */
+ * or normal exception) over our context and resume it. */
memcpy(context, &exception_frame->context, sizeof(CONTEXT));
return ExceptionContinueExecution;
- } else { /* Not a trap_ContextRestore, must be a sigtrap. */
- /* sigtrap_trampoline is defined in x86-assem.S. */
+ } else {
+ /* Not a trap_ContextRestore, must be a sigtrap.
+ * sigtrap_trampoline is defined in x86-assem.S. */
extern void sigtrap_trampoline;
/*
*/
context->Eip++;
- /*
- * We're not on an alternate stack like we would be in some
+ /* We're not on an alternate stack like we would be in some
* other operating systems, and we don't want to risk leaking
* any important resources if we throw out of the sigtrap
* handler, so we need to copy off our context to a "safe"
* I can come up with for this, however, involves a stack
* overflow occuring at just the wrong time (which makes one
* wonder how stack overflow exceptions even happen, given
- * that we don't switch stacks for exception processing...)
- */
+ * that we don't switch stacks for exception processing...) */
memcpy(&exception_frame->context, context, sizeof(CONTEXT));
+
+ /* FIXME: Why do we save the old EIP in EAX? The sigtrap_trampoline
+ * pushes it into stack, but the sigtrap_wrapper where the trampoline
+ * goes ignores it, and after the wrapper we hit the trap_ContextRestore,
+ * which nukes the whole context with the original one?
+ *
+ * Am I misreading this, or is the EAX here and in the
+ * trampoline superfluous? --NS 20061024 */
context->Eax = context->Eip;
context->Eip = (unsigned long)&sigtrap_trampoline;
* wrappers. Once it is installed there, it can probably be
* removed from here.
*/
-
extern void sigtrap_handler(int signal, siginfo_t *info, void *context);
/* volatile struct { */
/* Pick off sigtrap case first. */
return sigtrap_emulator(context, exception_frame);
- } else if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION &&
- is_valid_lisp_addr(fault_address)) {
+ }
+ else if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION &&
+ (is_valid_lisp_addr(fault_address) ||
+ is_linkage_table_addr(fault_address))) {
/* Pick off GC-related memory fault next. */
MEMORY_BASIC_INFORMATION mem_info;
/* exception_trampoline is defined in x86-assem.S. */
extern void exception_trampoline;
- /*
- * We're making the somewhat arbitrary decision that
- * having internal errors enabled means that lisp has
- * sufficient marbles to be able to handle exceptions.
+ /* We're making the somewhat arbitrary decision that having
+ * internal errors enabled means that lisp has sufficient
+ * marbles to be able to handle exceptions, but xceptions
+ * aren't supposed to happen during cold init or reinit
+ * anyway.
*
- * Exceptions aren't supposed to happen during cold
- * init or reinit anyway.
- */
-
- /*
* We use the same mechanism as the sigtrap emulator above
* with just a couple changes. We obviously use a different
* trampoline and wrapper function, we kill out any live
* floating point exceptions, and we save off the exception
- * record as well as the context.
- */
+ * record as well as the context. */
/* Save off context and exception information */
memcpy(&exception_frame->context, context, sizeof(CONTEXT));
memcpy(&exception_frame->exception, exception_record, sizeof(EXCEPTION_RECORD));
- /* Set up to activate trampoline when we return */
+ /* Set up to activate trampoline when we return
+ *
+ * FIXME: Why do we save the old EIP in EAX? The
+ * exception_trampoline pushes it into stack, but the wrapper
+ * where the trampoline goes ignores it, and then the wrapper
+ * unwinds from Lisp... WTF?
+ *
+ * Am I misreading this, or is the EAX here and in the
+ * trampoline superfluous? --NS 20061024 */
context->Eax = context->Eip;
context->Eip = (unsigned long)&exception_trampoline;
/* Make sure a floating-point trap doesn't kill us */
context->FloatSave.StatusWord &= ~0x3f;
- /* And return */
+ /* And return. */
return ExceptionContinueExecution;
}
fflush(stderr);
fake_foreign_function_call(context);
- monitor_or_something();
+ lose("fake_foreign_function_call fell through");
+ /* FIXME: WTF? How are we supposed to end up here? */
return ExceptionContinueSearch;
}
funcall2(SymbolFunction(HANDLE_WIN32_EXCEPTION), context_sap,
exception_record_sap);
+ /* FIXME: These never happen, as the Lisp-side call is
+ * to an ERROR, which means we must do a non-local exit
+ */
undo_fake_foreign_function_call(&context);
-
memcpy(&frame->context, &context, sizeof(CONTEXT));
}
return dest;
}
+char *dirname(char *path)
+{
+ static char buf[PATH_MAX + 1];
+ size_t pathlen = strlen(path);
+ int i;
+
+ if (pathlen >= sizeof(buf)) {
+ lose("Pathname too long in dirname.\n");
+ return NULL;
+ }
+
+ strcpy(buf, path);
+ for (i = pathlen; i >= 0; --i) {
+ if (buf[i] == '/' || buf[i] == '\\') {
+ buf[i] = '\0';
+ break;
+ }
+ }
+
+ return buf;
+}
+
/* This is a manually-maintained version of ldso_stubs.S. */
void scratch(void)
{
- strerror(42);
- asin(0);
+ CloseHandle(0);
+ FlushConsoleInputBuffer(0);
+ FormatMessageA(0, 0, 0, 0, 0, 0, 0);
+ FreeLibrary(0);
+ GetACP();
+ GetConsoleCP();
+ GetConsoleOutputCP();
+ GetCurrentProcess();
+ GetExitCodeProcess(0, 0);
+ GetLastError();
+ GetOEMCP();
+ GetProcAddress(0, 0);
+ GetProcessTimes(0, 0, 0, 0, 0);
+ GetSystemTimeAsFileTime(0);
+ LoadLibrary(0);
+ LocalFree(0);
+ PeekConsoleInput(0, 0, 0, 0);
+ PeekNamedPipe(0, 0, 0, 0, 0, 0);
+ ReadFile(0, 0, 0, 0, 0);
+ Sleep(0);
+ WriteFile(0, 0, 0, 0, 0);
+ _get_osfhandle(0);
+ _pipe(0,0,0);
+ access(0,0);
acos(0);
- sinh(0);
- cosh(0);
- hypot(0, 0);
- write(0, 0, 0);
+ asin(0);
close(0);
- rename(0,0);
- getcwd(0,0);
+ cosh(0);
dup(0);
- LoadLibrary(0);
- GetProcAddress(0, 0);
- mkdir(0);
+ hypot(0, 0);
isatty(0);
- access(0,0)
+ sinh(0);
+ strerror(42);
+ write(0, 0, 0);
+ #ifndef LISP_FEATURE_SB_UNICODE
+ CreateDirectoryA(0,0);
+ GetComputerNameA(0, 0);
+ GetCurrentDirectoryA(0,0);
+ GetEnvironmentVariableA(0, 0, 0);
+ GetVersionExA(0);
+ MoveFileA(0,0);
+ SHGetFolderPathA(0, 0, 0, 0, 0);
+ SetCurrentDirectoryA(0);
+ SetEnvironmentVariableA(0, 0);
+ #else
+ CreateDirectoryW(0,0);
+ FormatMessageW(0, 0, 0, 0, 0, 0, 0);
+ GetComputerNameW(0, 0);
+ GetCurrentDirectoryW(0,0);
+ GetEnvironmentVariableW(0, 0, 0);
+ GetVersionExW(0);
+ MoveFileW(0,0);
+ SHGetFolderPathW(0, 0, 0, 0, 0);
+ SetCurrentDirectoryW(0);
+ SetEnvironmentVariableW(0, 0);
+ #endif
+}
+
+char *
+os_get_runtime_executable_path()
+{
+ char path[MAX_PATH + 1];
+ DWORD bufsize = sizeof(path);
+ DWORD size;
+
+ if ((size = GetModuleFileNameA(NULL, path, bufsize)) == 0)
+ return NULL;
+ else if (size == bufsize && GetLastError() == ERROR_INSUFFICIENT_BUFFER)
+ return NULL;
+
+ return copied_string(path);
}
/* EOF */
projects / sbcl.git / blobdiff