2 * the Win32 incarnation of OS-dependent routines. See also
3 * $(sbcl_arch)-win32-os.c
5 * This file (along with os.h) exports an OS-independent interface to
6 * the operating system VM facilities. Surprise surprise, this
7 * interface looks a lot like the Mach interface (but simpler in some
8 * places). For some operating systems, a subset of these functions
9 * will have to be emulated.
13 * This software is part of the SBCL system. See the README file for
16 * This software is derived from the CMU CL system, which was
17 * written at Carnegie Mellon University and released into the
18 * public domain. The software is in the public domain and is
19 * provided with absolutely no warranty. See the COPYING and CREDITS
20 * files for more information.
24 * This file was copied from the Linux version of the same, and
25 * likely still has some linuxisms in it have haven't been elimiated
32 #include <sys/param.h>
40 #include "interrupt.h"
45 #include "genesis/primitive-objects.h"
48 #include <sys/types.h>
63 #ifndef LISP_FEATURE_SB_THREAD
64 /* dummy definition to reduce ifdef clutter */
65 #define WITH_GC_AT_SAFEPOINTS_ONLY() if (0) ; else
68 os_vm_size_t os_vm_page_size;
71 #include "gencgc-internal.h"
75 int linux_sparc_siginfo_bug = 0;
76 int linux_supports_futex=0;
82 /* missing definitions for modern mingws */
84 #define EH_UNWINDING 0x02
86 #ifndef EH_EXIT_UNWIND
87 #define EH_EXIT_UNWIND 0x04
90 /* Tired of writing arch_os_get_current_thread each time. */
91 #define this_thread (arch_os_get_current_thread())
93 /* wrappers for winapi calls that must be successful (like SBCL's
94 * (aver ...) form). */
96 /* win_aver function: basic building block for miscellaneous
97 * ..AVER.. macrology (below) */
99 /* To do: These routines used to be "customizable" with dyndebug_init()
100 * and variables like dyndebug_survive_aver, dyndebug_skip_averlax based
101 * on environment variables. Those features got lost on the way, but
102 * ought to be reintroduced. */
105 intptr_t win_aver(intptr_t value, char* comment, char* file, int line,
109 LPSTR errorMessage = "<FormatMessage failed>";
110 DWORD errorCode = GetLastError(), allocated=0;
111 int posixerrno = errno;
112 const char* posixstrerror = strerror(errno);
113 char* report_template =
114 "Expression unexpectedly false: %s:%d\n"
116 " ===> returned #X%p, \n"
118 " ... Win32 thinks:\n"
119 " ===> code %u, message => %s\n"
121 " ===> code %u, message => %s\n";
124 FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER|
125 FORMAT_MESSAGE_FROM_SYSTEM,
128 MAKELANGID(LANG_ENGLISH,SUBLANG_ENGLISH_US),
129 (LPSTR)&errorMessage,
134 fprintf(stderr, report_template,
138 (unsigned)errorCode, errorMessage,
139 posixerrno, posixstrerror);
141 lose(report_template,
145 (unsigned)errorCode, errorMessage,
146 posixerrno, posixstrerror);
149 LocalFree(errorMessage);
154 /* sys_aver function: really tiny adaptor of win_aver for
155 * "POSIX-parody" CRT results ("lowio" and similar stuff):
156 * negative number means something... negative. */
158 intptr_t sys_aver(long value, char* comment, char* file, int line,
161 win_aver((intptr_t)(value>=0),comment,file,line,justwarn);
165 /* Check for (call) result being boolean true. (call) may be arbitrary
166 * expression now; massive attack of gccisms ensures transparent type
167 * conversion back and forth, so the type of AVER(expression) is the
168 * type of expression. Value is the same _if_ it can be losslessly
169 * converted to (void*) and back.
171 * Failed AVER() is normally fatal. Well, unless dyndebug_survive_aver
175 ({ __typeof__(call) __attribute__((unused)) me = \
177 win_aver((intptr_t)(call), #call, __FILE__, __LINE__, 0); \
180 /* AVERLAX(call): do the same check as AVER did, but be mild on
181 * failure: print an annoying unrequested message to stderr, and
182 * continue. With dyndebug_skip_averlax flag, AVERLAX stop even to
183 * check and complain. */
185 #define AVERLAX(call) \
186 ({ __typeof__(call) __attribute__((unused)) me = \
188 win_aver((intptr_t)(call), #call, __FILE__, __LINE__, 1); \
191 /* Now, when failed AVER... prints both errno and GetLastError(), two
192 * variants of "POSIX/lowio" style checks below are almost useless
193 * (they build on sys_aver like the two above do on win_aver). */
195 #define CRT_AVER_NONNEGATIVE(call) \
196 ({ __typeof__(call) __attribute__((unused)) me = \
198 sys_aver((call), #call, __FILE__, __LINE__, 0); \
201 #define CRT_AVERLAX_NONNEGATIVE(call) \
202 ({ __typeof__(call) __attribute__((unused)) me = \
204 sys_aver((call), #call, __FILE__, __LINE__, 1); \
208 #define CRT_AVER(booly) \
209 ({ __typeof__(booly) __attribute__((unused)) me = (booly); \
210 sys_aver((booly)?0:-1, #booly, __FILE__, __LINE__, 0); \
213 const char * t_nil_s(lispobj symbol);
216 * The following signal-mask-related alien routines are called from Lisp:
219 /* As of win32, deferrables _do_ matter. gc_signal doesn't. */
220 unsigned long block_deferrables_and_return_mask()
223 block_deferrable_signals(0, &sset);
224 return (unsigned long)sset;
227 #if defined(LISP_FEATURE_SB_THREAD)
228 void apply_sigmask(unsigned long sigmask)
230 sigset_t sset = (sigset_t)sigmask;
231 pthread_sigmask(SIG_SETMASK, &sset, 0);
235 /* The exception handling function looks like this: */
236 EXCEPTION_DISPOSITION handle_exception(EXCEPTION_RECORD *,
237 struct lisp_exception_frame *,
240 /* handle_exception is defined further in this file, but since SBCL
241 * 1.0.1.24, it doesn't get registered as SEH handler directly anymore,
242 * not even by wos_install_interrupt_handlers. Instead, x86-assem.S
243 * provides exception_handler_wrapper; we install it here, and each
244 * exception frame on nested funcall()s also points to it.
248 void *base_seh_frame;
250 static void *get_seh_frame(void)
253 #ifdef LISP_FEATURE_X86
254 asm volatile ("mov %%fs:0,%0": "=r" (retval));
256 asm volatile ("mov %%gs:0,%0": "=r" (retval));
261 static void set_seh_frame(void *frame)
263 #ifdef LISP_FEATURE_X86
264 asm volatile ("mov %0,%%fs:0": : "r" (frame));
266 asm volatile ("mov %0,%%gs:0": : "r" (frame));
270 #if defined(LISP_FEATURE_SB_THREAD)
274 AVER(VirtualAlloc(GC_SAFEPOINT_PAGE_ADDR, sizeof(lispobj),
275 MEM_RESERVE|MEM_COMMIT, PAGE_READWRITE));
278 /* Permit loads from GC_SAFEPOINT_PAGE_ADDR (NB page state change is
279 * "synchronized" with the memory region content/availability --
280 * e.g. you won't see other CPU flushing buffered writes after WP --
281 * but there is some window when other thread _seem_ to trap AFTER
282 * access is granted. You may think of it something like "OS enters
283 * SEH handler too slowly" -- what's important is there's no implicit
284 * synchronization between VirtualProtect caller and other thread's
285 * SEH handler, hence no ordering of events. VirtualProtect is
286 * implicitly synchronized with protected memory contents (only).
288 * The last fact may be potentially used with many benefits e.g. for
289 * foreign call speed, but we don't use it for now: almost the only
290 * fact relevant to the current signalling protocol is "sooner or
291 * later everyone will trap [everyone will stop trapping]".
293 * An interesting source on page-protection-based inter-thread
294 * communication is a well-known paper by Dave Dice, Hui Huang,
295 * Mingyao Yang: ``Asymmetric Dekker Synchronization''. Last time
296 * I checked it was available at
297 * http://home.comcast.net/~pjbishop/Dave/Asymmetric-Dekker-Synchronization.txt
302 AVER(VirtualProtect((void*) GC_SAFEPOINT_PAGE_ADDR, sizeof(lispobj),
303 PAGE_READWRITE, &oldProt));
309 AVER(VirtualProtect((void*) GC_SAFEPOINT_PAGE_ADDR, sizeof(lispobj),
310 PAGE_NOACCESS, &oldProt));
315 #if defined(LISP_FEATURE_SB_THREAD)
316 /* We want to get a slot in TIB that (1) is available at constant
317 offset, (2) is our private property, so libraries wouldn't legally
318 override it, (3) contains something predefined for threads created
321 Low 64 TLS slots are adressable directly, starting with
322 FS:[#xE10]. When SBCL runtime is initialized, some of the low slots
323 may be already in use by its prerequisite DLLs, as DllMain()s and
324 TLS callbacks have been called already. But slot 63 is unlikely to
325 be reached at this point: one slot per DLL that needs it is the
326 common practice, and many system DLLs use predefined TIB-based
327 areas outside conventional TLS storage and don't need TLS slots.
328 With our current dependencies, even slot 2 is observed to be free
329 (as of WinXP and wine).
331 Now we'll call TlsAlloc() repeatedly until slot 63 is officially
332 assigned to us, then TlsFree() all other slots for normal use. TLS
333 slot 63, alias FS:[#.(+ #xE10 (* 4 63))], now belongs to us.
335 To summarize, let's list the assumptions we make:
337 - TIB, which is FS segment base, contains first 64 TLS slots at the
338 offset #xE10 (i.e. TIB layout compatibility);
339 - TLS slots are allocated from lower to higher ones;
340 - All libraries together with CRT startup have not requested 64
343 All these assumptions together don't seem to be less warranted than
344 the availability of TIB arbitrary data slot for our use. There are
345 some more reasons to prefer slot 63 over TIB arbitrary data: (1) if
346 our assumptions for slot 63 are violated, it will be detected at
347 startup instead of causing some system-specific unreproducible
348 problems afterwards, depending on OS and loaded foreign libraries;
349 (2) if getting slot 63 reliably with our current approach will
350 become impossible for some future Windows version, we can add TLS
351 callback directory to SBCL binary; main image TLS callback is
352 started before _any_ TLS slot is allocated by libraries, and
353 some C compiler vendors rely on this fact. */
357 #ifdef LISP_FEATURE_X86
358 DWORD slots[TLS_MINIMUM_AVAILABLE];
361 for (i=0; i<TLS_MINIMUM_AVAILABLE; ++i) {
363 if (key == OUR_TLS_INDEX) {
364 if (TlsGetValue(key)!=NULL)
365 lose("TLS slot assertion failed: fresh slot value is not NULL");
366 TlsSetValue(OUR_TLS_INDEX, (void*)(intptr_t)0xFEEDBAC4);
367 if ((intptr_t)(void*)arch_os_get_current_thread()!=(intptr_t)0xFEEDBAC4)
368 lose("TLS slot assertion failed: TIB layout change detected");
369 TlsSetValue(OUR_TLS_INDEX, NULL);
372 slots[n_slots++]=key;
374 for (i=0; i<n_slots; ++i) {
377 if (key!=OUR_TLS_INDEX) {
378 lose("TLS slot assertion failed: slot 63 is unavailable "
379 "(last TlsAlloc() returned %u)",key);
383 #endif /* LISP_FEATURE_SB_THREAD */
385 int os_number_of_processors = 1;
387 BOOL WINAPI CancelIoEx(HANDLE handle, LPOVERLAPPED overlapped);
388 typeof(CancelIoEx) *ptr_CancelIoEx;
389 BOOL WINAPI CancelSynchronousIo(HANDLE threadHandle);
390 typeof(CancelSynchronousIo) *ptr_CancelSynchronousIo;
392 #define RESOLVE(hmodule,fn) \
394 ptr_##fn = (typeof(ptr_##fn)) \
395 GetProcAddress(hmodule,#fn); \
398 static void resolve_optional_imports()
400 HMODULE kernel32 = GetModuleHandleA("kernel32");
402 RESOLVE(kernel32,CancelIoEx);
403 RESOLVE(kernel32,CancelSynchronousIo);
409 void os_init(char *argv[], char *envp[])
411 SYSTEM_INFO system_info;
412 GetSystemInfo(&system_info);
413 os_vm_page_size = system_info.dwPageSize > BACKEND_PAGE_BYTES?
414 system_info.dwPageSize : BACKEND_PAGE_BYTES;
415 #if defined(LISP_FEATURE_X86)
416 fast_bzero_pointer = fast_bzero_detect;
418 os_number_of_processors = system_info.dwNumberOfProcessors;
420 base_seh_frame = get_seh_frame();
422 resolve_optional_imports();
425 static inline boolean local_thread_stack_address_p(os_vm_address_t address)
427 return this_thread &&
428 (((((u64)address >= (u64)this_thread->os_address) &&
429 ((u64)address < ((u64)this_thread)-THREAD_CSP_PAGE_SIZE))||
430 (((u64)address >= (u64)this_thread->control_stack_start)&&
431 ((u64)address < (u64)this_thread->control_stack_end))));
435 * So we have three fun scenarios here.
437 * First, we could be being called to reserve the memory areas
438 * during initialization (prior to loading the core file).
440 * Second, we could be being called by the GC to commit a page
441 * that has just been decommitted (for easy zero-fill).
443 * Third, we could be being called by create_thread_struct()
444 * in order to create the sundry and various stacks.
446 * The third case is easy to pick out because it passes an
449 * The second case is easy to pick out because it will be for
450 * a range of memory that is MEM_RESERVE rather than MEM_FREE.
452 * The second case is also an easy implement, because we leave
453 * the memory as reserved (since we do lazy commits).
457 os_validate(os_vm_address_t addr, os_vm_size_t len)
459 MEMORY_BASIC_INFORMATION mem_info;
462 /* the simple case first */
464 AVERLAX(VirtualAlloc(addr, len, MEM_RESERVE|MEM_COMMIT, PAGE_EXECUTE_READWRITE));
467 if (!AVERLAX(VirtualQuery(addr, &mem_info, sizeof mem_info)))
470 if ((mem_info.State == MEM_RESERVE) && (mem_info.RegionSize >=len)) {
471 /* It would be correct to return here. However, support for Wine
472 * is beneficial, and Wine has a strange behavior in this
473 * department. It reports all memory below KERNEL32.DLL as
474 * reserved, but disallows MEM_COMMIT.
476 * Let's work around it: reserve the region we need for a second
477 * time. The second reservation is documented to fail on normal NT
478 * family, but it will succeed on Wine if this region is
481 VirtualAlloc(addr, len, MEM_RESERVE, PAGE_EXECUTE_READWRITE);
482 /* If it is wine, the second call has succeded, and now the region
483 * is really reserved. */
487 if (mem_info.State == MEM_RESERVE) {
488 fprintf(stderr, "validation of reserved space too short.\n");
490 /* Oddly, we do not treat this assertion as fatal; hence also the
491 * provision for MEM_RESERVE in the following code, I suppose: */
494 if (!AVERLAX(VirtualAlloc(addr, len, (mem_info.State == MEM_RESERVE)?
495 MEM_COMMIT: MEM_RESERVE, PAGE_EXECUTE_READWRITE)))
502 * For os_invalidate(), we merely decommit the memory rather than
503 * freeing the address space. This loses when freeing per-thread
504 * data and related memory since it leaks address space.
506 * So far the original comment (author unknown). It used to continue as
509 * It's not too lossy, however, since the two scenarios I'm aware of
510 * are fd-stream buffers, which are pooled rather than torched, and
511 * thread information, which I hope to pool (since windows creates
512 * threads at its own whim, and we probably want to be able to have
513 * them callback without funky magic on the part of the user, and
514 * full-on thread allocation is fairly heavyweight).
516 * But: As it turns out, we are no longer content with decommitting
517 * without freeing, and have now grown a second function
518 * os_invalidate_free(), sort of a really_os_invalidate().
520 * As discussed on #lisp, this is not a satisfactory solution, and probably
521 * ought to be rectified in the following way:
523 * - Any cases currently going through the non-freeing version of
524 * os_invalidate() are ultimately meant for zero-filling applications.
525 * Replace those use cases with an os_revalidate_bzero() or similarly
526 * named function, which explicitly takes care of that aspect of
529 * - The remaining uses of os_invalidate should actually free, and once
530 * the above is implemented, we can rename os_invalidate_free back to
531 * just os_invalidate().
533 * So far the new plan, as yet unimplemented. -- DFL
537 os_invalidate(os_vm_address_t addr, os_vm_size_t len)
539 AVERLAX(VirtualFree(addr, len, MEM_DECOMMIT));
543 os_invalidate_free(os_vm_address_t addr, os_vm_size_t len)
545 AVERLAX(VirtualFree(addr, 0, MEM_RELEASE));
549 os_invalidate_free_by_any_address(os_vm_address_t addr, os_vm_size_t len)
551 MEMORY_BASIC_INFORMATION minfo;
552 AVERLAX(VirtualQuery(addr, &minfo, sizeof minfo));
553 AVERLAX(minfo.AllocationBase);
554 AVERLAX(VirtualFree(minfo.AllocationBase, 0, MEM_RELEASE));
557 #define maybe_open_osfhandle _open_osfhandle
558 #define maybe_get_osfhandle _get_osfhandle
562 * os_map() is called to map a chunk of the core file into memory.
564 * Unfortunately, Windows semantics completely screws this up, so
565 * we just add backing store from the swapfile to where the chunk
566 * goes and read it up like a normal file. We could consider using
567 * a lazy read (demand page) setup, but that would mean keeping an
568 * open file pointer for the core indefinately (and be one more
569 * thing to maintain).
573 os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
577 AVER(VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE)||
578 VirtualAlloc(addr, len, MEM_RESERVE|MEM_COMMIT,
579 PAGE_EXECUTE_READWRITE));
581 CRT_AVER_NONNEGATIVE(lseek(fd, offset, SEEK_SET));
583 count = read(fd, addr, len);
584 CRT_AVER( count == len );
589 static DWORD os_protect_modes[8] = {
596 PAGE_EXECUTE_READWRITE,
597 PAGE_EXECUTE_READWRITE,
601 os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
605 DWORD new_prot = os_protect_modes[prot];
606 AVER(VirtualProtect(address, length, new_prot, &old_prot)||
607 (VirtualAlloc(address, length, MEM_COMMIT, new_prot) &&
608 VirtualProtect(address, length, new_prot, &old_prot)));
609 odxprint(misc,"Protecting %p + %p vmaccess %d "
610 "newprot %08x oldprot %08x",
611 address,length,prot,new_prot,old_prot);
614 /* FIXME: Now that FOO_END, rather than FOO_SIZE, is the fundamental
615 * description of a space, we could probably punt this and just do
616 * (FOO_START <= x && x < FOO_END) everywhere it's called. */
618 in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
620 char* beg = (char*)((uword_t)sbeg);
621 char* end = (char*)((uword_t)sbeg) + slen;
622 char* adr = (char*)a;
623 return (adr >= beg && adr < end);
627 is_linkage_table_addr(os_vm_address_t addr)
629 return in_range_p(addr, LINKAGE_TABLE_SPACE_START, LINKAGE_TABLE_SPACE_END);
632 static boolean is_some_thread_local_addr(os_vm_address_t addr);
635 is_valid_lisp_addr(os_vm_address_t addr)
637 if(in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) ||
638 in_range_p(addr, STATIC_SPACE_START , STATIC_SPACE_SIZE) ||
639 in_range_p(addr, DYNAMIC_SPACE_START , dynamic_space_size) ||
640 is_some_thread_local_addr(addr))
645 /* test if an address is within thread-local space */
647 is_thread_local_addr(struct thread* th, os_vm_address_t addr)
649 /* Assuming that this is correct, it would warrant further comment,
650 * I think. Based on what our call site is doing, we have been
651 * tasked to check for the address of a lisp object; not merely any
652 * foreign address within the thread's area. Indeed, this used to
653 * be a check for control and binding stack only, rather than the
654 * full thread "struct". So shouldn't the THREAD_STRUCT_SIZE rather
655 * be (thread_control_stack_size+BINDING_STACK_SIZE) instead? That
656 * would also do away with the LISP_FEATURE_SB_THREAD case. Or does
657 * it simply not matter? --DFL */
658 ptrdiff_t diff = ((char*)th->os_address)-(char*)addr;
659 return diff > (ptrdiff_t)0 && diff < (ptrdiff_t)THREAD_STRUCT_SIZE
660 #ifdef LISP_FEATURE_SB_THREAD
661 && addr != (os_vm_address_t) th->csp_around_foreign_call
667 is_some_thread_local_addr(os_vm_address_t addr)
670 #ifdef LISP_FEATURE_SB_THREAD
672 pthread_mutex_lock(&all_threads_lock);
673 for_each_thread(th) {
674 if(is_thread_local_addr(th,addr)) {
679 pthread_mutex_unlock(&all_threads_lock);
685 /* A tiny bit of interrupt.c state we want our paws on. */
686 extern boolean internal_errors_enabled;
688 extern void exception_handler_wrapper();
691 c_level_backtrace(const char* header, int depth)
697 for (lastseh = get_seh_frame(); lastseh && (lastseh!=(void*)-1);
700 fprintf(stderr, "Backtrace: %s (thread %p)\n", header, this_thread);
701 for (frame = __builtin_frame_address(0); frame; frame=*(void**)frame)
705 fprintf(stderr, "[#%02d]: ebp = 0x%p, ret = 0x%p\n",n,
706 frame, ((void**)frame)[1]);
710 #ifdef LISP_FEATURE_X86
711 #define voidreg(ctxptr,name) ((void*)((ctxptr)->E##name))
713 #define voidreg(ctxptr,name) ((void*)((ctxptr)->R##name))
717 #if defined(LISP_FEATURE_X86)
719 handle_single_step(os_context_t *ctx)
721 if (!single_stepping)
724 /* We are doing a displaced instruction. At least function
725 * end breakpoints use this. */
726 WITH_GC_AT_SAFEPOINTS_ONLY () /* Todo: Is it really gc-unsafe? */
727 restore_breakpoint_from_single_step(ctx);
733 #ifdef LISP_FEATURE_UD2_BREAKPOINTS
734 #define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_ILLEGAL_INSTRUCTION
735 #define TRAP_CODE_WIDTH 2
737 #define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_BREAKPOINT
738 #define TRAP_CODE_WIDTH 1
742 handle_breakpoint_trap(os_context_t *ctx, struct thread* self)
744 #ifdef LISP_FEATURE_UD2_BREAKPOINTS
745 if (((unsigned short *)((ctx->win32_context)->Eip))[0] != 0x0b0f)
749 /* Unlike some other operating systems, Win32 leaves EIP
750 * pointing to the breakpoint instruction. */
751 (*os_context_pc_addr(ctx)) += TRAP_CODE_WIDTH;
753 /* Now EIP points just after the INT3 byte and aims at the
754 * 'kind' value (eg trap_Cerror). */
755 unsigned trap = *(unsigned char *)(*os_context_pc_addr(ctx));
757 #ifdef LISP_FEATURE_SB_THREAD
758 /* Before any other trap handler: gc_safepoint ensures that
759 inner alloc_sap for passing the context won't trap on
761 if (trap == trap_PendingInterrupt) {
762 /* Done everything needed for this trap, except EIP
764 arch_skip_instruction(ctx);
765 thread_interrupted(ctx);
770 /* This is just for info in case the monitor wants to print an
772 access_control_stack_pointer(self) =
773 (lispobj *)*os_context_sp_addr(ctx);
775 WITH_GC_AT_SAFEPOINTS_ONLY() {
776 #if defined(LISP_FEATURE_SB_THREAD)
777 block_blockable_signals(0,&ctx->sigmask);
779 handle_trap(ctx, trap);
780 #if defined(LISP_FEATURE_SB_THREAD)
781 thread_sigmask(SIG_SETMASK,&ctx->sigmask,NULL);
785 /* Done, we're good to go! */
790 handle_access_violation(os_context_t *ctx,
791 EXCEPTION_RECORD *exception_record,
795 CONTEXT *win32_context = ctx->win32_context;
797 #if defined(LISP_FEATURE_X86)
799 "SEGV. ThSap %p, Eip %p, Esp %p, Esi %p, Edi %p, "
800 "Addr %p Access %d\n",
807 exception_record->ExceptionInformation[0]);
810 "SEGV. ThSap %p, Eip %p, Esp %p, Esi %p, Edi %p, "
811 "Addr %p Access %d\n",
818 exception_record->ExceptionInformation[0]);
821 /* Stack: This case takes care of our various stack exhaustion
822 * protect pages (with the notable exception of the control stack!). */
823 if (self && local_thread_stack_address_p(fault_address)) {
824 if (handle_guard_page_triggered(ctx, fault_address))
825 return 0; /* gc safety? */
829 /* Safepoint pages */
830 #ifdef LISP_FEATURE_SB_THREAD
831 if (fault_address == (void *) GC_SAFEPOINT_PAGE_ADDR) {
832 thread_in_lisp_raised(ctx);
836 if ((((u64)fault_address) == ((u64)self->csp_around_foreign_call))){
837 thread_in_safety_transition(ctx);
843 page_index_t index = find_page_index(fault_address);
846 * Now, if the page is supposedly write-protected and this
847 * is a write, tell the gc that it's been hit.
849 if (page_table[index].write_protected) {
850 gencgc_handle_wp_violation(fault_address);
852 AVER(VirtualAlloc(PTR_ALIGN_DOWN(fault_address,os_vm_page_size),
854 MEM_COMMIT, PAGE_EXECUTE_READWRITE));
859 if (fault_address == undefined_alien_address)
862 /* linkage table or a "valid_lisp_addr" outside of dynamic space (?) */
863 if (is_linkage_table_addr(fault_address)
864 || is_valid_lisp_addr(fault_address))
870 /* First use of a new page, lets get some memory for it. */
872 #if defined(LISP_FEATURE_X86)
873 AVER(VirtualAlloc(PTR_ALIGN_DOWN(fault_address,os_vm_page_size),
875 MEM_COMMIT, PAGE_EXECUTE_READWRITE)
876 ||(fprintf(stderr,"Unable to recommit addr %p eip 0x%08lx\n",
877 fault_address, win32_context->Eip) &&
878 (c_level_backtrace("BT",5),
879 fake_foreign_function_call(ctx),
880 lose("Lispy backtrace"),
883 AVER(VirtualAlloc(PTR_ALIGN_DOWN(fault_address,os_vm_page_size),
885 MEM_COMMIT, PAGE_EXECUTE_READWRITE)
886 ||(fprintf(stderr,"Unable to recommit addr %p eip 0x%p\n",
887 fault_address, (void*)win32_context->Rip) &&
888 (c_level_backtrace("BT",5),
889 fake_foreign_function_call(ctx),
890 lose("Lispy backtrace"),
898 signal_internal_error_or_lose(os_context_t *ctx,
899 EXCEPTION_RECORD *exception_record,
903 * If we fall through to here then we need to either forward
904 * the exception to the lisp-side exception handler if it's
905 * set up, or drop to LDB.
908 if (internal_errors_enabled) {
910 lispobj exception_record_sap;
913 /* We're making the somewhat arbitrary decision that having
914 * internal errors enabled means that lisp has sufficient
915 * marbles to be able to handle exceptions, but exceptions
916 * aren't supposed to happen during cold init or reinit
919 #if defined(LISP_FEATURE_SB_THREAD)
920 block_blockable_signals(0,&ctx->sigmask);
922 fake_foreign_function_call(ctx);
924 WITH_GC_AT_SAFEPOINTS_ONLY() {
925 /* Allocate the SAP objects while the "interrupts" are still
927 context_sap = alloc_sap(ctx);
928 exception_record_sap = alloc_sap(exception_record);
929 #if defined(LISP_FEATURE_SB_THREAD)
930 thread_sigmask(SIG_SETMASK, &ctx->sigmask, NULL);
933 /* The exception system doesn't automatically clear pending
934 * exceptions, so we lose as soon as we execute any FP
935 * instruction unless we do this first. */
936 /* Call into lisp to handle things. */
937 funcall2(StaticSymbolFunction(HANDLE_WIN32_EXCEPTION),
939 exception_record_sap);
941 /* If Lisp doesn't nlx, we need to put things back. */
942 undo_fake_foreign_function_call(ctx);
943 #if defined(LISP_FEATURE_SB_THREAD)
944 thread_sigmask(SIG_SETMASK, &ctx->sigmask, NULL);
946 /* FIXME: HANDLE-WIN32-EXCEPTION should be allowed to decline */
950 fprintf(stderr, "Exception Code: 0x%p.\n",
951 (void*)(intptr_t)exception_record->ExceptionCode);
952 fprintf(stderr, "Faulting IP: 0x%p.\n",
953 (void*)(intptr_t)exception_record->ExceptionAddress);
954 if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) {
955 MEMORY_BASIC_INFORMATION mem_info;
957 if (VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
958 fprintf(stderr, "page status: 0x%lx.\n", mem_info.State);
961 fprintf(stderr, "Was writing: %p, where: 0x%p.\n",
962 (void*)exception_record->ExceptionInformation[0],
968 fake_foreign_function_call(ctx);
969 lose("Exception too early in cold init, cannot continue.");
973 * A good explanation of the exception handling semantics is
974 * http://win32assembly.online.fr/Exceptionhandling.html (possibly defunct)
976 * http://www.microsoft.com/msj/0197/exception/exception.aspx
979 EXCEPTION_DISPOSITION
980 handle_exception(EXCEPTION_RECORD *exception_record,
981 struct lisp_exception_frame *exception_frame,
982 CONTEXT *win32_context,
983 void *dispatcher_context)
986 /* Not certain why this should be possible, but let's be safe... */
987 return ExceptionContinueSearch;
989 if (exception_record->ExceptionFlags & (EH_UNWINDING | EH_EXIT_UNWIND)) {
990 /* If we're being unwound, be graceful about it. */
992 /* Undo any dynamic bindings. */
993 unbind_to_here(exception_frame->bindstack_pointer,
994 arch_os_get_current_thread());
995 return ExceptionContinueSearch;
998 DWORD lastError = GetLastError();
999 DWORD lastErrno = errno;
1000 DWORD code = exception_record->ExceptionCode;
1001 struct thread* self = arch_os_get_current_thread();
1003 os_context_t context, *ctx = &context;
1004 context.win32_context = win32_context;
1005 #if defined(LISP_FEATURE_SB_THREAD)
1006 context.sigmask = self ? self->os_thread->blocked_signal_set : 0;
1009 /* For EXCEPTION_ACCESS_VIOLATION only. */
1010 void *fault_address = (void *)exception_record->ExceptionInformation[1];
1013 "SEH: rec %p, ctxptr %p, rip %p, fault %p\n"
1014 "... code %p, rcx %p, fp-tags %p\n\n",
1017 voidreg(win32_context,ip),
1019 (void*)(intptr_t)code,
1020 voidreg(win32_context,cx),
1021 win32_context->FloatSave.TagWord);
1023 /* This function had become unwieldy. Let's cut it down into
1024 * pieces based on the different exception codes. Each exception
1025 * code handler gets the chance to decline by returning non-zero if it
1030 case EXCEPTION_ACCESS_VIOLATION:
1031 rc = handle_access_violation(
1032 ctx, exception_record, fault_address, self);
1035 case SBCL_EXCEPTION_BREAKPOINT:
1036 rc = handle_breakpoint_trap(ctx, self);
1039 #if defined(LISP_FEATURE_X86)
1040 case EXCEPTION_SINGLE_STEP:
1041 rc = handle_single_step(ctx);
1050 /* All else failed, drop through to the lisp-side exception handler. */
1051 signal_internal_error_or_lose(ctx, exception_record, fault_address);
1054 SetLastError(lastError);
1055 return ExceptionContinueExecution;
1059 wos_install_interrupt_handlers(struct lisp_exception_frame *handler)
1061 #ifdef LISP_FEATURE_X86
1062 handler->next_frame = get_seh_frame();
1063 handler->handler = (void*)exception_handler_wrapper;
1064 set_seh_frame(handler);
1066 static int once = 0;
1068 AddVectoredExceptionHandler(1,veh);
1073 * The stubs below are replacements for the windows versions,
1074 * which can -fail- when used in our memory spaces because they
1075 * validate the memory spaces they are passed in a way that
1076 * denies our exception handler a chance to run.
1079 void *memmove(void *dest, const void *src, size_t n)
1083 for (i = 0; i < n; i++) *(((char *)dest)+i) = *(((char *)src)+i);
1085 while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
1090 void *memcpy(void *dest, const void *src, size_t n)
1092 while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
1096 char *dirname(char *path)
1098 static char buf[PATH_MAX + 1];
1099 size_t pathlen = strlen(path);
1102 if (pathlen >= sizeof(buf)) {
1103 lose("Pathname too long in dirname.\n");
1108 for (i = pathlen; i >= 0; --i) {
1109 if (buf[i] == '/' || buf[i] == '\\') {
1118 /* Unofficial but widely used property of console handles: they have
1119 #b11 in two minor bits, opposed to other handles, that are
1120 machine-word-aligned. Properly emulated even on wine.
1122 Console handles are special in many aspects, e.g. they aren't NTDLL
1123 system handles: kernel32 redirects console operations to CSRSS
1124 requests. Using the hack below to distinguish console handles is
1125 justified, as it's the only method that won't hang during
1126 outstanding reads, won't try to lock NT kernel object (if there is
1127 one; console isn't), etc. */
1129 console_handle_p(HANDLE handle)
1131 return (handle != NULL)&&
1132 (handle != INVALID_HANDLE_VALUE)&&
1133 ((((int)(intptr_t)handle)&3)==3);
1136 /* Atomically mark current thread as (probably) doing synchronous I/O
1137 * on handle, if no cancellation is requested yet (and return TRUE),
1138 * otherwise clear thread's I/O cancellation flag and return false.
1141 boolean io_begin_interruptible(HANDLE handle)
1143 /* No point in doing it unless OS supports cancellation from other
1145 if (!ptr_CancelIoEx)
1148 if (!__sync_bool_compare_and_swap(&this_thread->synchronous_io_handle_and_flag,
1150 ResetEvent(this_thread->private_events.events[0]);
1151 this_thread->synchronous_io_handle_and_flag = 0;
1157 /* Unmark current thread as (probably) doing synchronous I/O; if an
1158 * I/O cancellation was requested, postpone it until next
1159 * io_begin_interruptible */
1161 io_end_interruptible(HANDLE handle)
1163 if (!ptr_CancelIoEx)
1165 __sync_bool_compare_and_swap(&this_thread->synchronous_io_handle_and_flag,
1169 /* Documented limit for ReadConsole/WriteConsole is 64K bytes.
1170 Real limit observed on W2K-SP3 is somewhere in between 32KiB and 64Kib...
1172 #define MAX_CONSOLE_TCHARS 16384
1175 win32_write_unicode_console(HANDLE handle, void * buf, int count)
1181 if (nchars>MAX_CONSOLE_TCHARS) nchars = MAX_CONSOLE_TCHARS;
1183 if (!io_begin_interruptible(handle)) {
1187 result = WriteConsoleW(handle,buf,nchars,&written,NULL);
1188 io_end_interruptible(handle);
1198 DWORD err = GetLastError();
1199 odxprint(io,"WriteConsole fails => %u\n", err);
1200 errno = (err==ERROR_OPERATION_ABORTED ? EINTR : EIO);
1208 * It may be unobvious, but (probably) the most straightforward way of
1209 * providing some sane CL:LISTEN semantics for line-mode console
1210 * channel requires _dedicated input thread_.
1212 * LISTEN should return true iff the next (READ-CHAR) won't have to
1213 * wait. As our console may be shared with another process, entirely
1214 * out of our control, looking at the events in PeekConsoleEvent
1215 * result (and searching for #\Return) doesn't cut it.
1217 * We decided that console input thread must do something smarter than
1218 * a bare loop of continuous ReadConsoleW(). On Unix, user experience
1219 * with the terminal is entirely unaffected by the fact that some
1220 * process does (or doesn't) call read(); the situation on MS Windows
1223 * Echo output and line editing present on MS Windows while some
1224 * process is waiting in ReadConsole(); otherwise all input events are
1225 * buffered. If our thread were calling ReadConsole() all the time, it
1226 * would feel like Unix cooked mode.
1228 * But we don't write a Unix emulator here, even if it sometimes feels
1229 * like that; therefore preserving this aspect of console I/O seems a
1232 * LISTEN itself becomes trivial with dedicated input thread, but the
1233 * goal stated above -- provide `native' user experience with blocked
1234 * console -- don't play well with this trivial implementation.
1236 * What's currently implemented is a compromise, looking as something
1237 * in between Unix cooked mode and Win32 line mode.
1239 * 1. As long as no console I/O function is called (incl. CL:LISTEN),
1240 * console looks `blocked': no echo, no line editing.
1242 * 2. (READ-CHAR), (READ-SEQUENCE) and other functions doing real
1243 * input result in the ReadConsole request (in a dedicated thread);
1245 * 3. Once ReadConsole is called, it is not cancelled in the
1246 * middle. In line mode, it returns when <Enter> key is hit (or
1247 * something like that happens). Therefore, if line editing and echo
1248 * output had a chance to happen, console won't look `blocked' until
1249 * the line is entered (even if line input was triggered by
1252 * 4. LISTEN may request ReadConsole too (if no other thread is
1253 * reading the console and no data are queued). It's the only case
1254 * when the console becomes `unblocked' without any actual input
1255 * requested by Lisp code. LISTEN check if there is at least one
1256 * input event in PeekConsole queue; unless there is such an event,
1257 * ReadConsole is not triggered by LISTEN.
1259 * 5. Console-reading Lisp thread now may be interrupted immediately;
1260 * ReadConsole call itself, however, continues until the line is
1265 WCHAR buffer[MAX_CONSOLE_TCHARS];
1267 pthread_mutex_t lock;
1268 pthread_cond_t cond_has_data;
1269 pthread_cond_t cond_has_client;
1271 boolean initialized;
1273 boolean in_progress;
1274 } ttyinput = {.lock = PTHREAD_MUTEX_INITIALIZER};
1277 tty_read_line_server()
1279 pthread_mutex_lock(&ttyinput.lock);
1280 while (ttyinput.handle) {
1284 while (!ttyinput.in_progress)
1285 pthread_cond_wait(&ttyinput.cond_has_client,&ttyinput.lock);
1287 pthread_mutex_unlock(&ttyinput.lock);
1289 ok = ReadConsoleW(ttyinput.handle,
1290 &ttyinput.buffer[ttyinput.tail],
1291 MAX_CONSOLE_TCHARS-ttyinput.tail,
1294 pthread_mutex_lock(&ttyinput.lock);
1297 ttyinput.tail += nchars;
1298 pthread_cond_broadcast(&ttyinput.cond_has_data);
1300 ttyinput.in_progress = 0;
1302 pthread_mutex_unlock(&ttyinput.lock);
1307 tty_maybe_initialize_unlocked(HANDLE handle)
1309 if (!ttyinput.initialized) {
1310 if (!DuplicateHandle(GetCurrentProcess(),handle,
1311 GetCurrentProcess(),&ttyinput.handle,
1312 0,FALSE,DUPLICATE_SAME_ACCESS)) {
1315 pthread_cond_init(&ttyinput.cond_has_data,NULL);
1316 pthread_cond_init(&ttyinput.cond_has_client,NULL);
1317 pthread_create(&ttyinput.thread,NULL,tty_read_line_server,NULL);
1318 ttyinput.initialized = 1;
1324 win32_tty_listen(HANDLE handle)
1329 pthread_mutex_lock(&ttyinput.lock);
1330 if (!tty_maybe_initialize_unlocked(handle))
1333 if (ttyinput.in_progress) {
1336 if (ttyinput.head != ttyinput.tail) {
1339 if (PeekConsoleInput(ttyinput.handle,&ir,1,&nevents) && nevents) {
1340 ttyinput.in_progress = 1;
1341 pthread_cond_broadcast(&ttyinput.cond_has_client);
1345 pthread_mutex_unlock(&ttyinput.lock);
1350 tty_read_line_client(HANDLE handle, void* buf, int count)
1353 int nchars = count / sizeof(WCHAR);
1358 if (nchars>MAX_CONSOLE_TCHARS)
1359 nchars=MAX_CONSOLE_TCHARS;
1361 count = nchars*sizeof(WCHAR);
1363 pthread_mutex_lock(&ttyinput.lock);
1365 if (!tty_maybe_initialize_unlocked(handle)) {
1372 while (ttyinput.head == ttyinput.tail) {
1373 if (!io_begin_interruptible(ttyinput.handle)) {
1374 ttyinput.in_progress = 0;
1379 if (!ttyinput.in_progress) {
1380 /* We are to wait */
1381 ttyinput.in_progress=1;
1382 /* wake console reader */
1383 pthread_cond_broadcast(&ttyinput.cond_has_client);
1385 pthread_cond_wait(&ttyinput.cond_has_data, &ttyinput.lock);
1386 io_end_interruptible(ttyinput.handle);
1389 result = sizeof(WCHAR)*(ttyinput.tail-ttyinput.head);
1390 if (result > count) {
1395 DWORD nch,offset = 0;
1398 memcpy(buf,&ttyinput.buffer[ttyinput.head],count);
1399 ttyinput.head += (result / sizeof(WCHAR));
1400 if (ttyinput.head == ttyinput.tail)
1401 ttyinput.head = ttyinput.tail = 0;
1403 for (nch=0;nch<result/sizeof(WCHAR);++nch) {
1404 if (ubuf[nch]==13) {
1407 ubuf[nch-offset]=ubuf[nch];
1410 result-=offset*sizeof(WCHAR);
1415 ttyinput.head = ttyinput.tail = 0;
1420 pthread_mutex_unlock(&ttyinput.lock);
1425 win32_read_unicode_console(HANDLE handle, void* buf, int count)
1429 result = tty_read_line_client(handle,buf,count);
1434 win32_maybe_interrupt_io(void* thread)
1436 struct thread *th = thread;
1440 * ICBW about all of this. But it seems to me that this procedure is
1441 * a race condition. In theory. One that is hard produce (I can't
1442 * come up with a test case that exploits it), and might only be a bug
1443 * if users are doing weird things with I/O, possibly from FFI. But a
1444 * race is a race, so shouldn't this function and io_end_interruptible
1447 * Here's my thinking:
1449 * A.. <interruptee thread>
1450 * ... stuffs its handle into its structure.
1451 * B.. <interrupter thread>
1452 * ... calls us to wake the thread, finds the handle.
1453 * But just before we actually call CancelSynchronousIo/CancelIoEx,
1454 * something weird happens in the scheduler and the system is
1455 * so extremely busy that the interrupter doesn't get scheduled
1456 * for a while, giving the interruptee lots of time to continue.
1457 * A.. Didn't actually have to block, calls io_end_interruptible (in
1458 * which the handle flag already invalid, but it doesn't care
1459 * about that and still continues).
1460 * ... Proceeds to do unrelated I/O, e.g. goes into FFI code
1461 * (possible, because the CSP page hasn't been armed yet), which
1462 * does I/O from a C library, completely unrelated to SBCL's
1464 * B.. The scheduler gives us time for the interrupter again.
1465 * We call CancelSynchronousIo/CancelIoEx.
1466 * A.. Interruptee gets an expected error in unrelated I/O during FFI.
1467 * Interruptee's C code is unhappy and dies.
1469 * Note that CancelSynchronousIo and CancelIoEx have a rather different
1470 * effect here. In the normal (CancelIoEx) case, we only ever kill
1471 * I/O on the file handle in question. I think we could ask users
1472 * to please not both use Lisp streams (unix-read/write) _and_ FFI code
1473 * on the same file handle in quick succession.
1475 * CancelSynchronousIo seems more dangerous though. Here we interrupt
1476 * I/O on any other handle, even ones we're not actually responsible for,
1477 * because this functions deals with the thread handle, not the file
1481 * - Use mutexes. Somewhere, somehow. Presumably one mutex per
1482 * target thread, acquired around win32_maybe_interrupt_io and
1483 * io_end_interruptible. (That's one mutex use per I/O
1484 * operation, but I can't imagine that compared to our FFI overhead
1485 * that's much of a problem.)
1486 * - In io_end_interruptible, detect that the flag has been
1487 * invalidated, and in that case, do something clever (what?) to
1488 * wait for the imminent gc_stop_the_world, which implicitly tells
1489 * us that win32_maybe_interrupt_io must have exited. Except if
1490 * some _third_ thread is also beginning to call interrupt-thread
1491 * and wake_thread at the same time...?
1492 * - Revert the whole CancelSynchronousIo business after all.
1493 * - I'm wrong and everything is OK already.
1495 if (ptr_CancelIoEx) {
1497 InterlockedExchangePointer((volatile LPVOID *)
1498 &th->synchronous_io_handle_and_flag,
1499 (LPVOID)INVALID_HANDLE_VALUE);
1500 if (h && (h!=INVALID_HANDLE_VALUE)) {
1501 if (console_handle_p(h)) {
1502 pthread_mutex_lock(&ttyinput.lock);
1503 pthread_cond_broadcast(&ttyinput.cond_has_data);
1504 pthread_mutex_unlock(&ttyinput.lock);
1506 if (ptr_CancelSynchronousIo) {
1507 pthread_mutex_lock(&th->os_thread->fiber_lock);
1508 done = ptr_CancelSynchronousIo(th->os_thread->fiber_group->handle);
1509 pthread_mutex_unlock(&th->os_thread->fiber_lock);
1511 return (!!done)|(!!ptr_CancelIoEx(h,NULL));
1517 static const LARGE_INTEGER zero_large_offset = {.QuadPart = 0LL};
1520 win32_unix_write(FDTYPE fd, void * buf, int count)
1523 DWORD written_bytes;
1524 OVERLAPPED overlapped;
1525 struct thread * self = arch_os_get_current_thread();
1527 LARGE_INTEGER file_position;
1531 handle =(HANDLE)maybe_get_osfhandle(fd);
1532 if (console_handle_p(handle))
1533 return win32_write_unicode_console(handle,buf,count);
1535 overlapped.hEvent = self->private_events.events[0];
1536 seekable = SetFilePointerEx(handle,
1541 overlapped.Offset = file_position.LowPart;
1542 overlapped.OffsetHigh = file_position.HighPart;
1544 overlapped.Offset = 0;
1545 overlapped.OffsetHigh = 0;
1547 if (!io_begin_interruptible(handle)) {
1551 ok = WriteFile(handle, buf, count, &written_bytes, &overlapped);
1552 io_end_interruptible(handle);
1555 goto done_something;
1557 DWORD errorCode = GetLastError();
1558 if (errorCode==ERROR_OPERATION_ABORTED) {
1559 GetOverlappedResult(handle,&overlapped,&written_bytes,FALSE);
1563 if (errorCode!=ERROR_IO_PENDING) {
1567 if(WaitForMultipleObjects(2,self->private_events.events,
1568 FALSE,INFINITE) != WAIT_OBJECT_0) {
1574 if (!GetOverlappedResult(handle,&overlapped,&written_bytes,waitInGOR)) {
1575 if (GetLastError()==ERROR_OPERATION_ABORTED) {
1582 goto done_something;
1588 file_position.QuadPart += written_bytes;
1589 SetFilePointerEx(handle,file_position,NULL,FILE_BEGIN);
1591 return written_bytes;
1595 win32_unix_read(FDTYPE fd, void * buf, int count)
1598 OVERLAPPED overlapped = {.Internal=0};
1599 DWORD read_bytes = 0;
1600 struct thread * self = arch_os_get_current_thread();
1601 DWORD errorCode = 0;
1602 BOOL waitInGOR = FALSE;
1604 LARGE_INTEGER file_position;
1607 handle = (HANDLE)maybe_get_osfhandle(fd);
1609 if (console_handle_p(handle))
1610 return win32_read_unicode_console(handle,buf,count);
1612 overlapped.hEvent = self->private_events.events[0];
1613 /* If it has a position, we won't try overlapped */
1614 seekable = SetFilePointerEx(handle,
1619 overlapped.Offset = file_position.LowPart;
1620 overlapped.OffsetHigh = file_position.HighPart;
1622 overlapped.Offset = 0;
1623 overlapped.OffsetHigh = 0;
1625 if (!io_begin_interruptible(handle)) {
1629 ok = ReadFile(handle,buf,count,&read_bytes, &overlapped);
1630 io_end_interruptible(handle);
1633 goto done_something;
1635 errorCode = GetLastError();
1636 if (errorCode == ERROR_HANDLE_EOF ||
1637 errorCode == ERROR_BROKEN_PIPE ||
1638 errorCode == ERROR_NETNAME_DELETED) {
1640 goto done_something;
1642 if (errorCode==ERROR_OPERATION_ABORTED) {
1643 GetOverlappedResult(handle,&overlapped,&read_bytes,FALSE);
1647 if (errorCode!=ERROR_IO_PENDING) {
1648 /* is it some _real_ error? */
1653 if( (ret = WaitForMultipleObjects(2,self->private_events.events,
1654 FALSE,INFINITE)) != WAIT_OBJECT_0) {
1657 /* Waiting for IO only */
1661 ok = GetOverlappedResult(handle,&overlapped,&read_bytes,waitInGOR);
1663 errorCode = GetLastError();
1664 if (errorCode == ERROR_HANDLE_EOF ||
1665 errorCode == ERROR_BROKEN_PIPE ||
1666 errorCode == ERROR_NETNAME_DELETED) {
1668 goto done_something;
1670 if (errorCode == ERROR_OPERATION_ABORTED)
1671 errno = EINTR; /* that's it. */
1673 errno = EIO; /* something unspecific */
1677 goto done_something;
1682 file_position.QuadPart += read_bytes;
1683 SetFilePointerEx(handle,file_position,NULL,FILE_BEGIN);
1688 /* This is a manually-maintained version of ldso_stubs.S. */
1690 void __stdcall RtlUnwind(void *, void *, void *, void *); /* I don't have winternl.h */
1694 LARGE_INTEGER la = {{0}};
1698 SetHandleInformation(0, 0, 0);
1699 GetHandleInformation(0, 0);
1700 getsockopt(0, 0, 0, 0, 0);
1701 FlushConsoleInputBuffer(0);
1702 FormatMessageA(0, 0, 0, 0, 0, 0, 0);
1706 GetConsoleOutputCP();
1707 GetCurrentProcess();
1708 GetExitCodeProcess(0, 0);
1711 GetProcAddress(0, 0);
1712 GetProcessTimes(0, 0, 0, 0, 0);
1713 GetSystemTimeAsFileTime(0);
1716 PeekConsoleInput(0, 0, 0, 0);
1717 PeekNamedPipe(0, 0, 0, 0, 0, 0);
1718 ReadFile(0, 0, 0, 0, 0);
1720 WriteFile(0, 0, 0, 0, 0);
1722 _open_osfhandle(0, 0);
1731 RtlUnwind(0, 0, 0, 0);
1732 MapViewOfFile(0,0,0,0,0);
1734 FlushViewOfFile(0,0);
1735 SetFilePointerEx(0, la, 0, 0);
1736 DuplicateHandle(0, 0, 0, 0, 0, 0, 0);
1737 #ifndef LISP_FEATURE_SB_UNICODE
1738 CreateDirectoryA(0,0);
1739 CreateFileMappingA(0,0,0,0,0,0);
1740 CreateFileA(0,0,0,0,0,0,0);
1741 GetComputerNameA(0, 0);
1742 GetCurrentDirectoryA(0,0);
1743 GetEnvironmentVariableA(0, 0, 0);
1744 GetFileAttributesA(0);
1747 SHGetFolderPathA(0, 0, 0, 0, 0);
1748 SetCurrentDirectoryA(0);
1749 SetEnvironmentVariableA(0, 0);
1751 CreateDirectoryW(0,0);
1752 CreateFileMappingW(0,0,0,0,0,0);
1753 CreateFileW(0,0,0,0,0,0,0);
1754 FormatMessageW(0, 0, 0, 0, 0, 0, 0);
1755 GetComputerNameW(0, 0);
1756 GetCurrentDirectoryW(0,0);
1757 GetEnvironmentVariableW(0, 0, 0);
1758 GetFileAttributesW(0);
1761 SHGetFolderPathW(0, 0, 0, 0, 0);
1762 SetCurrentDirectoryW(0);
1763 SetEnvironmentVariableW(0, 0);
1769 os_get_runtime_executable_path(int external)
1771 char path[MAX_PATH + 1];
1772 DWORD bufsize = sizeof(path);
1775 if ((size = GetModuleFileNameA(NULL, path, bufsize)) == 0)
1777 else if (size == bufsize && GetLastError() == ERROR_INSUFFICIENT_BUFFER)
1780 return copied_string(path);
1783 #ifdef LISP_FEATURE_SB_THREAD
1786 win32_wait_object_or_signal(HANDLE waitFor)
1788 struct thread * self = arch_os_get_current_thread();
1790 handles[0] = waitFor;
1791 handles[1] = self->private_events.events[1];
1793 WaitForMultipleObjects(2,handles, FALSE,INFINITE);
1797 * Portability glue for win32 waitable timers.
1799 * One may ask: Why is there a wrapper in C when the calls are so
1800 * obvious that Lisp could do them directly (as it did on Windows)?
1802 * But the answer is that on POSIX platforms, we now emulate the win32
1803 * calls and hide that emulation behind this os_* abstraction.
1808 return CreateWaitableTimer(0, 0, 0);
1812 os_wait_for_wtimer(HANDLE handle)
1814 return win32_wait_object_or_signal(handle);
1818 os_close_wtimer(HANDLE handle)
1820 CloseHandle(handle);
1824 os_set_wtimer(HANDLE handle, int sec, int nsec)
1826 /* in units of 100ns, i.e. 0.1us. Negative for relative semantics. */
1828 = -(((long long) sec) * 10000000
1829 + ((long long) nsec + 99) / 100);
1830 SetWaitableTimer(handle, (LARGE_INTEGER*) &dueTime, 0, 0, 0, 0);
1834 os_cancel_wtimer(HANDLE handle)
1836 CancelWaitableTimer(handle);