1.0.23.59: bug 3b has been fixed a while now
[sbcl/tcr.git] / src / runtime / win32-os.c
blob32ff6d054be4355cb8144c0b21de1348572b3283
1 /*
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
14 * more information.
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
26 * yet.
29 #include <malloc.h>
30 #include <stdio.h>
31 #include <sys/param.h>
32 #include <sys/file.h>
33 #include <io.h>
34 #include "sbcl.h"
35 #include "./signal.h"
36 #include "os.h"
37 #include "arch.h"
38 #include "globals.h"
39 #include "sbcl.h"
40 #include "interrupt.h"
41 #include "interr.h"
42 #include "lispregs.h"
43 #include "runtime.h"
44 #include "alloc.h"
45 #include "genesis/primitive-objects.h"
46 #include "dynbind.h"
48 #include <sys/types.h>
49 #include <signal.h>
50 #include <sys/time.h>
51 #include <sys/stat.h>
52 #include <unistd.h>
54 #include <math.h>
55 #include <float.h>
57 #include <excpt.h>
59 #include "validate.h"
60 #include "thread.h"
61 size_t os_vm_page_size;
63 #include "gc.h"
64 #include "gencgc-internal.h"
66 #if 0
67 int linux_sparc_siginfo_bug = 0;
68 int linux_supports_futex=0;
69 #endif
71 /* The exception handling function looks like this: */
72 EXCEPTION_DISPOSITION handle_exception(EXCEPTION_RECORD *,
73 struct lisp_exception_frame *,
74 CONTEXT *,
75 void *);
77 void *base_seh_frame;
79 static void *get_seh_frame(void)
81 void* retval;
82 asm volatile ("movl %%fs:0,%0": "=r" (retval));
83 return retval;
86 static void set_seh_frame(void *frame)
88 asm volatile ("movl %0,%%fs:0": : "r" (frame));
91 #if 0
92 static struct lisp_exception_frame *find_our_seh_frame(void)
94 struct lisp_exception_frame *frame = get_seh_frame();
96 while (frame->handler != handle_exception)
97 frame = frame->next_frame;
99 return frame;
102 inline static void *get_stack_frame(void)
104 void* retval;
105 asm volatile ("movl %%ebp,%0": "=r" (retval));
106 return retval;
108 #endif
110 void os_init(char *argv[], char *envp[])
112 SYSTEM_INFO system_info;
114 GetSystemInfo(&system_info);
115 os_vm_page_size = system_info.dwPageSize;
117 base_seh_frame = get_seh_frame();
122 * So we have three fun scenarios here.
124 * First, we could be being called to reserve the memory areas
125 * during initialization (prior to loading the core file).
127 * Second, we could be being called by the GC to commit a page
128 * that has just been decommitted (for easy zero-fill).
130 * Third, we could be being called by create_thread_struct()
131 * in order to create the sundry and various stacks.
133 * The third case is easy to pick out because it passes an
134 * addr of 0.
136 * The second case is easy to pick out because it will be for
137 * a range of memory that is MEM_RESERVE rather than MEM_FREE.
139 * The second case is also an easy implement, because we leave
140 * the memory as reserved (since we do lazy commits).
143 os_vm_address_t
144 os_validate(os_vm_address_t addr, os_vm_size_t len)
146 MEMORY_BASIC_INFORMATION mem_info;
148 if (!addr) {
149 /* the simple case first */
150 os_vm_address_t real_addr;
151 if (!(real_addr = VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE))) {
152 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
153 return 0;
156 return real_addr;
159 if (!VirtualQuery(addr, &mem_info, sizeof mem_info)) {
160 fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
161 return 0;
164 if ((mem_info.State == MEM_RESERVE) && (mem_info.RegionSize >=len)) return addr;
166 if (mem_info.State == MEM_RESERVE) {
167 fprintf(stderr, "validation of reserved space too short.\n");
168 fflush(stderr);
171 if (!VirtualAlloc(addr, len, (mem_info.State == MEM_RESERVE)? MEM_COMMIT: MEM_RESERVE, PAGE_EXECUTE_READWRITE)) {
172 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
173 return 0;
176 return addr;
180 * For os_invalidate(), we merely decommit the memory rather than
181 * freeing the address space. This loses when freeing per-thread
182 * data and related memory since it leaks address space. It's not
183 * too lossy, however, since the two scenarios I'm aware of are
184 * fd-stream buffers, which are pooled rather than torched, and
185 * thread information, which I hope to pool (since windows creates
186 * threads at its own whim, and we probably want to be able to
187 * have them callback without funky magic on the part of the user,
188 * and full-on thread allocation is fairly heavyweight). Someone
189 * will probably shoot me down on this with some pithy comment on
190 * the use of (setf symbol-value) on a special variable. I'm happy
191 * for them.
194 void
195 os_invalidate(os_vm_address_t addr, os_vm_size_t len)
197 if (!VirtualFree(addr, len, MEM_DECOMMIT)) {
198 fprintf(stderr, "VirtualFree: 0x%lx.\n", GetLastError());
203 * os_map() is called to map a chunk of the core file into memory.
205 * Unfortunately, Windows semantics completely screws this up, so
206 * we just add backing store from the swapfile to where the chunk
207 * goes and read it up like a normal file. We could consider using
208 * a lazy read (demand page) setup, but that would mean keeping an
209 * open file pointer for the core indefinately (and be one more
210 * thing to maintain).
213 os_vm_address_t
214 os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
216 os_vm_size_t count;
218 #if 0
219 fprintf(stderr, "os_map: %d, 0x%x, %p, 0x%x.\n", fd, offset, addr, len);
220 fflush(stderr);
221 #endif
223 if (!VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE)) {
224 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
225 lose("os_map: VirtualAlloc failure");
228 if (lseek(fd, offset, SEEK_SET) == -1) {
229 lose("os_map: Seek failure.");
232 count = read(fd, addr, len);
233 if (count != len) {
234 fprintf(stderr, "expected 0x%x, read 0x%x.\n", len, count);
235 lose("os_map: Failed to read enough bytes.");
238 return addr;
241 static DWORD os_protect_modes[8] = {
242 PAGE_NOACCESS,
243 PAGE_READONLY,
244 PAGE_READWRITE,
245 PAGE_READWRITE,
246 PAGE_EXECUTE,
247 PAGE_EXECUTE_READ,
248 PAGE_EXECUTE_READWRITE,
249 PAGE_EXECUTE_READWRITE,
252 void
253 os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
255 DWORD old_prot;
257 if (!VirtualProtect(address, length, os_protect_modes[prot], &old_prot)) {
258 fprintf(stderr, "VirtualProtect failed, code 0x%lx.\n", GetLastError());
259 fflush(stderr);
263 /* FIXME: Now that FOO_END, rather than FOO_SIZE, is the fundamental
264 * description of a space, we could probably punt this and just do
265 * (FOO_START <= x && x < FOO_END) everywhere it's called. */
266 static boolean
267 in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
269 char* beg = (char*)((long)sbeg);
270 char* end = (char*)((long)sbeg) + slen;
271 char* adr = (char*)a;
272 return (adr >= beg && adr < end);
275 boolean
276 is_linkage_table_addr(os_vm_address_t addr)
278 return in_range_p(addr, LINKAGE_TABLE_SPACE_START, LINKAGE_TABLE_SPACE_END);
281 boolean
282 is_valid_lisp_addr(os_vm_address_t addr)
284 struct thread *th;
285 if(in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) ||
286 in_range_p(addr, STATIC_SPACE_START , STATIC_SPACE_SIZE) ||
287 in_range_p(addr, DYNAMIC_SPACE_START , dynamic_space_size))
288 return 1;
289 for_each_thread(th) {
290 if(((os_vm_address_t)th->control_stack_start <= addr) && (addr < (os_vm_address_t)th->control_stack_end))
291 return 1;
292 if(in_range_p(addr, (unsigned long)th->binding_stack_start, BINDING_STACK_SIZE))
293 return 1;
295 return 0;
298 /* A tiny bit of interrupt.c state we want our paws on. */
299 extern boolean internal_errors_enabled;
302 * A good explanation of the exception handling semantics is
303 * http://win32assembly.online.fr/Exceptionhandling.html .
306 EXCEPTION_DISPOSITION
307 handle_exception(EXCEPTION_RECORD *exception_record,
308 struct lisp_exception_frame *exception_frame,
309 CONTEXT *context,
310 void *dispatcher_context)
312 if (exception_record->ExceptionFlags & (EH_UNWINDING | EH_EXIT_UNWIND)) {
313 /* If we're being unwound, be graceful about it. */
315 /* Undo any dynamic bindings. */
316 unbind_to_here(exception_frame->bindstack_pointer,
317 arch_os_get_current_thread());
319 return ExceptionContinueSearch;
322 /* For EXCEPTION_ACCESS_VIOLATION only. */
323 void *fault_address = (void *)exception_record->ExceptionInformation[1];
325 if (single_stepping &&
326 exception_record->ExceptionCode == EXCEPTION_SINGLE_STEP) {
327 /* We are doing a displaced instruction. At least function
328 * end breakpoints uses this. */
329 restore_breakpoint_from_single_step(context);
330 return ExceptionContinueExecution;
333 if (exception_record->ExceptionCode == EXCEPTION_BREAKPOINT) {
334 unsigned char trap;
335 /* This is just for info in case the monitor wants to print an
336 * approximation. */
337 current_control_stack_pointer =
338 (lispobj *)*os_context_sp_addr(context);
339 /* Unlike some other operating systems, Win32 leaves EIP
340 * pointing to the breakpoint instruction. */
341 context->Eip++;
342 /* Now EIP points just after the INT3 byte and aims at the
343 * 'kind' value (eg trap_Cerror). */
344 trap = *(unsigned char *)(*os_context_pc_addr(context));
345 handle_trap(context, trap);
346 /* Done, we're good to go! */
347 return ExceptionContinueExecution;
349 else if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION &&
350 (is_valid_lisp_addr(fault_address) ||
351 is_linkage_table_addr(fault_address))) {
352 /* Pick off GC-related memory fault next. */
353 MEMORY_BASIC_INFORMATION mem_info;
355 if (!VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
356 fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
357 lose("handle_exception: VirtualQuery failure");
360 if (mem_info.State == MEM_RESERVE) {
361 /* First use new page, lets get some memory for it. */
362 if (!VirtualAlloc(mem_info.BaseAddress, os_vm_page_size,
363 MEM_COMMIT, PAGE_EXECUTE_READWRITE)) {
364 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
365 lose("handle_exception: VirtualAlloc failure");
367 } else {
369 * Now, if the page is supposedly write-protected and this
370 * is a write, tell the gc that it's been hit.
372 * FIXME: Are we supposed to fall-through to the Lisp
373 * exception handler if the gc doesn't take the wp violation?
375 if (exception_record->ExceptionInformation[0]) {
376 int index = find_page_index(fault_address);
377 if ((index != -1) && (page_table[index].write_protected)) {
378 gencgc_handle_wp_violation(fault_address);
381 return ExceptionContinueExecution;
384 } else if (gencgc_handle_wp_violation(fault_address)) {
385 /* gc accepts the wp violation, so resume where we left off. */
386 return ExceptionContinueExecution;
389 /* All else failed, drop through to the lisp-side exception handler. */
393 * If we fall through to here then we need to either forward
394 * the exception to the lisp-side exception handler if it's
395 * set up, or drop to LDB.
398 if (internal_errors_enabled) {
399 lispobj context_sap;
400 lispobj exception_record_sap;
402 /* We're making the somewhat arbitrary decision that having
403 * internal errors enabled means that lisp has sufficient
404 * marbles to be able to handle exceptions, but exceptions
405 * aren't supposed to happen during cold init or reinit
406 * anyway. */
408 fake_foreign_function_call(context);
410 /* Allocate the SAP objects while the "interrupts" are still
411 * disabled. */
412 context_sap = alloc_sap(context);
413 exception_record_sap = alloc_sap(exception_record);
415 /* The exception system doesn't automatically clear pending
416 * exceptions, so we lose as soon as we execute any FP
417 * instruction unless we do this first. */
418 _clearfp();
420 /* Call into lisp to handle things. */
421 funcall2(StaticSymbolFunction(HANDLE_WIN32_EXCEPTION), context_sap,
422 exception_record_sap);
424 /* If Lisp doesn't nlx, we need to put things back. */
425 undo_fake_foreign_function_call(context);
427 /* FIXME: HANDLE-WIN32-EXCEPTION should be allowed to decline */
428 return ExceptionContinueExecution;
431 fprintf(stderr, "Exception Code: 0x%lx.\n", exception_record->ExceptionCode);
432 fprintf(stderr, "Faulting IP: 0x%lx.\n", (DWORD)exception_record->ExceptionAddress);
433 if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) {
434 MEMORY_BASIC_INFORMATION mem_info;
436 if (VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
437 fprintf(stderr, "page status: 0x%lx.\n", mem_info.State);
440 fprintf(stderr, "Was writing: %ld, where: 0x%lx.\n",
441 exception_record->ExceptionInformation[0],
442 (DWORD)fault_address);
445 fflush(stderr);
447 fake_foreign_function_call(context);
448 lose("Exception too early in cold init, cannot continue.");
450 /* FIXME: WTF? How are we supposed to end up here? */
451 return ExceptionContinueSearch;
454 void
455 wos_install_interrupt_handlers(struct lisp_exception_frame *handler)
457 handler->next_frame = get_seh_frame();
458 handler->handler = &handle_exception;
459 set_seh_frame(handler);
462 void bcopy(const void *src, void *dest, size_t n)
464 MoveMemory(dest, src, n);
468 * The stubs below are replacements for the windows versions,
469 * which can -fail- when used in our memory spaces because they
470 * validate the memory spaces they are passed in a way that
471 * denies our exception handler a chance to run.
474 void *memmove(void *dest, const void *src, size_t n)
476 if (dest < src) {
477 int i;
478 for (i = 0; i < n; i++) *(((char *)dest)+i) = *(((char *)src)+i);
479 } else {
480 while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
482 return dest;
485 void *memcpy(void *dest, const void *src, size_t n)
487 while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
488 return dest;
491 char *dirname(char *path)
493 static char buf[PATH_MAX + 1];
494 size_t pathlen = strlen(path);
495 int i;
497 if (pathlen >= sizeof(buf)) {
498 lose("Pathname too long in dirname.\n");
499 return NULL;
502 strcpy(buf, path);
503 for (i = pathlen; i >= 0; --i) {
504 if (buf[i] == '/' || buf[i] == '\\') {
505 buf[i] = '\0';
506 break;
510 return buf;
513 /* This is a manually-maintained version of ldso_stubs.S. */
515 void __stdcall RtlUnwind(void *, void *, void *, void *); /* I don't have winternl.h */
517 void scratch(void)
519 CloseHandle(0);
520 FlushConsoleInputBuffer(0);
521 FormatMessageA(0, 0, 0, 0, 0, 0, 0);
522 FreeLibrary(0);
523 GetACP();
524 GetConsoleCP();
525 GetConsoleOutputCP();
526 GetCurrentProcess();
527 GetExitCodeProcess(0, 0);
528 GetLastError();
529 GetOEMCP();
530 GetProcAddress(0, 0);
531 GetProcessTimes(0, 0, 0, 0, 0);
532 GetSystemTimeAsFileTime(0);
533 LoadLibrary(0);
534 LocalFree(0);
535 PeekConsoleInput(0, 0, 0, 0);
536 PeekNamedPipe(0, 0, 0, 0, 0, 0);
537 ReadFile(0, 0, 0, 0, 0);
538 Sleep(0);
539 WriteFile(0, 0, 0, 0, 0);
540 _get_osfhandle(0);
541 _pipe(0,0,0);
542 access(0,0);
543 close(0);
544 dup(0);
545 isatty(0);
546 strerror(42);
547 write(0, 0, 0);
548 RtlUnwind(0, 0, 0, 0);
549 #ifndef LISP_FEATURE_SB_UNICODE
550 CreateDirectoryA(0,0);
551 GetComputerNameA(0, 0);
552 GetCurrentDirectoryA(0,0);
553 GetEnvironmentVariableA(0, 0, 0);
554 GetVersionExA(0);
555 MoveFileA(0,0);
556 SHGetFolderPathA(0, 0, 0, 0, 0);
557 SetCurrentDirectoryA(0);
558 SetEnvironmentVariableA(0, 0);
559 #else
560 CreateDirectoryW(0,0);
561 FormatMessageW(0, 0, 0, 0, 0, 0, 0);
562 GetComputerNameW(0, 0);
563 GetCurrentDirectoryW(0,0);
564 GetEnvironmentVariableW(0, 0, 0);
565 GetVersionExW(0);
566 MoveFileW(0,0);
567 SHGetFolderPathW(0, 0, 0, 0, 0);
568 SetCurrentDirectoryW(0);
569 SetEnvironmentVariableW(0, 0);
570 #endif
573 char *
574 os_get_runtime_executable_path()
576 char path[MAX_PATH + 1];
577 DWORD bufsize = sizeof(path);
578 DWORD size;
580 if ((size = GetModuleFileNameA(NULL, path, bufsize)) == 0)
581 return NULL;
582 else if (size == bufsize && GetLastError() == ERROR_INSUFFICIENT_BUFFER)
583 return NULL;
585 return copied_string(path);
588 /* EOF */