#include "gc.h"
#include "gencgc-internal.h"
#include <winsock2.h>
+#include <wincrypt.h>
#if 0
int linux_sparc_siginfo_bug = 0;
}
#endif /* LISP_FEATURE_SB_THREAD */
+
+#ifdef LISP_FEATURE_X86_64
+/* Windows has 32-bit 'longs', so printf...%lX (and other %l patterns) doesn't
+ * work well with address-sized values, like it's done all over the place in
+ * SBCL. And msvcrt uses I64, not LL, for printing long longs.
+ *
+ * I've already had enough search/replace with longs/words/intptr_t for today,
+ * so I prefer to solve this problem with a format string translator. */
+
+/* There is (will be) defines for printf and friends. */
+
+static int translating_vfprintf(FILE*stream, const char *fmt, va_list args)
+{
+ char translated[1024];
+ int i=0, delta = 0;
+
+ while (fmt[i-delta] && i<sizeof(translated)-1) {
+ if((fmt[i-delta]=='%')&&
+ (fmt[i-delta+1]=='l')) {
+ translated[i++]='%';
+ translated[i++]='I';
+ translated[i++]='6';
+ translated[i++]='4';
+ delta += 2;
+ } else {
+ translated[i]=fmt[i-delta];
+ ++i;
+ }
+ }
+ translated[i++]=0;
+ return vfprintf(stream,translated,args);
+}
+
+int printf(const char*fmt,...)
+{
+ va_list args;
+ va_start(args,fmt);
+ return translating_vfprintf(stdout,fmt,args);
+}
+int fprintf(FILE*stream,const char*fmt,...)
+{
+ va_list args;
+ va_start(args,fmt);
+ return translating_vfprintf(stream,fmt,args);
+}
+
+#endif
+
int os_number_of_processors = 1;
BOOL WINAPI CancelIoEx(HANDLE handle, LPOVERLAPPED overlapped);
AVERLAX(VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE));
}
-#define maybe_open_osfhandle _open_osfhandle
-#define maybe_get_osfhandle _get_osfhandle
-#define FDTYPE int
-
/*
* os_map() is called to map a chunk of the core file into memory.
*
#endif
-#if defined(LISP_FEATURE_X86)
static int
handle_single_step(os_context_t *ctx)
{
/* We are doing a displaced instruction. At least function
* end breakpoints use this. */
- WITH_GC_AT_SAFEPOINTS_ONLY () /* Todo: Is it really gc-unsafe? */
- restore_breakpoint_from_single_step(ctx);
+ restore_breakpoint_from_single_step(ctx);
return 0;
}
-#endif
#ifdef LISP_FEATURE_UD2_BREAKPOINTS
#define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_ILLEGAL_INSTRUCTION
handle_breakpoint_trap(os_context_t *ctx, struct thread* self)
{
#ifdef LISP_FEATURE_UD2_BREAKPOINTS
- if (((unsigned short *)((ctx->win32_context)->Eip))[0] != 0x0b0f)
+ if (((unsigned short *)*os_context_pc_addr(ctx))[0] != 0x0b0f)
return -1;
#endif
context.sigmask = self ? self->os_thread->blocked_signal_set : 0;
#endif
+ os_context_register_t oldbp = NULL;
+ if (self) {
+ oldbp = self ? self->carried_base_pointer : 0;
+ self->carried_base_pointer
+ = (os_context_register_t) voidreg(win32_context, bp);
+ }
+
/* For EXCEPTION_ACCESS_VIOLATION only. */
void *fault_address = (void *)exception_record->ExceptionInformation[1];
rc = handle_breakpoint_trap(ctx, self);
break;
-#if defined(LISP_FEATURE_X86)
case EXCEPTION_SINGLE_STEP:
rc = handle_single_step(ctx);
break;
-#endif
default:
rc = -1;
/* All else failed, drop through to the lisp-side exception handler. */
signal_internal_error_or_lose(ctx, exception_record, fault_address);
+ if (self)
+ self->carried_base_pointer = oldbp;
+
errno = lastErrno;
SetLastError(lastError);
return ExceptionContinueExecution;
}
+#ifdef LISP_FEATURE_X86_64
+
+#define RESTORING_ERRNO() \
+ int sbcl__lastErrno = errno; \
+ RUN_BODY_ONCE(restoring_errno, errno = sbcl__lastErrno)
+
+LONG
+veh(EXCEPTION_POINTERS *ep)
+{
+ EXCEPTION_DISPOSITION disp;
+
+ RESTORING_ERRNO() {
+ if (!pthread_self())
+ return EXCEPTION_CONTINUE_SEARCH;
+ }
+
+ disp = handle_exception(ep->ExceptionRecord,0,ep->ContextRecord,0);
+
+ switch (disp)
+ {
+ case ExceptionContinueExecution:
+ return EXCEPTION_CONTINUE_EXECUTION;
+ case ExceptionContinueSearch:
+ return EXCEPTION_CONTINUE_SEARCH;
+ default:
+ fprintf(stderr,"Exception handler is mad\n");
+ ExitProcess(0);
+ }
+}
+#endif
+
+os_context_register_t
+carry_frame_pointer(os_context_register_t default_value)
+{
+ struct thread* self = arch_os_get_current_thread();
+ os_context_register_t bp = self->carried_base_pointer;
+ return bp ? bp : default_value;
+}
+
void
wos_install_interrupt_handlers(struct lisp_exception_frame *handler)
{
return buf;
}
+// 0 - not a socket or other error, 1 - has input, 2 - has no input
+int
+socket_input_available(HANDLE socket)
+{
+ unsigned long count = 0, count_size = 0;
+ int wsaErrno = GetLastError();
+ int err = WSAIoctl((SOCKET)socket, FIONREAD, NULL, 0,
+ &count, sizeof(count), &count_size, NULL, NULL);
+
+ int ret;
+
+ if (err == 0) {
+ ret = (count > 0) ? 1 : 2;
+ } else
+ ret = 0;
+ SetLastError(wsaErrno);
+ return ret;
+}
+
/* Unofficial but widely used property of console handles: they have
#b11 in two minor bits, opposed to other handles, that are
machine-word-aligned. Properly emulated even on wine.
return 1;
}
+static pthread_mutex_t interrupt_io_lock = PTHREAD_MUTEX_INITIALIZER;
+
/* Unmark current thread as (probably) doing synchronous I/O; if an
* I/O cancellation was requested, postpone it until next
* io_begin_interruptible */
{
if (!ptr_CancelIoEx)
return;
+ pthread_mutex_lock(&interrupt_io_lock);
__sync_bool_compare_and_swap(&this_thread->synchronous_io_handle_and_flag,
handle, 0);
+ pthread_mutex_unlock(&interrupt_io_lock);
}
/* Documented limit for ReadConsole/WriteConsole is 64K bytes.
{
struct thread *th = thread;
boolean done = 0;
- /* Kludge. (?)
- *
- * ICBW about all of this. But it seems to me that this procedure is
- * a race condition. In theory. One that is hard produce (I can't
- * come up with a test case that exploits it), and might only be a bug
- * if users are doing weird things with I/O, possibly from FFI. But a
- * race is a race, so shouldn't this function and io_end_interruptible
- * cooperate more?
- *
- * Here's my thinking:
- *
- * A.. <interruptee thread>
- * ... stuffs its handle into its structure.
- * B.. <interrupter thread>
- * ... calls us to wake the thread, finds the handle.
- * But just before we actually call CancelSynchronousIo/CancelIoEx,
- * something weird happens in the scheduler and the system is
- * so extremely busy that the interrupter doesn't get scheduled
- * for a while, giving the interruptee lots of time to continue.
- * A.. Didn't actually have to block, calls io_end_interruptible (in
- * which the handle flag already invalid, but it doesn't care
- * about that and still continues).
- * ... Proceeds to do unrelated I/O, e.g. goes into FFI code
- * (possible, because the CSP page hasn't been armed yet), which
- * does I/O from a C library, completely unrelated to SBCL's
- * routines.
- * B.. The scheduler gives us time for the interrupter again.
- * We call CancelSynchronousIo/CancelIoEx.
- * A.. Interruptee gets an expected error in unrelated I/O during FFI.
- * Interruptee's C code is unhappy and dies.
- *
- * Note that CancelSynchronousIo and CancelIoEx have a rather different
- * effect here. In the normal (CancelIoEx) case, we only ever kill
- * I/O on the file handle in question. I think we could ask users
- * to please not both use Lisp streams (unix-read/write) _and_ FFI code
- * on the same file handle in quick succession.
- *
- * CancelSynchronousIo seems more dangerous though. Here we interrupt
- * I/O on any other handle, even ones we're not actually responsible for,
- * because this functions deals with the thread handle, not the file
- * handle.
- *
- * Options:
- * - Use mutexes. Somewhere, somehow. Presumably one mutex per
- * target thread, acquired around win32_maybe_interrupt_io and
- * io_end_interruptible. (That's one mutex use per I/O
- * operation, but I can't imagine that compared to our FFI overhead
- * that's much of a problem.)
- * - In io_end_interruptible, detect that the flag has been
- * invalidated, and in that case, do something clever (what?) to
- * wait for the imminent gc_stop_the_world, which implicitly tells
- * us that win32_maybe_interrupt_io must have exited. Except if
- * some _third_ thread is also beginning to call interrupt-thread
- * and wake_thread at the same time...?
- * - Revert the whole CancelSynchronousIo business after all.
- * - I'm wrong and everything is OK already.
- */
if (ptr_CancelIoEx) {
+ pthread_mutex_lock(&interrupt_io_lock);
HANDLE h = (HANDLE)
InterlockedExchangePointer((volatile LPVOID *)
&th->synchronous_io_handle_and_flag,
}
if (ptr_CancelSynchronousIo) {
pthread_mutex_lock(&th->os_thread->fiber_lock);
- done = ptr_CancelSynchronousIo(th->os_thread->fiber_group->handle);
+ done = !!ptr_CancelSynchronousIo(th->os_thread->fiber_group->handle);
pthread_mutex_unlock(&th->os_thread->fiber_lock);
}
- return (!!done)|(!!ptr_CancelIoEx(h,NULL));
+ done |= !!ptr_CancelIoEx(h,NULL);
}
+ pthread_mutex_unlock(&interrupt_io_lock);
}
- return 0;
+ return done;
}
static const LARGE_INTEGER zero_large_offset = {.QuadPart = 0LL};
int
-win32_unix_write(FDTYPE fd, void * buf, int count)
+win32_unix_write(HANDLE handle, void * buf, int count)
{
- HANDLE handle;
DWORD written_bytes;
OVERLAPPED overlapped;
struct thread * self = arch_os_get_current_thread();
BOOL seekable;
BOOL ok;
- handle =(HANDLE)maybe_get_osfhandle(fd);
if (console_handle_p(handle))
return win32_write_unicode_console(handle,buf,count);
}
int
-win32_unix_read(FDTYPE fd, void * buf, int count)
+win32_unix_read(HANDLE handle, void * buf, int count)
{
- HANDLE handle;
OVERLAPPED overlapped = {.Internal=0};
DWORD read_bytes = 0;
struct thread * self = arch_os_get_current_thread();
LARGE_INTEGER file_position;
BOOL seekable;
- handle = (HANDLE)maybe_get_osfhandle(fd);
-
if (console_handle_p(handle))
return win32_read_unicode_console(handle,buf,count);
return read_bytes;
}
-void __stdcall RtlUnwind(void *, void *, void *, void *); /* I don't have winternl.h */
-
/* We used to have a scratch() function listing all symbols needed by
* Lisp. Much rejoicing commenced upon its removal. However, I would
* like cold init to fail aggressively when encountering unused symbols.
/* a function from shell32.dll */
SHGetFolderPathA(0, 0, 0, 0, 0);
+
+ /* from advapi32.dll */
+ CryptGenRandom(0, 0, 0);
}
char *
projects / sbcl.git / blobdiff