#include "gc.h"
#include "gencgc-internal.h"
#include <winsock2.h>
+#include <wincrypt.h>
#if 0
int linux_sparc_siginfo_bug = 0;
void *base_seh_frame;
+HMODULE runtime_module_handle = 0u;
+
static void *get_seh_frame(void)
{
void* retval;
#if defined(LISP_FEATURE_SB_THREAD)
+void alloc_gc_page()
+{
+ AVER(VirtualAlloc(GC_SAFEPOINT_PAGE_ADDR, sizeof(lispobj),
+ MEM_RESERVE|MEM_COMMIT, PAGE_READWRITE));
+}
+
/* Permit loads from GC_SAFEPOINT_PAGE_ADDR (NB page state change is
* "synchronized" with the memory region content/availability --
* e.g. you won't see other CPU flushing buffered writes after WP --
#endif
+#if defined(LISP_FEATURE_SB_DYNAMIC_CORE)
+/* This feature has already saved me more development time than it
+ * took to implement. In its current state, ``dynamic RT<->core
+ * linking'' is a protocol of initialization of C runtime and Lisp
+ * core, populating SBCL linkage table with entries for runtime
+ * "foreign" symbols that were referenced in cross-compiled code.
+ *
+ * How it works: a sketch
+ *
+ * Last Genesis (resulting in cold-sbcl.core) binds foreign fixups in
+ * x-compiled lisp-objs to sequential addresses from the beginning of
+ * linkage-table space; that's how it ``resolves'' foreign references.
+ * Obviously, this process doesn't require pre-built runtime presence.
+ *
+ * When the runtime loads the core (cold-sbcl.core initially,
+ * sbcl.core later), runtime should do its part of the protocol by (1)
+ * traversing a list of ``runtime symbols'' prepared by Genesis and
+ * dumped as a static symbol value, (2) resolving each name from this
+ * list to an address (stubbing unresolved ones with
+ * undefined_alien_address or undefined_alien_function), (3) adding an
+ * entry for each symbol somewhere near the beginning of linkage table
+ * space (location is provided by the core).
+ *
+ * The implementation of the part described in the last paragraph
+ * follows. C side is currently more ``hackish'' and less clear than
+ * the Lisp code; OTOH, related Lisp changes are scattered, and some
+ * of them play part in complex interrelations -- beautiful but taking
+ * much time to understand --- but my subset of PE-i386 parser below
+ * is in one place (here) and doesn't have _any_ non-trivial coupling
+ * with the rest of the Runtime.
+ *
+ * What do we gain with this feature, after all?
+ *
+ * One things that I have to do rather frequently: recompile and
+ * replace runtime without rebuilding the core. Doubtlessly, slam.sh
+ * was a great time-saver here, but relinking ``cold'' core and bake a
+ * ``warm'' one takes, as it seems, more than 10x times of bare
+ * SBCL.EXE build time -- even if everything is recompiled, which is
+ * now unnecessary. Today, if I have a new idea for the runtime,
+ * getting from C-x C-s M-x ``compile'' to fully loaded SBCL
+ * installation takes 5-15 seconds.
+ *
+ * Another thing (that I'm not currently using, but obviously
+ * possible) is delivering software patches to remote system on
+ * customer site. As you are doing minor additions or corrections in
+ * Lisp code, it doesn't take much effort to prepare a tiny ``FASL
+ * bundle'' that rolls up your patch, redumps and -- presto -- 100MiB
+ * program is fixed by sending and loading a 50KiB thingie.
+ *
+ * However, until LISP_FEATURE_SB_DYNAMIC_CORE, if your bug were fixed
+ * by modifying two lines of _C_ sources, a customer described above
+ * had to be ready to receive and reinstall a new 100MiB
+ * executable. With the aid of code below, deploying such a fix
+ * requires only sending ~300KiB (when stripped) of SBCL.EXE.
+ *
+ * But there is more to it: as the common linkage-table is used for
+ * DLLs and core, its entries may be overridden almost without a look
+ * into SBCL internals. Therefore, ``patching'' C runtime _without_
+ * restarting target systems is also possible in many situations
+ * (it's not as trivial as loading FASLs into a running daemon, but
+ * easy enough to be a viable alternative if any downtime is highly
+ * undesirable).
+ *
+ * During my (rather limited) commercial Lisp development experience
+ * I've already been through a couple of situations where such
+ * ``deployment'' issues were important; from my _total_ programming
+ * experience I know -- _sometimes_ they are a two orders of magnitude
+ * more important than those I observed.
+ *
+ * The possibility of entire runtime ``hot-swapping'' in running
+ * process is not purely theoretical, as it could seem. There are 2-3
+ * problems whose solution is not obvious (call stack patching, for
+ * instance), but it's literally _nothing_ if compared with
+ * e.g. LISP_FEATURE_SB_AUTO_FPU_SWITCH. By the way, one of the
+ * problems with ``hot-swapping'', that could become a major one in
+ * many other environments, is nonexistent in SBCL: we already have a
+ * ``global quiesce point'' that is generally required for this kind
+ * of worldwide revolution -- around collect_garbage.
+ *
+ * What's almost unnoticeable from the C side (where you are now, dear
+ * reader): using the same style for all linking is beautiful. I tried
+ * to leave old-style linking code in place for the sake of
+ * _non-linkage-table_ platforms (they probably don't have -ldl or its
+ * equivalent, like LL/GPA, at all) -- but i did it usually by moving
+ * the entire `old style' code under #!-sb-dynamic-core and
+ * refactoring the `new style' branch, instead of cutting the tail
+ * piecemeal and increasing #!+-ifdeffery amount & the world enthropy.
+ *
+ * If we look at the majority of the ``new style'' code units, it's a
+ * common thing to observe how #!+-ifdeffery _vanishes_ instead of
+ * multiplying: #!-sb-xc, #!+sb-xc-host and #!-sb-xc-host end up
+ * needing the same code. Runtime checks of static v. dynamic symbol
+ * disappear even faster. STDCALL mangling and leading underscores go
+ * out of scope (and GCed, hopefully) instead of surfacing here and
+ * there as a ``special case for core static symbols''. What I like
+ * the most about CL development in general is a frequency of solving
+ * problems and fixing bugs by simplifying code and dropping special
+ * cases.
+ *
+ * Last important thing about the following code: besides resolving
+ * symbols provided by the core itself, it detects runtime's own
+ * build-time prerequisite DLLs. Any symbol that is unresolved against
+ * the core is looked up in those DLLs (normally kernel32, msvcrt,
+ * ws2_32... I could forget something). This action (1) resembles
+ * implementation of foreign symbol lookup in SBCL itself, (2)
+ * emulates shared library d.l. facilities of OSes that use flat
+ * dynamic symbol namespace (or default to it). Anyone concerned with
+ * portability problems of this PE-i386 stuff below will be glad to
+ * hear that it could be ported to most modern Unices _by deletion_:
+ * raw dlsym() with null handle usually does the same thing that i'm
+ * trying to squeeze out of MS Windows by the brute force.
+ *
+ * My reason for _desiring_ flat symbol namespace, populated from
+ * link-time dependencies, is avoiding any kind of ``requested-by-Lisp
+ * symbol lists to be linked statically'', providing core v. runtime
+ * independence in both directions. Minimizing future maintenance
+ * effort is very important; I had gone for it consistently, starting
+ * by turning "CloseHandle@4" into a simple "CloseHandle", continuing
+ * by adding intermediate Genesis resulting in autogenerated symbol
+ * list (farewell, void scratch(); good riddance), going to take
+ * another great step for core/runtime independence... and _without_
+ * flat namespace emulation, the ghosts and spirits exiled at the
+ * first steps would come and take revenge: well, here are the symbols
+ * that are really in msvcrt.dll.. hmm, let's link statically against
+ * them, so the entry is pulled from the import library.. and those
+ * entry has mangled names that we have to map.. ENOUGH, I though
+ * here: fed up with stuff like that.
+ *
+ * Now here we are, without import libraries, without mangled symbols,
+ * and without nm-generated symbol tables. Every symbol exported by
+ * the runtime is added to SBCL.EXE export directory; every symbol
+ * requested by the core is looked up by GetProcAddress for SBCL.EXE,
+ * falling back to GetProcAddress for MSVCRT.dll, etc etc.. All ties
+ * between SBCL's foreign symbols with object file symbol tables,
+ * import libraries and other pre-linking symbol-resolving entities
+ * _having no representation in SBCL.EXE_ were teared.
+ *
+ * This simplistic approach proved to work well; there is only one
+ * problem introduced by it, and rather minor: in real MSVCRT.dll,
+ * what's used to be available as open() is now called _open();
+ * similar thing happened to many other `lowio' functions, though not
+ * every one, so it's not a kind of name mangling but rather someone's
+ * evil creative mind in action.
+ *
+ * When we look up any of those poor `uglified' functions in CRT
+ * reference on MSDN, we can see a notice resembling this one:
+ *
+ * `unixishname()' is obsolete and provided for backward
+ * compatibility; new standard-compliant function, `_unixishname()',
+ * should be used instead. Sentences of that kind were there for
+ * several years, probably even for a decade or more (a propos,
+ * MSVCRT.dll, as the name to link against, predates year 2000, so
+ * it's actually possible). Reasoning behing it (what MS people had in
+ * mind) always seemed strange to me: if everyone uses open() and that
+ * `everyone' is important to you, why rename the function? If no one
+ * uses open(), why provide or retain _open() at all? <kidding>After
+ * all, names like _open() are entirely non-informative and just plain
+ * ugly; compare that with CreateFileW() or InitCommonControlsEx(),
+ * the real examples of beauty and clarity.</kidding>
+ *
+ * Anyway, if the /standard/ name on Windows is _open() (I start to
+ * recall, vaguely, that it's because of _underscore names being
+ * `reserved to system' and all other ones `available for user', per
+ * ANSI/ISO C89) -- well, if the /standard/ name is _open, SBCL should
+ * use it when it uses MSVCRT and not some ``backward-compatible''
+ * stuff. Deciding this way, I added a hack to SBCL's syscall macros,
+ * so "[_]open" as a syscall name is interpreted as a request to link
+ * agains "_open" on win32 and "open" on every other system.
+ *
+ * Of course, this name-parsing trick lacks conceptual clarity; we're
+ * going to get rid of it eventually. */
+
+u32 os_get_build_time_shared_libraries(u32 excl_maximum,
+ void* opt_root,
+ void** opt_store_handles,
+ const char *opt_store_names[])
+{
+ void* base = opt_root ? opt_root : (void*)runtime_module_handle;
+ /* base defaults to 0x400000 with GCC/mingw32. If you dereference
+ * that location, you'll see 'MZ' bytes */
+ void* base_magic_location =
+ base + ((IMAGE_DOS_HEADER*)base)->e_lfanew;
+
+ /* dos header provided the offset from `base' to
+ * IMAGE_FILE_HEADER where PE-i386 really starts */
+
+ void* check_duplicates[excl_maximum];
+
+ if ((*(u32*)base_magic_location)!=0x4550) {
+ /* We don't need this DLL thingie _that_ much. If the world
+ * has changed to a degree where PE magic isn't found, let's
+ * silently return `no libraries detected'. */
+ return 0;
+ } else {
+ /* We traverse PE-i386 structures of SBCL.EXE in memory (not
+ * in the file). File and memory layout _surely_ differ in
+ * some places and _may_ differ in some other places, but
+ * fortunately, those places are irrelevant to the task at
+ * hand. */
+
+ IMAGE_FILE_HEADER* image_file_header = (base_magic_location + 4);
+ IMAGE_OPTIONAL_HEADER* image_optional_header =
+ (void*)(image_file_header + 1);
+ IMAGE_DATA_DIRECTORY* image_import_direntry =
+ &image_optional_header->DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT];
+ IMAGE_IMPORT_DESCRIPTOR* image_import_descriptor =
+ base + image_import_direntry->VirtualAddress;
+ u32 nlibrary, i,j;
+
+ for (nlibrary=0u; nlibrary < excl_maximum
+ && image_import_descriptor->FirstThunk;
+ ++image_import_descriptor)
+ {
+ HMODULE hmodule;
+ odxprint(runtime_link, "Now should know DLL: %s",
+ (char*)(base + image_import_descriptor->Name));
+ /* Code using image thunk data to get its handle was here, with a
+ * number of platform-specific tricks (like using VirtualQuery for
+ * old OSes lacking GetModuleHandleEx).
+ *
+ * It's now replaced with requesting handle by name, which is
+ * theoretically unreliable (with SxS, multiple modules with same
+ * name are quite possible), but good enough to find the
+ * link-time dependencies of our executable or DLL. */
+
+ hmodule = (HMODULE)
+ GetModuleHandle(base + image_import_descriptor->Name);
+
+ if (hmodule)
+ {
+ /* We may encouncer some module more than once while
+ traversing import descriptors (it's usually a
+ result of non-trivial linking process, like doing
+ ld -r on some groups of files before linking
+ everything together.
+
+ Anyway: using a module handle more than once will
+ do no harm, but it slows down the startup (even
+ now, our startup time is not a pleasant topic to
+ discuss when it comes to :sb-dynamic-core; there is
+ an obvious direction to go for speed, though --
+ instead of resolving symbols one-by-one, locate PE
+ export directories -- they are sorted by symbol
+ name -- and merge them, at one pass, with sorted
+ list of required symbols (the best time to sort the
+ latter list is during Genesis -- that's why I don't
+ proceed with memory copying, qsort() and merge
+ right here)). */
+
+ for (j=0; j<nlibrary; ++j)
+ {
+ if(check_duplicates[j] == hmodule)
+ break;
+ }
+ if (j<nlibrary) continue; /* duplicate => skip it in
+ * outer loop */
+
+ check_duplicates[nlibrary] = hmodule;
+ if (opt_store_handles) {
+ opt_store_handles[nlibrary] = hmodule;
+ }
+ if (opt_store_names) {
+ opt_store_names[nlibrary] = (const char *)
+ (base + image_import_descriptor->Name);
+ }
+ odxprint(runtime_link, "DLL detection: %u, base %p: %s",
+ nlibrary, hmodule,
+ (char*)(base + image_import_descriptor->Name));
+ ++ nlibrary;
+ }
+ }
+ return nlibrary;
+ }
+}
+
+static u32 buildTimeImageCount = 0;
+static void* buildTimeImages[16];
+
+/* Resolve symbols against the executable and its build-time dependencies */
+void* os_dlsym_default(char* name)
+{
+ unsigned int i;
+ void* result = 0;
+ if (buildTimeImageCount == 0) {
+ buildTimeImageCount =
+ 1 + os_get_build_time_shared_libraries(15u,
+ NULL, 1+(void**)buildTimeImages, NULL);
+ }
+ for (i = 0; i<buildTimeImageCount && (!result); ++i) {
+ result = GetProcAddress(buildTimeImages[i], name);
+ }
+ return result;
+}
+
+#endif /* SB_DYNAMIC_CORE */
+
#if defined(LISP_FEATURE_SB_THREAD)
/* We want to get a slot in TIB that (1) is available at constant
offset, (2) is our private property, so libraries wouldn't legally
}
#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);
#undef RESOLVE
+intptr_t win32_get_module_handle_by_address(os_vm_address_t addr)
+{
+ HMODULE result = 0;
+ /* So apparently we could use VirtualQuery instead of
+ * GetModuleHandleEx if we wanted to support pre-XP, pre-2003
+ * versions of Windows (i.e. Windows 2000). I've opted against such
+ * special-casing. :-). --DFL */
+ return (intptr_t)(GetModuleHandleEx(
+ GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS |
+ GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT,
+ (LPCSTR)addr, &result)
+ ? result : 0);
+}
+
void os_init(char *argv[], char *envp[])
{
SYSTEM_INFO system_info;
base_seh_frame = get_seh_frame();
resolve_optional_imports();
+ runtime_module_handle = (HMODULE)win32_get_module_handle_by_address(&runtime_module_handle);
}
static inline boolean local_thread_stack_address_p(os_vm_address_t address)
AVERLAX(VirtualFree(minfo.AllocationBase, 0, MEM_RELEASE));
}
-#define maybe_open_osfhandle _open_osfhandle
-#define maybe_get_osfhandle _get_osfhandle
-#define FDTYPE int
+/* os_validate doesn't commit, i.e. doesn't actually "validate" in the
+ * sense that we could start using the space afterwards. Usually it's
+ * os_map or Lisp code that will run into that, in which case we recommit
+ * elsewhere in this file. For cases where C wants to write into newly
+ * os_validate()d memory, it needs to commit it explicitly first:
+ */
+os_vm_address_t
+os_validate_recommit(os_vm_address_t addr, os_vm_size_t len)
+{
+ return
+ AVERLAX(VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE));
+}
/*
* 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.
+ Real limit observed on W2K-SP3 is somewhere in between 32KiB and 64Kib...
+*/
+#define MAX_CONSOLE_TCHARS 16384
+
+int
+win32_write_unicode_console(HANDLE handle, void * buf, int count)
+{
+ DWORD written = 0;
+ DWORD nchars;
+ BOOL result;
+ nchars = count>>1;
+ if (nchars>MAX_CONSOLE_TCHARS) nchars = MAX_CONSOLE_TCHARS;
+
+ if (!io_begin_interruptible(handle)) {
+ errno = EINTR;
+ return -1;
+ }
+ result = WriteConsoleW(handle,buf,nchars,&written,NULL);
+ io_end_interruptible(handle);
+
+ if (result) {
+ if (!written) {
+ errno = EINTR;
+ return -1;
+ } else {
+ return 2*written;
+ }
+ } else {
+ DWORD err = GetLastError();
+ odxprint(io,"WriteConsole fails => %u\n", err);
+ errno = (err==ERROR_OPERATION_ABORTED ? EINTR : EIO);
+ return -1;
+ }
+}
+
+/*
+ * (AK writes:)
+ *
+ * It may be unobvious, but (probably) the most straightforward way of
+ * providing some sane CL:LISTEN semantics for line-mode console
+ * channel requires _dedicated input thread_.
+ *
+ * LISTEN should return true iff the next (READ-CHAR) won't have to
+ * wait. As our console may be shared with another process, entirely
+ * out of our control, looking at the events in PeekConsoleEvent
+ * result (and searching for #\Return) doesn't cut it.
+ *
+ * We decided that console input thread must do something smarter than
+ * a bare loop of continuous ReadConsoleW(). On Unix, user experience
+ * with the terminal is entirely unaffected by the fact that some
+ * process does (or doesn't) call read(); the situation on MS Windows
+ * is different.
+ *
+ * Echo output and line editing present on MS Windows while some
+ * process is waiting in ReadConsole(); otherwise all input events are
+ * buffered. If our thread were calling ReadConsole() all the time, it
+ * would feel like Unix cooked mode.
+ *
+ * But we don't write a Unix emulator here, even if it sometimes feels
+ * like that; therefore preserving this aspect of console I/O seems a
+ * good thing to us.
+ *
+ * LISTEN itself becomes trivial with dedicated input thread, but the
+ * goal stated above -- provide `native' user experience with blocked
+ * console -- don't play well with this trivial implementation.
+ *
+ * What's currently implemented is a compromise, looking as something
+ * in between Unix cooked mode and Win32 line mode.
+ *
+ * 1. As long as no console I/O function is called (incl. CL:LISTEN),
+ * console looks `blocked': no echo, no line editing.
+ *
+ * 2. (READ-CHAR), (READ-SEQUENCE) and other functions doing real
+ * input result in the ReadConsole request (in a dedicated thread);
+ *
+ * 3. Once ReadConsole is called, it is not cancelled in the
+ * middle. In line mode, it returns when <Enter> key is hit (or
+ * something like that happens). Therefore, if line editing and echo
+ * output had a chance to happen, console won't look `blocked' until
+ * the line is entered (even if line input was triggered by
+ * (READ-CHAR)).
+ *
+ * 4. LISTEN may request ReadConsole too (if no other thread is
+ * reading the console and no data are queued). It's the only case
+ * when the console becomes `unblocked' without any actual input
+ * requested by Lisp code. LISTEN check if there is at least one
+ * input event in PeekConsole queue; unless there is such an event,
+ * ReadConsole is not triggered by LISTEN.
+ *
+ * 5. Console-reading Lisp thread now may be interrupted immediately;
+ * ReadConsole call itself, however, continues until the line is
+ * entered.
+ */
+
+struct {
+ WCHAR buffer[MAX_CONSOLE_TCHARS];
+ DWORD head, tail;
+ pthread_mutex_t lock;
+ pthread_cond_t cond_has_data;
+ pthread_cond_t cond_has_client;
+ pthread_t thread;
+ boolean initialized;
+ HANDLE handle;
+ boolean in_progress;
+} ttyinput = {.lock = PTHREAD_MUTEX_INITIALIZER};
+
+static void*
+tty_read_line_server()
+{
+ pthread_mutex_lock(&ttyinput.lock);
+ while (ttyinput.handle) {
+ DWORD nchars;
+ BOOL ok;
+
+ while (!ttyinput.in_progress)
+ pthread_cond_wait(&ttyinput.cond_has_client,&ttyinput.lock);
+
+ pthread_mutex_unlock(&ttyinput.lock);
+
+ ok = ReadConsoleW(ttyinput.handle,
+ &ttyinput.buffer[ttyinput.tail],
+ MAX_CONSOLE_TCHARS-ttyinput.tail,
+ &nchars,NULL);
+
+ pthread_mutex_lock(&ttyinput.lock);
+
+ if (ok) {
+ ttyinput.tail += nchars;
+ pthread_cond_broadcast(&ttyinput.cond_has_data);
+ }
+ ttyinput.in_progress = 0;
+ }
+ pthread_mutex_unlock(&ttyinput.lock);
+ return NULL;
+}
+
+static boolean
+tty_maybe_initialize_unlocked(HANDLE handle)
+{
+ if (!ttyinput.initialized) {
+ if (!DuplicateHandle(GetCurrentProcess(),handle,
+ GetCurrentProcess(),&ttyinput.handle,
+ 0,FALSE,DUPLICATE_SAME_ACCESS)) {
+ return 0;
+ }
+ pthread_cond_init(&ttyinput.cond_has_data,NULL);
+ pthread_cond_init(&ttyinput.cond_has_client,NULL);
+ pthread_create(&ttyinput.thread,NULL,tty_read_line_server,NULL);
+ ttyinput.initialized = 1;
+ }
+ return 1;
+}
+
+boolean
+win32_tty_listen(HANDLE handle)
+{
+ boolean result = 0;
+ INPUT_RECORD ir;
+ DWORD nevents;
+ pthread_mutex_lock(&ttyinput.lock);
+ if (!tty_maybe_initialize_unlocked(handle))
+ result = 0;
+
+ if (ttyinput.in_progress) {
+ result = 0;
+ } else {
+ if (ttyinput.head != ttyinput.tail) {
+ result = 1;
+ } else {
+ if (PeekConsoleInput(ttyinput.handle,&ir,1,&nevents) && nevents) {
+ ttyinput.in_progress = 1;
+ pthread_cond_broadcast(&ttyinput.cond_has_client);
+ }
+ }
+ }
+ pthread_mutex_unlock(&ttyinput.lock);
+ return result;
+}
+
+static int
+tty_read_line_client(HANDLE handle, void* buf, int count)
+{
+ int result = 0;
+ int nchars = count / sizeof(WCHAR);
+ sigset_t pendset;
+
+ if (!nchars)
+ return 0;
+ if (nchars>MAX_CONSOLE_TCHARS)
+ nchars=MAX_CONSOLE_TCHARS;
+
+ count = nchars*sizeof(WCHAR);
+
+ pthread_mutex_lock(&ttyinput.lock);
+
+ if (!tty_maybe_initialize_unlocked(handle)) {
+ result = -1;
+ errno = EIO;
+ goto unlock;
+ }
+
+ while (!result) {
+ while (ttyinput.head == ttyinput.tail) {
+ if (!io_begin_interruptible(ttyinput.handle)) {
+ ttyinput.in_progress = 0;
+ result = -1;
+ errno = EINTR;
+ goto unlock;
+ } else {
+ if (!ttyinput.in_progress) {
+ /* We are to wait */
+ ttyinput.in_progress=1;
+ /* wake console reader */
+ pthread_cond_broadcast(&ttyinput.cond_has_client);
+ }
+ pthread_cond_wait(&ttyinput.cond_has_data, &ttyinput.lock);
+ io_end_interruptible(ttyinput.handle);
+ }
+ }
+ result = sizeof(WCHAR)*(ttyinput.tail-ttyinput.head);
+ if (result > count) {
+ result = count;
+ }
+ if (result) {
+ if (result > 0) {
+ DWORD nch,offset = 0;
+ LPWSTR ubuf = buf;
+
+ memcpy(buf,&ttyinput.buffer[ttyinput.head],count);
+ ttyinput.head += (result / sizeof(WCHAR));
+ if (ttyinput.head == ttyinput.tail)
+ ttyinput.head = ttyinput.tail = 0;
+
+ for (nch=0;nch<result/sizeof(WCHAR);++nch) {
+ if (ubuf[nch]==13) {
+ ++offset;
+ } else {
+ ubuf[nch-offset]=ubuf[nch];
+ }
+ }
+ result-=offset*sizeof(WCHAR);
+
+ }
+ } else {
+ result = -1;
+ ttyinput.head = ttyinput.tail = 0;
+ errno = EIO;
+ }
+ }
+unlock:
+ pthread_mutex_unlock(&ttyinput.lock);
+ return result;
+}
+
+int
+win32_read_unicode_console(HANDLE handle, void* buf, int count)
+{
+
+ int result;
+ result = tty_read_line_client(handle,buf,count);
+ return result;
}
boolean
{
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,
(LPVOID)INVALID_HANDLE_VALUE);
if (h && (h!=INVALID_HANDLE_VALUE)) {
+ if (console_handle_p(h)) {
+ pthread_mutex_lock(&ttyinput.lock);
+ pthread_cond_broadcast(&ttyinput.cond_has_data);
+ pthread_mutex_unlock(&ttyinput.lock);
+ }
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 write(fd, buf, count);
+ return win32_write_unicode_console(handle,buf,count);
overlapped.hEvent = self->private_events.events[0];
seekable = SetFilePointerEx(handle,
}
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 read(fd, buf, count);
+ return win32_read_unicode_console(handle,buf,count);
+
overlapped.hEvent = self->private_events.events[0];
/* If it has a position, we won't try overlapped */
seekable = SetFilePointerEx(handle,
return read_bytes;
}
-/* This is a manually-maintained version of ldso_stubs.S. */
-
-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.
+ * That poses a problem, however, since our C code no longer includes
+ * any references to symbols in ws2_32.dll, and hence the linker
+ * completely ignores our request to reference it (--no-as-needed does
+ * not work). Warm init would later load the DLLs explicitly, but then
+ * it's too late for an early sanity check. In the unfortunate spirit
+ * of scratch(), continue to reference some required DLLs explicitly by
+ * means of one scratch symbol per DLL.
+ */
void scratch(void)
{
- LARGE_INTEGER la = {{0}};
- closesocket(0);
- CloseHandle(0);
+ /* a function from ws2_32.dll */
shutdown(0, 0);
- SetHandleInformation(0, 0, 0);
- GetHandleInformation(0, 0);
- getsockopt(0, 0, 0, 0, 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);
- _open_osfhandle(0, 0);
- _rmdir(0);
- _pipe(0,0,0);
- access(0,0);
- close(0);
- dup(0);
- isatty(0);
- strerror(42);
- write(0, 0, 0);
- RtlUnwind(0, 0, 0, 0);
- MapViewOfFile(0,0,0,0,0);
- UnmapViewOfFile(0);
- FlushViewOfFile(0,0);
- SetFilePointerEx(0, la, 0, 0);
- DuplicateHandle(0, 0, 0, 0, 0, 0, 0);
- #ifndef LISP_FEATURE_SB_UNICODE
- CreateDirectoryA(0,0);
- CreateFileMappingA(0,0,0,0,0,0);
- CreateFileA(0,0,0,0,0,0,0);
- GetComputerNameA(0, 0);
- GetCurrentDirectoryA(0,0);
- GetEnvironmentVariableA(0, 0, 0);
- GetFileAttributesA(0);
- GetVersionExA(0);
- MoveFileA(0,0);
- SHGetFolderPathA(0, 0, 0, 0, 0);
- SetCurrentDirectoryA(0);
- SetEnvironmentVariableA(0, 0);
- #else
- CreateDirectoryW(0,0);
- CreateFileMappingW(0,0,0,0,0,0);
- CreateFileW(0,0,0,0,0,0,0);
- FormatMessageW(0, 0, 0, 0, 0, 0, 0);
- GetComputerNameW(0, 0);
- GetCurrentDirectoryW(0,0);
- GetEnvironmentVariableW(0, 0, 0);
- GetFileAttributesW(0);
- GetVersionExW(0);
- MoveFileW(0,0);
- SHGetFolderPathW(0, 0, 0, 0, 0);
- SetCurrentDirectoryW(0);
- SetEnvironmentVariableW(0, 0);
- #endif
- _exit(0);
+
+ /* a function from shell32.dll */
+ SHGetFolderPathA(0, 0, 0, 0, 0);
+
+ /* from advapi32.dll */
+ CryptGenRandom(0, 0, 0);
}
char *