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
31 #include <sys/param.h>
40 #include "interrupt.h"
45 #include "genesis/primitive-objects.h"
47 #include <sys/types.h>
53 /* KLUDGE: Avoid double definition of boolean by rpcndr.h included via
56 * FIXME: We should probably arrange to use the rpcndr.h boolean on Windows,
57 * or get rid of our own boolean type.
59 #define boolean rpcndr_boolean
70 size_t os_vm_page_size;
73 #include "gencgc-internal.h"
76 int linux_sparc_siginfo_bug = 0;
77 int linux_supports_futex=0;
80 /* The exception handling function looks like this: */
81 EXCEPTION_DISPOSITION handle_exception(EXCEPTION_RECORD *,
82 struct lisp_exception_frame *,
88 static void *get_seh_frame(void)
91 asm volatile ("movl %%fs:0,%0": "=r" (retval));
95 static void set_seh_frame(void *frame)
97 asm volatile ("movl %0,%%fs:0": : "r" (frame));
101 static struct lisp_exception_frame *find_our_seh_frame(void)
103 struct lisp_exception_frame *frame = get_seh_frame();
105 while (frame->handler != handle_exception)
106 frame = frame->next_frame;
111 inline static void *get_stack_frame(void)
114 asm volatile ("movl %%ebp,%0": "=r" (retval));
119 void os_init(char *argv[], char *envp[])
121 SYSTEM_INFO system_info;
123 GetSystemInfo(&system_info);
124 os_vm_page_size = system_info.dwPageSize;
126 base_seh_frame = get_seh_frame();
131 * So we have three fun scenarios here.
133 * First, we could be being called to reserve the memory areas
134 * during initialization (prior to loading the core file).
136 * Second, we could be being called by the GC to commit a page
137 * that has just been decommitted (for easy zero-fill).
139 * Third, we could be being called by create_thread_struct()
140 * in order to create the sundry and various stacks.
142 * The third case is easy to pick out because it passes an
145 * The second case is easy to pick out because it will be for
146 * a range of memory that is MEM_RESERVE rather than MEM_FREE.
148 * The second case is also an easy implement, because we leave
149 * the memory as reserved (since we do lazy commits).
153 os_validate(os_vm_address_t addr, os_vm_size_t len)
155 MEMORY_BASIC_INFORMATION mem_info;
158 /* the simple case first */
159 os_vm_address_t real_addr;
160 if (!(real_addr = VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE))) {
161 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
168 if (!VirtualQuery(addr, &mem_info, sizeof mem_info)) {
169 fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
173 if ((mem_info.State == MEM_RESERVE) && (mem_info.RegionSize >=len)) return addr;
175 if (mem_info.State == MEM_RESERVE) {
176 fprintf(stderr, "validation of reserved space too short.\n");
180 if (!VirtualAlloc(addr, len, (mem_info.State == MEM_RESERVE)? MEM_COMMIT: MEM_RESERVE, PAGE_EXECUTE_READWRITE)) {
181 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
189 * For os_invalidate(), we merely decommit the memory rather than
190 * freeing the address space. This loses when freeing per-thread
191 * data and related memory since it leaks address space. It's not
192 * too lossy, however, since the two scenarios I'm aware of are
193 * fd-stream buffers, which are pooled rather than torched, and
194 * thread information, which I hope to pool (since windows creates
195 * threads at its own whim, and we probably want to be able to
196 * have them callback without funky magic on the part of the user,
197 * and full-on thread allocation is fairly heavyweight). Someone
198 * will probably shoot me down on this with some pithy comment on
199 * the use of (setf symbol-value) on a special variable. I'm happy
204 os_invalidate(os_vm_address_t addr, os_vm_size_t len)
206 if (!VirtualFree(addr, len, MEM_DECOMMIT)) {
207 fprintf(stderr, "VirtualFree: 0x%lx.\n", GetLastError());
212 * os_map() is called to map a chunk of the core file into memory.
214 * Unfortunately, Windows semantics completely screws this up, so
215 * we just add backing store from the swapfile to where the chunk
216 * goes and read it up like a normal file. We could consider using
217 * a lazy read (demand page) setup, but that would mean keeping an
218 * open file pointer for the core indefinately (and be one more
219 * thing to maintain).
223 os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
228 fprintf(stderr, "os_map: %d, 0x%x, %p, 0x%x.\n", fd, offset, addr, len);
232 if (!VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE)) {
233 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
234 lose("os_map: VirtualAlloc failure");
237 if (lseek(fd, offset, SEEK_SET) == -1) {
238 lose("os_map: Seek failure.");
241 count = read(fd, addr, len);
243 fprintf(stderr, "expected 0x%x, read 0x%x.\n", len, count);
244 lose("os_map: Failed to read enough bytes.");
250 static DWORD os_protect_modes[8] = {
257 PAGE_EXECUTE_READWRITE,
258 PAGE_EXECUTE_READWRITE,
262 os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
266 if (!VirtualProtect(address, length, os_protect_modes[prot], &old_prot)) {
267 fprintf(stderr, "VirtualProtect failed, code 0x%lx.\n", GetLastError());
272 /* FIXME: Now that FOO_END, rather than FOO_SIZE, is the fundamental
273 * description of a space, we could probably punt this and just do
274 * (FOO_START <= x && x < FOO_END) everywhere it's called. */
276 in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
278 char* beg = (char*)((long)sbeg);
279 char* end = (char*)((long)sbeg) + slen;
280 char* adr = (char*)a;
281 return (adr >= beg && adr < end);
285 is_linkage_table_addr(os_vm_address_t addr)
287 return in_range_p(addr, LINKAGE_TABLE_SPACE_START, LINKAGE_TABLE_SPACE_END);
291 is_valid_lisp_addr(os_vm_address_t addr)
294 if(in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) ||
295 in_range_p(addr, STATIC_SPACE_START , STATIC_SPACE_SIZE) ||
296 in_range_p(addr, DYNAMIC_SPACE_START , dynamic_space_size))
298 for_each_thread(th) {
299 if(((os_vm_address_t)th->control_stack_start <= addr) && (addr < (os_vm_address_t)th->control_stack_end))
301 if(in_range_p(addr, (unsigned long)th->binding_stack_start, BINDING_STACK_SIZE))
308 * any OS-dependent special low-level handling for signals
311 /* A tiny bit of interrupt.c state we want our paws on. */
312 extern boolean internal_errors_enabled;
315 * A good explanation of the exception handling semantics is
316 * http://win32assembly.online.fr/Exceptionhandling.html .
319 EXCEPTION_DISPOSITION
320 handle_exception(EXCEPTION_RECORD *exception_record,
321 struct lisp_exception_frame *exception_frame,
323 void *dc) /* FIXME: What's dc again? */
325 /* For EXCEPTION_ACCESS_VIOLATION only. */
326 void *fault_address = (void *)exception_record->ExceptionInformation[1];
328 if (single_stepping &&
329 exception_record->ExceptionCode == EXCEPTION_SINGLE_STEP) {
330 /* We are doing a displaced instruction. At least function
331 * end breakpoints uses this. */
332 restore_breakpoint_from_single_step(context);
333 return ExceptionContinueExecution;
336 if (exception_record->ExceptionCode == EXCEPTION_BREAKPOINT) {
337 /* Pick off sigtrap case first. */
339 extern void sigtrap_handler(int signal, siginfo_t *info, void *context);
341 * Unlike some other operating systems, Win32 leaves EIP
342 * pointing to the breakpoint instruction.
346 sigtrap_handler(0, NULL, context);
348 return ExceptionContinueExecution;
350 else if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION &&
351 (is_valid_lisp_addr(fault_address) ||
352 is_linkage_table_addr(fault_address))) {
353 /* Pick off GC-related memory fault next. */
354 MEMORY_BASIC_INFORMATION mem_info;
356 if (!VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
357 fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
358 lose("handle_exception: VirtualQuery failure");
361 if (mem_info.State == MEM_RESERVE) {
362 /* First use new page, lets get some memory for it. */
363 if (!VirtualAlloc(mem_info.BaseAddress, os_vm_page_size,
364 MEM_COMMIT, PAGE_EXECUTE_READWRITE)) {
365 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
366 lose("handle_exception: VirtualAlloc failure");
370 * Now, if the page is supposedly write-protected and this
371 * is a write, tell the gc that it's been hit.
373 * FIXME: Are we supposed to fall-through to the Lisp
374 * exception handler if the gc doesn't take the wp violation?
376 if (exception_record->ExceptionInformation[0]) {
377 int index = find_page_index(fault_address);
378 if ((index != -1) && (page_table[index].write_protected)) {
379 gencgc_handle_wp_violation(fault_address);
382 return ExceptionContinueExecution;
385 } else if (gencgc_handle_wp_violation(fault_address)) {
386 /* gc accepts the wp violation, so resume where we left off. */
387 return ExceptionContinueExecution;
390 /* All else failed, drop through to the lisp-side exception handler. */
394 * If we fall through to here then we need to either forward
395 * the exception to the lisp-side exception handler if it's
396 * set up, or drop to LDB.
399 if (internal_errors_enabled) {
401 lispobj exception_record_sap;
403 /* We're making the somewhat arbitrary decision that having
404 * internal errors enabled means that lisp has sufficient
405 * marbles to be able to handle exceptions, but exceptions
406 * aren't supposed to happen during cold init or reinit
409 fake_foreign_function_call(context);
411 /* Allocate the SAP objects while the "interrupts" are still
413 context_sap = alloc_sap(context);
414 exception_record_sap = alloc_sap(exception_record);
416 /* The exception system doesn't automatically clear pending
417 * exceptions, so we lose as soon as we execute any FP
418 * instruction unless we do this first. */
421 /* Call into lisp to handle things. */
422 funcall2(SymbolFunction(HANDLE_WIN32_EXCEPTION), context_sap,
423 exception_record_sap);
425 /* If Lisp doesn't nlx, we need to put things back. */
426 undo_fake_foreign_function_call(context);
428 /* FIXME: HANDLE-WIN32-EXCEPTION should be allowed to decline */
429 return ExceptionContinueExecution;
432 fprintf(stderr, "Exception Code: 0x%lx.\n", exception_record->ExceptionCode);
433 fprintf(stderr, "Faulting IP: 0x%lx.\n", (DWORD)exception_record->ExceptionAddress);
434 if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) {
435 MEMORY_BASIC_INFORMATION mem_info;
437 if (VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
438 fprintf(stderr, "page status: 0x%lx.\n", mem_info.State);
441 fprintf(stderr, "Was writing: %ld, where: 0x%lx.\n",
442 exception_record->ExceptionInformation[0],
443 (DWORD)fault_address);
448 fake_foreign_function_call(context);
449 lose("fake_foreign_function_call fell through");
451 /* FIXME: WTF? How are we supposed to end up here? */
452 return ExceptionContinueSearch;
456 wos_install_interrupt_handlers(struct lisp_exception_frame *handler)
458 handler->next_frame = get_seh_frame();
459 handler->handler = &handle_exception;
460 set_seh_frame(handler);
463 void bcopy(const void *src, void *dest, size_t n)
465 MoveMemory(dest, src, n);
469 * The stubs below are replacements for the windows versions,
470 * which can -fail- when used in our memory spaces because they
471 * validate the memory spaces they are passed in a way that
472 * denies our exception handler a chance to run.
475 void *memmove(void *dest, const void *src, size_t n)
479 for (i = 0; i < n; i++) *(((char *)dest)+i) = *(((char *)src)+i);
481 while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
486 void *memcpy(void *dest, const void *src, size_t n)
488 while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
492 char *dirname(char *path)
494 static char buf[PATH_MAX + 1];
495 size_t pathlen = strlen(path);
498 if (pathlen >= sizeof(buf)) {
499 lose("Pathname too long in dirname.\n");
504 for (i = pathlen; i >= 0; --i) {
505 if (buf[i] == '/' || buf[i] == '\\') {
514 /* This is a manually-maintained version of ldso_stubs.S. */
516 void __stdcall RtlUnwind(void *, void *, void *, void *); /* I don't have winternl.h */
521 FlushConsoleInputBuffer(0);
522 FormatMessageA(0, 0, 0, 0, 0, 0, 0);
526 GetConsoleOutputCP();
528 GetExitCodeProcess(0, 0);
531 GetProcAddress(0, 0);
532 GetProcessTimes(0, 0, 0, 0, 0);
533 GetSystemTimeAsFileTime(0);
536 PeekConsoleInput(0, 0, 0, 0);
537 PeekNamedPipe(0, 0, 0, 0, 0, 0);
538 ReadFile(0, 0, 0, 0, 0);
540 WriteFile(0, 0, 0, 0, 0);
554 RtlUnwind(0, 0, 0, 0);
555 #ifndef LISP_FEATURE_SB_UNICODE
556 CreateDirectoryA(0,0);
557 GetComputerNameA(0, 0);
558 GetCurrentDirectoryA(0,0);
559 GetEnvironmentVariableA(0, 0, 0);
562 SHGetFolderPathA(0, 0, 0, 0, 0);
563 SetCurrentDirectoryA(0);
564 SetEnvironmentVariableA(0, 0);
566 CreateDirectoryW(0,0);
567 FormatMessageW(0, 0, 0, 0, 0, 0, 0);
568 GetComputerNameW(0, 0);
569 GetCurrentDirectoryW(0,0);
570 GetEnvironmentVariableW(0, 0, 0);
573 SHGetFolderPathW(0, 0, 0, 0, 0);
574 SetCurrentDirectoryW(0);
575 SetEnvironmentVariableW(0, 0);
580 os_get_runtime_executable_path()
582 char path[MAX_PATH + 1];
583 DWORD bufsize = sizeof(path);
586 if ((size = GetModuleFileNameA(NULL, path, bufsize)) == 0)
588 else if (size == bufsize && GetLastError() == ERROR_INSUFFICIENT_BUFFER)
591 return copied_string(path);