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)
272 /* Permit loads from GC_SAFEPOINT_PAGE_ADDR (NB page state change is
273 * "synchronized" with the memory region content/availability --
274 * e.g. you won't see other CPU flushing buffered writes after WP --
275 * but there is some window when other thread _seem_ to trap AFTER
276 * access is granted. You may think of it something like "OS enters
277 * SEH handler too slowly" -- what's important is there's no implicit
278 * synchronization between VirtualProtect caller and other thread's
279 * SEH handler, hence no ordering of events. VirtualProtect is
280 * implicitly synchronized with protected memory contents (only).
282 * The last fact may be potentially used with many benefits e.g. for
283 * foreign call speed, but we don't use it for now: almost the only
284 * fact relevant to the current signalling protocol is "sooner or
285 * later everyone will trap [everyone will stop trapping]".
287 * An interesting source on page-protection-based inter-thread
288 * communication is a well-known paper by Dave Dice, Hui Huang,
289 * Mingyao Yang: ``Asymmetric Dekker Synchronization''. Last time
290 * I checked it was available at
291 * http://home.comcast.net/~pjbishop/Dave/Asymmetric-Dekker-Synchronization.txt
296 AVER(VirtualProtect((void*) GC_SAFEPOINT_PAGE_ADDR, sizeof(lispobj),
297 PAGE_READWRITE, &oldProt));
303 AVER(VirtualProtect((void*) GC_SAFEPOINT_PAGE_ADDR, sizeof(lispobj),
304 PAGE_NOACCESS, &oldProt));
309 #if defined(LISP_FEATURE_SB_THREAD)
310 /* We want to get a slot in TIB that (1) is available at constant
311 offset, (2) is our private property, so libraries wouldn't legally
312 override it, (3) contains something predefined for threads created
315 Low 64 TLS slots are adressable directly, starting with
316 FS:[#xE10]. When SBCL runtime is initialized, some of the low slots
317 may be already in use by its prerequisite DLLs, as DllMain()s and
318 TLS callbacks have been called already. But slot 63 is unlikely to
319 be reached at this point: one slot per DLL that needs it is the
320 common practice, and many system DLLs use predefined TIB-based
321 areas outside conventional TLS storage and don't need TLS slots.
322 With our current dependencies, even slot 2 is observed to be free
323 (as of WinXP and wine).
325 Now we'll call TlsAlloc() repeatedly until slot 63 is officially
326 assigned to us, then TlsFree() all other slots for normal use. TLS
327 slot 63, alias FS:[#.(+ #xE10 (* 4 63))], now belongs to us.
329 To summarize, let's list the assumptions we make:
331 - TIB, which is FS segment base, contains first 64 TLS slots at the
332 offset #xE10 (i.e. TIB layout compatibility);
333 - TLS slots are allocated from lower to higher ones;
334 - All libraries together with CRT startup have not requested 64
337 All these assumptions together don't seem to be less warranted than
338 the availability of TIB arbitrary data slot for our use. There are
339 some more reasons to prefer slot 63 over TIB arbitrary data: (1) if
340 our assumptions for slot 63 are violated, it will be detected at
341 startup instead of causing some system-specific unreproducible
342 problems afterwards, depending on OS and loaded foreign libraries;
343 (2) if getting slot 63 reliably with our current approach will
344 become impossible for some future Windows version, we can add TLS
345 callback directory to SBCL binary; main image TLS callback is
346 started before _any_ TLS slot is allocated by libraries, and
347 some C compiler vendors rely on this fact. */
351 #ifdef LISP_FEATURE_X86
352 DWORD slots[TLS_MINIMUM_AVAILABLE];
355 for (i=0; i<TLS_MINIMUM_AVAILABLE; ++i) {
357 if (key == OUR_TLS_INDEX) {
358 if (TlsGetValue(key)!=NULL)
359 lose("TLS slot assertion failed: fresh slot value is not NULL");
360 TlsSetValue(OUR_TLS_INDEX, (void*)(intptr_t)0xFEEDBAC4);
361 if ((intptr_t)(void*)arch_os_get_current_thread()!=(intptr_t)0xFEEDBAC4)
362 lose("TLS slot assertion failed: TIB layout change detected");
363 TlsSetValue(OUR_TLS_INDEX, NULL);
366 slots[n_slots++]=key;
368 for (i=0; i<n_slots; ++i) {
371 if (key!=OUR_TLS_INDEX) {
372 lose("TLS slot assertion failed: slot 63 is unavailable "
373 "(last TlsAlloc() returned %u)",key);
377 #endif /* LISP_FEATURE_SB_THREAD */
379 int os_number_of_processors = 1;
381 BOOL WINAPI CancelIoEx(HANDLE handle, LPOVERLAPPED overlapped);
382 typeof(CancelIoEx) *ptr_CancelIoEx;
383 BOOL WINAPI CancelSynchronousIo(HANDLE threadHandle);
384 typeof(CancelSynchronousIo) *ptr_CancelSynchronousIo;
386 #define RESOLVE(hmodule,fn) \
388 ptr_##fn = (typeof(ptr_##fn)) \
389 GetProcAddress(hmodule,#fn); \
392 static void resolve_optional_imports()
394 HMODULE kernel32 = GetModuleHandleA("kernel32");
396 RESOLVE(kernel32,CancelIoEx);
397 RESOLVE(kernel32,CancelSynchronousIo);
403 void os_init(char *argv[], char *envp[])
405 SYSTEM_INFO system_info;
406 GetSystemInfo(&system_info);
407 os_vm_page_size = system_info.dwPageSize > BACKEND_PAGE_BYTES?
408 system_info.dwPageSize : BACKEND_PAGE_BYTES;
409 #if defined(LISP_FEATURE_X86)
410 fast_bzero_pointer = fast_bzero_detect;
412 os_number_of_processors = system_info.dwNumberOfProcessors;
414 base_seh_frame = get_seh_frame();
416 resolve_optional_imports();
419 static inline boolean local_thread_stack_address_p(os_vm_address_t address)
421 return this_thread &&
422 (((((u64)address >= (u64)this_thread->os_address) &&
423 ((u64)address < ((u64)this_thread)-THREAD_CSP_PAGE_SIZE))||
424 (((u64)address >= (u64)this_thread->control_stack_start)&&
425 ((u64)address < (u64)this_thread->control_stack_end))));
429 * So we have three fun scenarios here.
431 * First, we could be being called to reserve the memory areas
432 * during initialization (prior to loading the core file).
434 * Second, we could be being called by the GC to commit a page
435 * that has just been decommitted (for easy zero-fill).
437 * Third, we could be being called by create_thread_struct()
438 * in order to create the sundry and various stacks.
440 * The third case is easy to pick out because it passes an
443 * The second case is easy to pick out because it will be for
444 * a range of memory that is MEM_RESERVE rather than MEM_FREE.
446 * The second case is also an easy implement, because we leave
447 * the memory as reserved (since we do lazy commits).
451 os_validate(os_vm_address_t addr, os_vm_size_t len)
453 MEMORY_BASIC_INFORMATION mem_info;
456 /* the simple case first */
458 AVERLAX(VirtualAlloc(addr, len, MEM_RESERVE|MEM_COMMIT, PAGE_EXECUTE_READWRITE));
461 if (!AVERLAX(VirtualQuery(addr, &mem_info, sizeof mem_info)))
464 if ((mem_info.State == MEM_RESERVE) && (mem_info.RegionSize >=len)) {
465 /* It would be correct to return here. However, support for Wine
466 * is beneficial, and Wine has a strange behavior in this
467 * department. It reports all memory below KERNEL32.DLL as
468 * reserved, but disallows MEM_COMMIT.
470 * Let's work around it: reserve the region we need for a second
471 * time. The second reservation is documented to fail on normal NT
472 * family, but it will succeed on Wine if this region is
475 VirtualAlloc(addr, len, MEM_RESERVE, PAGE_EXECUTE_READWRITE);
476 /* If it is wine, the second call has succeded, and now the region
477 * is really reserved. */
481 if (mem_info.State == MEM_RESERVE) {
482 fprintf(stderr, "validation of reserved space too short.\n");
484 /* Oddly, we do not treat this assertion as fatal; hence also the
485 * provision for MEM_RESERVE in the following code, I suppose: */
488 if (!AVERLAX(VirtualAlloc(addr, len, (mem_info.State == MEM_RESERVE)?
489 MEM_COMMIT: MEM_RESERVE, PAGE_EXECUTE_READWRITE)))
496 * For os_invalidate(), we merely decommit the memory rather than
497 * freeing the address space. This loses when freeing per-thread
498 * data and related memory since it leaks address space.
500 * So far the original comment (author unknown). It used to continue as
503 * It's not too lossy, however, since the two scenarios I'm aware of
504 * are fd-stream buffers, which are pooled rather than torched, and
505 * thread information, which I hope to pool (since windows creates
506 * threads at its own whim, and we probably want to be able to have
507 * them callback without funky magic on the part of the user, and
508 * full-on thread allocation is fairly heavyweight).
510 * But: As it turns out, we are no longer content with decommitting
511 * without freeing, and have now grown a second function
512 * os_invalidate_free(), sort of a really_os_invalidate().
514 * As discussed on #lisp, this is not a satisfactory solution, and probably
515 * ought to be rectified in the following way:
517 * - Any cases currently going through the non-freeing version of
518 * os_invalidate() are ultimately meant for zero-filling applications.
519 * Replace those use cases with an os_revalidate_bzero() or similarly
520 * named function, which explicitly takes care of that aspect of
523 * - The remaining uses of os_invalidate should actually free, and once
524 * the above is implemented, we can rename os_invalidate_free back to
525 * just os_invalidate().
527 * So far the new plan, as yet unimplemented. -- DFL
531 os_invalidate(os_vm_address_t addr, os_vm_size_t len)
533 AVERLAX(VirtualFree(addr, len, MEM_DECOMMIT));
537 os_invalidate_free(os_vm_address_t addr, os_vm_size_t len)
539 AVERLAX(VirtualFree(addr, 0, MEM_RELEASE));
543 os_invalidate_free_by_any_address(os_vm_address_t addr, os_vm_size_t len)
545 MEMORY_BASIC_INFORMATION minfo;
546 AVERLAX(VirtualQuery(addr, &minfo, sizeof minfo));
547 AVERLAX(minfo.AllocationBase);
548 AVERLAX(VirtualFree(minfo.AllocationBase, 0, MEM_RELEASE));
551 #define maybe_open_osfhandle _open_osfhandle
552 #define maybe_get_osfhandle _get_osfhandle
556 * os_map() is called to map a chunk of the core file into memory.
558 * Unfortunately, Windows semantics completely screws this up, so
559 * we just add backing store from the swapfile to where the chunk
560 * goes and read it up like a normal file. We could consider using
561 * a lazy read (demand page) setup, but that would mean keeping an
562 * open file pointer for the core indefinately (and be one more
563 * thing to maintain).
567 os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
571 AVER(VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE)||
572 VirtualAlloc(addr, len, MEM_RESERVE|MEM_COMMIT,
573 PAGE_EXECUTE_READWRITE));
575 CRT_AVER_NONNEGATIVE(lseek(fd, offset, SEEK_SET));
577 count = read(fd, addr, len);
578 CRT_AVER( count == len );
583 static DWORD os_protect_modes[8] = {
590 PAGE_EXECUTE_READWRITE,
591 PAGE_EXECUTE_READWRITE,
595 os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
599 DWORD new_prot = os_protect_modes[prot];
600 AVER(VirtualProtect(address, length, new_prot, &old_prot)||
601 (VirtualAlloc(address, length, MEM_COMMIT, new_prot) &&
602 VirtualProtect(address, length, new_prot, &old_prot)));
603 odxprint(misc,"Protecting %p + %p vmaccess %d "
604 "newprot %08x oldprot %08x",
605 address,length,prot,new_prot,old_prot);
608 /* FIXME: Now that FOO_END, rather than FOO_SIZE, is the fundamental
609 * description of a space, we could probably punt this and just do
610 * (FOO_START <= x && x < FOO_END) everywhere it's called. */
612 in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
614 char* beg = (char*)((uword_t)sbeg);
615 char* end = (char*)((uword_t)sbeg) + slen;
616 char* adr = (char*)a;
617 return (adr >= beg && adr < end);
621 is_linkage_table_addr(os_vm_address_t addr)
623 return in_range_p(addr, LINKAGE_TABLE_SPACE_START, LINKAGE_TABLE_SPACE_END);
626 static boolean is_some_thread_local_addr(os_vm_address_t addr);
629 is_valid_lisp_addr(os_vm_address_t addr)
631 if(in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) ||
632 in_range_p(addr, STATIC_SPACE_START , STATIC_SPACE_SIZE) ||
633 in_range_p(addr, DYNAMIC_SPACE_START , dynamic_space_size) ||
634 is_some_thread_local_addr(addr))
639 /* test if an address is within thread-local space */
641 is_thread_local_addr(struct thread* th, os_vm_address_t addr)
643 /* Assuming that this is correct, it would warrant further comment,
644 * I think. Based on what our call site is doing, we have been
645 * tasked to check for the address of a lisp object; not merely any
646 * foreign address within the thread's area. Indeed, this used to
647 * be a check for control and binding stack only, rather than the
648 * full thread "struct". So shouldn't the THREAD_STRUCT_SIZE rather
649 * be (thread_control_stack_size+BINDING_STACK_SIZE) instead? That
650 * would also do away with the LISP_FEATURE_SB_THREAD case. Or does
651 * it simply not matter? --DFL */
652 ptrdiff_t diff = ((char*)th->os_address)-(char*)addr;
653 return diff > (ptrdiff_t)0 && diff < (ptrdiff_t)THREAD_STRUCT_SIZE
654 #ifdef LISP_FEATURE_SB_THREAD
655 && addr != (os_vm_address_t) th->csp_around_foreign_call
661 is_some_thread_local_addr(os_vm_address_t addr)
664 #ifdef LISP_FEATURE_SB_THREAD
666 pthread_mutex_lock(&all_threads_lock);
667 for_each_thread(th) {
668 if(is_thread_local_addr(th,addr)) {
673 pthread_mutex_unlock(&all_threads_lock);
679 /* A tiny bit of interrupt.c state we want our paws on. */
680 extern boolean internal_errors_enabled;
682 extern void exception_handler_wrapper();
685 c_level_backtrace(const char* header, int depth)
691 for (lastseh = get_seh_frame(); lastseh && (lastseh!=(void*)-1);
694 fprintf(stderr, "Backtrace: %s (thread %p)\n", header, this_thread);
695 for (frame = __builtin_frame_address(0); frame; frame=*(void**)frame)
699 fprintf(stderr, "[#%02d]: ebp = 0x%p, ret = 0x%p\n",n,
700 frame, ((void**)frame)[1]);
704 #ifdef LISP_FEATURE_X86
705 #define voidreg(ctxptr,name) ((void*)((ctxptr)->E##name))
707 #define voidreg(ctxptr,name) ((void*)((ctxptr)->R##name))
711 #if defined(LISP_FEATURE_X86)
713 handle_single_step(os_context_t *ctx)
715 if (!single_stepping)
718 /* We are doing a displaced instruction. At least function
719 * end breakpoints use this. */
720 WITH_GC_AT_SAFEPOINTS_ONLY () /* Todo: Is it really gc-unsafe? */
721 restore_breakpoint_from_single_step(ctx);
727 #ifdef LISP_FEATURE_UD2_BREAKPOINTS
728 #define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_ILLEGAL_INSTRUCTION
729 #define TRAP_CODE_WIDTH 2
731 #define SBCL_EXCEPTION_BREAKPOINT EXCEPTION_BREAKPOINT
732 #define TRAP_CODE_WIDTH 1
736 handle_breakpoint_trap(os_context_t *ctx, struct thread* self)
738 #ifdef LISP_FEATURE_UD2_BREAKPOINTS
739 if (((unsigned short *)((ctx->win32_context)->Eip))[0] != 0x0b0f)
743 /* Unlike some other operating systems, Win32 leaves EIP
744 * pointing to the breakpoint instruction. */
745 (*os_context_pc_addr(ctx)) += TRAP_CODE_WIDTH;
747 /* Now EIP points just after the INT3 byte and aims at the
748 * 'kind' value (eg trap_Cerror). */
749 unsigned trap = *(unsigned char *)(*os_context_pc_addr(ctx));
751 #ifdef LISP_FEATURE_SB_THREAD
752 /* Before any other trap handler: gc_safepoint ensures that
753 inner alloc_sap for passing the context won't trap on
755 if (trap == trap_PendingInterrupt) {
756 /* Done everything needed for this trap, except EIP
758 arch_skip_instruction(ctx);
759 thread_interrupted(ctx);
764 /* This is just for info in case the monitor wants to print an
766 access_control_stack_pointer(self) =
767 (lispobj *)*os_context_sp_addr(ctx);
769 WITH_GC_AT_SAFEPOINTS_ONLY() {
770 #if defined(LISP_FEATURE_SB_THREAD)
771 block_blockable_signals(0,&ctx->sigmask);
773 handle_trap(ctx, trap);
774 #if defined(LISP_FEATURE_SB_THREAD)
775 thread_sigmask(SIG_SETMASK,&ctx->sigmask,NULL);
779 /* Done, we're good to go! */
784 handle_access_violation(os_context_t *ctx,
785 EXCEPTION_RECORD *exception_record,
789 CONTEXT *win32_context = ctx->win32_context;
791 #if defined(LISP_FEATURE_X86)
793 "SEGV. ThSap %p, Eip %p, Esp %p, Esi %p, Edi %p, "
794 "Addr %p Access %d\n",
801 exception_record->ExceptionInformation[0]);
804 "SEGV. ThSap %p, Eip %p, Esp %p, Esi %p, Edi %p, "
805 "Addr %p Access %d\n",
812 exception_record->ExceptionInformation[0]);
815 /* Stack: This case takes care of our various stack exhaustion
816 * protect pages (with the notable exception of the control stack!). */
817 if (self && local_thread_stack_address_p(fault_address)) {
818 if (handle_guard_page_triggered(ctx, fault_address))
819 return 0; /* gc safety? */
823 /* Safepoint pages */
824 #ifdef LISP_FEATURE_SB_THREAD
825 if (fault_address == (void *) GC_SAFEPOINT_PAGE_ADDR) {
826 thread_in_lisp_raised(ctx);
830 if ((((u64)fault_address) == ((u64)self->csp_around_foreign_call))){
831 thread_in_safety_transition(ctx);
837 page_index_t index = find_page_index(fault_address);
840 * Now, if the page is supposedly write-protected and this
841 * is a write, tell the gc that it's been hit.
843 if (page_table[index].write_protected) {
844 gencgc_handle_wp_violation(fault_address);
846 AVER(VirtualAlloc(PTR_ALIGN_DOWN(fault_address,os_vm_page_size),
848 MEM_COMMIT, PAGE_EXECUTE_READWRITE));
853 if (fault_address == undefined_alien_address)
856 /* linkage table or a "valid_lisp_addr" outside of dynamic space (?) */
857 if (is_linkage_table_addr(fault_address)
858 || is_valid_lisp_addr(fault_address))
864 /* First use of a new page, lets get some memory for it. */
866 #if defined(LISP_FEATURE_X86)
867 AVER(VirtualAlloc(PTR_ALIGN_DOWN(fault_address,os_vm_page_size),
869 MEM_COMMIT, PAGE_EXECUTE_READWRITE)
870 ||(fprintf(stderr,"Unable to recommit addr %p eip 0x%08lx\n",
871 fault_address, win32_context->Eip) &&
872 (c_level_backtrace("BT",5),
873 fake_foreign_function_call(ctx),
874 lose("Lispy backtrace"),
877 AVER(VirtualAlloc(PTR_ALIGN_DOWN(fault_address,os_vm_page_size),
879 MEM_COMMIT, PAGE_EXECUTE_READWRITE)
880 ||(fprintf(stderr,"Unable to recommit addr %p eip 0x%p\n",
881 fault_address, (void*)win32_context->Rip) &&
882 (c_level_backtrace("BT",5),
883 fake_foreign_function_call(ctx),
884 lose("Lispy backtrace"),
892 signal_internal_error_or_lose(os_context_t *ctx,
893 EXCEPTION_RECORD *exception_record,
897 * If we fall through to here then we need to either forward
898 * the exception to the lisp-side exception handler if it's
899 * set up, or drop to LDB.
902 if (internal_errors_enabled) {
904 lispobj exception_record_sap;
907 /* We're making the somewhat arbitrary decision that having
908 * internal errors enabled means that lisp has sufficient
909 * marbles to be able to handle exceptions, but exceptions
910 * aren't supposed to happen during cold init or reinit
913 #if defined(LISP_FEATURE_SB_THREAD)
914 block_blockable_signals(0,&ctx->sigmask);
916 fake_foreign_function_call(ctx);
918 WITH_GC_AT_SAFEPOINTS_ONLY() {
919 /* Allocate the SAP objects while the "interrupts" are still
921 context_sap = alloc_sap(ctx);
922 exception_record_sap = alloc_sap(exception_record);
923 #if defined(LISP_FEATURE_SB_THREAD)
924 thread_sigmask(SIG_SETMASK, &ctx->sigmask, NULL);
927 /* The exception system doesn't automatically clear pending
928 * exceptions, so we lose as soon as we execute any FP
929 * instruction unless we do this first. */
930 /* Call into lisp to handle things. */
931 funcall2(StaticSymbolFunction(HANDLE_WIN32_EXCEPTION),
933 exception_record_sap);
935 /* If Lisp doesn't nlx, we need to put things back. */
936 undo_fake_foreign_function_call(ctx);
937 #if defined(LISP_FEATURE_SB_THREAD)
938 thread_sigmask(SIG_SETMASK, &ctx->sigmask, NULL);
940 /* FIXME: HANDLE-WIN32-EXCEPTION should be allowed to decline */
944 fprintf(stderr, "Exception Code: 0x%p.\n",
945 (void*)(intptr_t)exception_record->ExceptionCode);
946 fprintf(stderr, "Faulting IP: 0x%p.\n",
947 (void*)(intptr_t)exception_record->ExceptionAddress);
948 if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) {
949 MEMORY_BASIC_INFORMATION mem_info;
951 if (VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
952 fprintf(stderr, "page status: 0x%lx.\n", mem_info.State);
955 fprintf(stderr, "Was writing: %p, where: 0x%p.\n",
956 (void*)exception_record->ExceptionInformation[0],
962 fake_foreign_function_call(ctx);
963 lose("Exception too early in cold init, cannot continue.");
967 * A good explanation of the exception handling semantics is
968 * http://win32assembly.online.fr/Exceptionhandling.html (possibly defunct)
970 * http://www.microsoft.com/msj/0197/exception/exception.aspx
973 EXCEPTION_DISPOSITION
974 handle_exception(EXCEPTION_RECORD *exception_record,
975 struct lisp_exception_frame *exception_frame,
976 CONTEXT *win32_context,
977 void *dispatcher_context)
980 /* Not certain why this should be possible, but let's be safe... */
981 return ExceptionContinueSearch;
983 if (exception_record->ExceptionFlags & (EH_UNWINDING | EH_EXIT_UNWIND)) {
984 /* If we're being unwound, be graceful about it. */
986 /* Undo any dynamic bindings. */
987 unbind_to_here(exception_frame->bindstack_pointer,
988 arch_os_get_current_thread());
989 return ExceptionContinueSearch;
992 DWORD lastError = GetLastError();
993 DWORD lastErrno = errno;
994 DWORD code = exception_record->ExceptionCode;
995 struct thread* self = arch_os_get_current_thread();
997 os_context_t context, *ctx = &context;
998 context.win32_context = win32_context;
999 #if defined(LISP_FEATURE_SB_THREAD)
1000 context.sigmask = self ? self->os_thread->blocked_signal_set : 0;
1003 /* For EXCEPTION_ACCESS_VIOLATION only. */
1004 void *fault_address = (void *)exception_record->ExceptionInformation[1];
1007 "SEH: rec %p, ctxptr %p, rip %p, fault %p\n"
1008 "... code %p, rcx %p, fp-tags %p\n\n",
1011 voidreg(win32_context,ip),
1013 (void*)(intptr_t)code,
1014 voidreg(win32_context,cx),
1015 win32_context->FloatSave.TagWord);
1017 /* This function had become unwieldy. Let's cut it down into
1018 * pieces based on the different exception codes. Each exception
1019 * code handler gets the chance to decline by returning non-zero if it
1024 case EXCEPTION_ACCESS_VIOLATION:
1025 rc = handle_access_violation(
1026 ctx, exception_record, fault_address, self);
1029 case SBCL_EXCEPTION_BREAKPOINT:
1030 rc = handle_breakpoint_trap(ctx, self);
1033 #if defined(LISP_FEATURE_X86)
1034 case EXCEPTION_SINGLE_STEP:
1035 rc = handle_single_step(ctx);
1044 /* All else failed, drop through to the lisp-side exception handler. */
1045 signal_internal_error_or_lose(ctx, exception_record, fault_address);
1048 SetLastError(lastError);
1049 return ExceptionContinueExecution;
1053 wos_install_interrupt_handlers(struct lisp_exception_frame *handler)
1055 #ifdef LISP_FEATURE_X86
1056 handler->next_frame = get_seh_frame();
1057 handler->handler = (void*)exception_handler_wrapper;
1058 set_seh_frame(handler);
1060 static int once = 0;
1062 AddVectoredExceptionHandler(1,veh);
1067 * The stubs below are replacements for the windows versions,
1068 * which can -fail- when used in our memory spaces because they
1069 * validate the memory spaces they are passed in a way that
1070 * denies our exception handler a chance to run.
1073 void *memmove(void *dest, const void *src, size_t n)
1077 for (i = 0; i < n; i++) *(((char *)dest)+i) = *(((char *)src)+i);
1079 while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
1084 void *memcpy(void *dest, const void *src, size_t n)
1086 while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
1090 char *dirname(char *path)
1092 static char buf[PATH_MAX + 1];
1093 size_t pathlen = strlen(path);
1096 if (pathlen >= sizeof(buf)) {
1097 lose("Pathname too long in dirname.\n");
1102 for (i = pathlen; i >= 0; --i) {
1103 if (buf[i] == '/' || buf[i] == '\\') {
1112 /* Unofficial but widely used property of console handles: they have
1113 #b11 in two minor bits, opposed to other handles, that are
1114 machine-word-aligned. Properly emulated even on wine.
1116 Console handles are special in many aspects, e.g. they aren't NTDLL
1117 system handles: kernel32 redirects console operations to CSRSS
1118 requests. Using the hack below to distinguish console handles is
1119 justified, as it's the only method that won't hang during
1120 outstanding reads, won't try to lock NT kernel object (if there is
1121 one; console isn't), etc. */
1123 console_handle_p(HANDLE handle)
1125 return (handle != NULL)&&
1126 (handle != INVALID_HANDLE_VALUE)&&
1127 ((((int)(intptr_t)handle)&3)==3);
1130 /* Atomically mark current thread as (probably) doing synchronous I/O
1131 * on handle, if no cancellation is requested yet (and return TRUE),
1132 * otherwise clear thread's I/O cancellation flag and return false.
1135 boolean io_begin_interruptible(HANDLE handle)
1137 /* No point in doing it unless OS supports cancellation from other
1139 if (!ptr_CancelIoEx)
1142 if (!__sync_bool_compare_and_swap(&this_thread->synchronous_io_handle_and_flag,
1144 ResetEvent(this_thread->private_events.events[0]);
1145 this_thread->synchronous_io_handle_and_flag = 0;
1151 /* Unmark current thread as (probably) doing synchronous I/O; if an
1152 * I/O cancellation was requested, postpone it until next
1153 * io_begin_interruptible */
1155 io_end_interruptible(HANDLE handle)
1157 if (!ptr_CancelIoEx)
1159 __sync_bool_compare_and_swap(&this_thread->synchronous_io_handle_and_flag,
1164 win32_maybe_interrupt_io(void* thread)
1166 struct thread *th = thread;
1170 * ICBW about all of this. But it seems to me that this procedure is
1171 * a race condition. In theory. One that is hard produce (I can't
1172 * come up with a test case that exploits it), and might only be a bug
1173 * if users are doing weird things with I/O, possibly from FFI. But a
1174 * race is a race, so shouldn't this function and io_end_interruptible
1177 * Here's my thinking:
1179 * A.. <interruptee thread>
1180 * ... stuffs its handle into its structure.
1181 * B.. <interrupter thread>
1182 * ... calls us to wake the thread, finds the handle.
1183 * But just before we actually call CancelSynchronousIo/CancelIoEx,
1184 * something weird happens in the scheduler and the system is
1185 * so extremely busy that the interrupter doesn't get scheduled
1186 * for a while, giving the interruptee lots of time to continue.
1187 * A.. Didn't actually have to block, calls io_end_interruptible (in
1188 * which the handle flag already invalid, but it doesn't care
1189 * about that and still continues).
1190 * ... Proceeds to do unrelated I/O, e.g. goes into FFI code
1191 * (possible, because the CSP page hasn't been armed yet), which
1192 * does I/O from a C library, completely unrelated to SBCL's
1194 * B.. The scheduler gives us time for the interrupter again.
1195 * We call CancelSynchronousIo/CancelIoEx.
1196 * A.. Interruptee gets an expected error in unrelated I/O during FFI.
1197 * Interruptee's C code is unhappy and dies.
1199 * Note that CancelSynchronousIo and CancelIoEx have a rather different
1200 * effect here. In the normal (CancelIoEx) case, we only ever kill
1201 * I/O on the file handle in question. I think we could ask users
1202 * to please not both use Lisp streams (unix-read/write) _and_ FFI code
1203 * on the same file handle in quick succession.
1205 * CancelSynchronousIo seems more dangerous though. Here we interrupt
1206 * I/O on any other handle, even ones we're not actually responsible for,
1207 * because this functions deals with the thread handle, not the file
1211 * - Use mutexes. Somewhere, somehow. Presumably one mutex per
1212 * target thread, acquired around win32_maybe_interrupt_io and
1213 * io_end_interruptible. (That's one mutex use per I/O
1214 * operation, but I can't imagine that compared to our FFI overhead
1215 * that's much of a problem.)
1216 * - In io_end_interruptible, detect that the flag has been
1217 * invalidated, and in that case, do something clever (what?) to
1218 * wait for the imminent gc_stop_the_world, which implicitly tells
1219 * us that win32_maybe_interrupt_io must have exited. Except if
1220 * some _third_ thread is also beginning to call interrupt-thread
1221 * and wake_thread at the same time...?
1222 * - Revert the whole CancelSynchronousIo business after all.
1223 * - I'm wrong and everything is OK already.
1225 if (ptr_CancelIoEx) {
1227 InterlockedExchangePointer((volatile LPVOID *)
1228 &th->synchronous_io_handle_and_flag,
1229 (LPVOID)INVALID_HANDLE_VALUE);
1230 if (h && (h!=INVALID_HANDLE_VALUE)) {
1231 if (ptr_CancelSynchronousIo) {
1232 pthread_mutex_lock(&th->os_thread->fiber_lock);
1233 done = ptr_CancelSynchronousIo(th->os_thread->fiber_group->handle);
1234 pthread_mutex_unlock(&th->os_thread->fiber_lock);
1236 return (!!done)|(!!ptr_CancelIoEx(h,NULL));
1242 static const LARGE_INTEGER zero_large_offset = {.QuadPart = 0LL};
1245 win32_unix_write(FDTYPE fd, void * buf, int count)
1248 DWORD written_bytes;
1249 OVERLAPPED overlapped;
1250 struct thread * self = arch_os_get_current_thread();
1252 LARGE_INTEGER file_position;
1256 handle =(HANDLE)maybe_get_osfhandle(fd);
1257 if (console_handle_p(handle))
1258 return write(fd, buf, count);
1260 overlapped.hEvent = self->private_events.events[0];
1261 seekable = SetFilePointerEx(handle,
1266 overlapped.Offset = file_position.LowPart;
1267 overlapped.OffsetHigh = file_position.HighPart;
1269 overlapped.Offset = 0;
1270 overlapped.OffsetHigh = 0;
1272 if (!io_begin_interruptible(handle)) {
1276 ok = WriteFile(handle, buf, count, &written_bytes, &overlapped);
1277 io_end_interruptible(handle);
1280 goto done_something;
1282 DWORD errorCode = GetLastError();
1283 if (errorCode==ERROR_OPERATION_ABORTED) {
1284 GetOverlappedResult(handle,&overlapped,&written_bytes,FALSE);
1288 if (errorCode!=ERROR_IO_PENDING) {
1292 if(WaitForMultipleObjects(2,self->private_events.events,
1293 FALSE,INFINITE) != WAIT_OBJECT_0) {
1299 if (!GetOverlappedResult(handle,&overlapped,&written_bytes,waitInGOR)) {
1300 if (GetLastError()==ERROR_OPERATION_ABORTED) {
1307 goto done_something;
1313 file_position.QuadPart += written_bytes;
1314 SetFilePointerEx(handle,file_position,NULL,FILE_BEGIN);
1316 return written_bytes;
1320 win32_unix_read(FDTYPE fd, void * buf, int count)
1323 OVERLAPPED overlapped = {.Internal=0};
1324 DWORD read_bytes = 0;
1325 struct thread * self = arch_os_get_current_thread();
1326 DWORD errorCode = 0;
1327 BOOL waitInGOR = FALSE;
1329 LARGE_INTEGER file_position;
1332 handle = (HANDLE)maybe_get_osfhandle(fd);
1334 if (console_handle_p(handle))
1335 return read(fd, buf, count);
1336 overlapped.hEvent = self->private_events.events[0];
1337 /* If it has a position, we won't try overlapped */
1338 seekable = SetFilePointerEx(handle,
1343 overlapped.Offset = file_position.LowPart;
1344 overlapped.OffsetHigh = file_position.HighPart;
1346 overlapped.Offset = 0;
1347 overlapped.OffsetHigh = 0;
1349 if (!io_begin_interruptible(handle)) {
1353 ok = ReadFile(handle,buf,count,&read_bytes, &overlapped);
1354 io_end_interruptible(handle);
1357 goto done_something;
1359 errorCode = GetLastError();
1360 if (errorCode == ERROR_HANDLE_EOF ||
1361 errorCode == ERROR_BROKEN_PIPE ||
1362 errorCode == ERROR_NETNAME_DELETED) {
1364 goto done_something;
1366 if (errorCode==ERROR_OPERATION_ABORTED) {
1367 GetOverlappedResult(handle,&overlapped,&read_bytes,FALSE);
1371 if (errorCode!=ERROR_IO_PENDING) {
1372 /* is it some _real_ error? */
1377 if( (ret = WaitForMultipleObjects(2,self->private_events.events,
1378 FALSE,INFINITE)) != WAIT_OBJECT_0) {
1381 /* Waiting for IO only */
1385 ok = GetOverlappedResult(handle,&overlapped,&read_bytes,waitInGOR);
1387 errorCode = GetLastError();
1388 if (errorCode == ERROR_HANDLE_EOF ||
1389 errorCode == ERROR_BROKEN_PIPE ||
1390 errorCode == ERROR_NETNAME_DELETED) {
1392 goto done_something;
1394 if (errorCode == ERROR_OPERATION_ABORTED)
1395 errno = EINTR; /* that's it. */
1397 errno = EIO; /* something unspecific */
1401 goto done_something;
1406 file_position.QuadPart += read_bytes;
1407 SetFilePointerEx(handle,file_position,NULL,FILE_BEGIN);
1412 /* This is a manually-maintained version of ldso_stubs.S. */
1414 void __stdcall RtlUnwind(void *, void *, void *, void *); /* I don't have winternl.h */
1418 LARGE_INTEGER la = {{0}};
1422 SetHandleInformation(0, 0, 0);
1423 GetHandleInformation(0, 0);
1424 getsockopt(0, 0, 0, 0, 0);
1425 FlushConsoleInputBuffer(0);
1426 FormatMessageA(0, 0, 0, 0, 0, 0, 0);
1430 GetConsoleOutputCP();
1431 GetCurrentProcess();
1432 GetExitCodeProcess(0, 0);
1435 GetProcAddress(0, 0);
1436 GetProcessTimes(0, 0, 0, 0, 0);
1437 GetSystemTimeAsFileTime(0);
1440 PeekConsoleInput(0, 0, 0, 0);
1441 PeekNamedPipe(0, 0, 0, 0, 0, 0);
1442 ReadFile(0, 0, 0, 0, 0);
1444 WriteFile(0, 0, 0, 0, 0);
1446 _open_osfhandle(0, 0);
1455 RtlUnwind(0, 0, 0, 0);
1456 MapViewOfFile(0,0,0,0,0);
1458 FlushViewOfFile(0,0);
1459 SetFilePointerEx(0, la, 0, 0);
1460 DuplicateHandle(0, 0, 0, 0, 0, 0, 0);
1461 #ifndef LISP_FEATURE_SB_UNICODE
1462 CreateDirectoryA(0,0);
1463 CreateFileMappingA(0,0,0,0,0,0);
1464 CreateFileA(0,0,0,0,0,0,0);
1465 GetComputerNameA(0, 0);
1466 GetCurrentDirectoryA(0,0);
1467 GetEnvironmentVariableA(0, 0, 0);
1468 GetFileAttributesA(0);
1471 SHGetFolderPathA(0, 0, 0, 0, 0);
1472 SetCurrentDirectoryA(0);
1473 SetEnvironmentVariableA(0, 0);
1475 CreateDirectoryW(0,0);
1476 CreateFileMappingW(0,0,0,0,0,0);
1477 CreateFileW(0,0,0,0,0,0,0);
1478 FormatMessageW(0, 0, 0, 0, 0, 0, 0);
1479 GetComputerNameW(0, 0);
1480 GetCurrentDirectoryW(0,0);
1481 GetEnvironmentVariableW(0, 0, 0);
1482 GetFileAttributesW(0);
1485 SHGetFolderPathW(0, 0, 0, 0, 0);
1486 SetCurrentDirectoryW(0);
1487 SetEnvironmentVariableW(0, 0);
1493 os_get_runtime_executable_path(int external)
1495 char path[MAX_PATH + 1];
1496 DWORD bufsize = sizeof(path);
1499 if ((size = GetModuleFileNameA(NULL, path, bufsize)) == 0)
1501 else if (size == bufsize && GetLastError() == ERROR_INSUFFICIENT_BUFFER)
1504 return copied_string(path);
1507 #ifdef LISP_FEATURE_SB_THREAD
1510 win32_wait_object_or_signal(HANDLE waitFor)
1512 struct thread * self = arch_os_get_current_thread();
1514 handles[0] = waitFor;
1515 handles[1] = self->private_events.events[1];
1517 WaitForMultipleObjects(2,handles, FALSE,INFINITE);
1521 * Portability glue for win32 waitable timers.
1523 * One may ask: Why is there a wrapper in C when the calls are so
1524 * obvious that Lisp could do them directly (as it did on Windows)?
1526 * But the answer is that on POSIX platforms, we now emulate the win32
1527 * calls and hide that emulation behind this os_* abstraction.
1532 return CreateWaitableTimer(0, 0, 0);
1536 os_wait_for_wtimer(HANDLE handle)
1538 return win32_wait_object_or_signal(handle);
1542 os_close_wtimer(HANDLE handle)
1544 CloseHandle(handle);
1548 os_set_wtimer(HANDLE handle, int sec, int nsec)
1550 /* in units of 100ns, i.e. 0.1us. Negative for relative semantics. */
1552 = -(((long long) sec) * 10000000
1553 + ((long long) nsec + 99) / 100);
1554 SetWaitableTimer(handle, (LARGE_INTEGER*) &dueTime, 0, 0, 0, 0);
1558 os_cancel_wtimer(HANDLE handle)
1560 CancelWaitableTimer(handle);