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"
48 #include <sys/types.h>
61 size_t os_vm_page_size
;
64 #include "gencgc-internal.h"
67 int linux_sparc_siginfo_bug
= 0;
68 int linux_supports_futex
=0;
71 /* The exception handling function looks like this: */
72 EXCEPTION_DISPOSITION
handle_exception(EXCEPTION_RECORD
*,
73 struct lisp_exception_frame
*,
79 static void *get_seh_frame(void)
82 asm volatile ("movl %%fs:0,%0": "=r" (retval
));
86 static void set_seh_frame(void *frame
)
88 asm volatile ("movl %0,%%fs:0": : "r" (frame
));
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
;
102 inline static void *get_stack_frame(void)
105 asm volatile ("movl %%ebp,%0": "=r" (retval
));
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
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).
144 os_validate(os_vm_address_t addr
, os_vm_size_t len
)
146 MEMORY_BASIC_INFORMATION mem_info
;
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());
159 if (!VirtualQuery(addr
, &mem_info
, sizeof mem_info
)) {
160 fprintf(stderr
, "VirtualQuery: 0x%lx.\n", GetLastError());
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");
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());
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
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).
214 os_map(int fd
, int offset
, os_vm_address_t addr
, os_vm_size_t len
)
219 fprintf(stderr
, "os_map: %d, 0x%x, %p, 0x%x.\n", fd
, offset
, addr
, len
);
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
);
234 fprintf(stderr
, "expected 0x%x, read 0x%x.\n", len
, count
);
235 lose("os_map: Failed to read enough bytes.");
241 static DWORD os_protect_modes
[8] = {
248 PAGE_EXECUTE_READWRITE
,
249 PAGE_EXECUTE_READWRITE
,
253 os_protect(os_vm_address_t address
, os_vm_size_t length
, os_vm_prot_t prot
)
257 if (!VirtualProtect(address
, length
, os_protect_modes
[prot
], &old_prot
)) {
258 fprintf(stderr
, "VirtualProtect failed, code 0x%lx.\n", GetLastError());
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. */
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
);
276 is_linkage_table_addr(os_vm_address_t addr
)
278 return in_range_p(addr
, LINKAGE_TABLE_SPACE_START
, LINKAGE_TABLE_SPACE_END
);
282 is_valid_lisp_addr(os_vm_address_t addr
)
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
))
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
))
292 if(in_range_p(addr
, (unsigned long)th
->binding_stack_start
, BINDING_STACK_SIZE
))
298 /* A tiny bit of interrupt.c state we want our paws on. */
299 extern boolean internal_errors_enabled
;
301 #ifdef LISP_FEATURE_UD2_BREAKPOINTS
302 #define IS_TRAP_EXCEPTION(exception_record, context) \
303 (((exception_record)->ExceptionCode == EXCEPTION_ILLEGAL_INSTRUCTION) && \
304 (((unsigned short *)((context)->Eip))[0] == 0x0b0f))
305 #define TRAP_CODE_WIDTH 2
307 #define IS_TRAP_EXCEPTION(exception_record, context) \
308 ((exception_record)->ExceptionCode == EXCEPTION_BREAKPOINT)
309 #define TRAP_CODE_WIDTH 1
313 * A good explanation of the exception handling semantics is
314 * http://win32assembly.online.fr/Exceptionhandling.html .
317 EXCEPTION_DISPOSITION
318 handle_exception(EXCEPTION_RECORD
*exception_record
,
319 struct lisp_exception_frame
*exception_frame
,
321 void *dispatcher_context
)
323 if (exception_record
->ExceptionFlags
& (EH_UNWINDING
| EH_EXIT_UNWIND
)) {
324 /* If we're being unwound, be graceful about it. */
326 /* Undo any dynamic bindings. */
327 unbind_to_here(exception_frame
->bindstack_pointer
,
328 arch_os_get_current_thread());
330 return ExceptionContinueSearch
;
333 /* For EXCEPTION_ACCESS_VIOLATION only. */
334 void *fault_address
= (void *)exception_record
->ExceptionInformation
[1];
336 if (single_stepping
&&
337 exception_record
->ExceptionCode
== EXCEPTION_SINGLE_STEP
) {
338 /* We are doing a displaced instruction. At least function
339 * end breakpoints uses this. */
340 restore_breakpoint_from_single_step(context
);
341 return ExceptionContinueExecution
;
344 if (IS_TRAP_EXCEPTION(exception_record
, context
)) {
346 /* This is just for info in case the monitor wants to print an
348 current_control_stack_pointer
=
349 (lispobj
*)*os_context_sp_addr(context
);
350 /* Unlike some other operating systems, Win32 leaves EIP
351 * pointing to the breakpoint instruction. */
352 context
->Eip
+= TRAP_CODE_WIDTH
;
353 /* Now EIP points just after the INT3 byte and aims at the
354 * 'kind' value (eg trap_Cerror). */
355 trap
= *(unsigned char *)(*os_context_pc_addr(context
));
356 handle_trap(context
, trap
);
357 /* Done, we're good to go! */
358 return ExceptionContinueExecution
;
360 else if (exception_record
->ExceptionCode
== EXCEPTION_ACCESS_VIOLATION
&&
361 (is_valid_lisp_addr(fault_address
) ||
362 is_linkage_table_addr(fault_address
))) {
363 /* Pick off GC-related memory fault next. */
364 MEMORY_BASIC_INFORMATION mem_info
;
366 if (!VirtualQuery(fault_address
, &mem_info
, sizeof mem_info
)) {
367 fprintf(stderr
, "VirtualQuery: 0x%lx.\n", GetLastError());
368 lose("handle_exception: VirtualQuery failure");
371 if (mem_info
.State
== MEM_RESERVE
) {
372 /* First use new page, lets get some memory for it. */
373 if (!VirtualAlloc(mem_info
.BaseAddress
, os_vm_page_size
,
374 MEM_COMMIT
, PAGE_EXECUTE_READWRITE
)) {
375 fprintf(stderr
, "VirtualAlloc: 0x%lx.\n", GetLastError());
376 lose("handle_exception: VirtualAlloc failure");
380 * Now, if the page is supposedly write-protected and this
381 * is a write, tell the gc that it's been hit.
383 * FIXME: Are we supposed to fall-through to the Lisp
384 * exception handler if the gc doesn't take the wp violation?
386 if (exception_record
->ExceptionInformation
[0]) {
387 int index
= find_page_index(fault_address
);
388 if ((index
!= -1) && (page_table
[index
].write_protected
)) {
389 gencgc_handle_wp_violation(fault_address
);
392 return ExceptionContinueExecution
;
395 } else if (gencgc_handle_wp_violation(fault_address
)) {
396 /* gc accepts the wp violation, so resume where we left off. */
397 return ExceptionContinueExecution
;
400 /* All else failed, drop through to the lisp-side exception handler. */
404 * If we fall through to here then we need to either forward
405 * the exception to the lisp-side exception handler if it's
406 * set up, or drop to LDB.
409 if (internal_errors_enabled
) {
411 lispobj exception_record_sap
;
413 /* We're making the somewhat arbitrary decision that having
414 * internal errors enabled means that lisp has sufficient
415 * marbles to be able to handle exceptions, but exceptions
416 * aren't supposed to happen during cold init or reinit
419 fake_foreign_function_call(context
);
421 /* Allocate the SAP objects while the "interrupts" are still
423 context_sap
= alloc_sap(context
);
424 exception_record_sap
= alloc_sap(exception_record
);
426 /* The exception system doesn't automatically clear pending
427 * exceptions, so we lose as soon as we execute any FP
428 * instruction unless we do this first. */
431 /* Call into lisp to handle things. */
432 funcall2(StaticSymbolFunction(HANDLE_WIN32_EXCEPTION
), context_sap
,
433 exception_record_sap
);
435 /* If Lisp doesn't nlx, we need to put things back. */
436 undo_fake_foreign_function_call(context
);
438 /* FIXME: HANDLE-WIN32-EXCEPTION should be allowed to decline */
439 return ExceptionContinueExecution
;
442 fprintf(stderr
, "Exception Code: 0x%lx.\n", exception_record
->ExceptionCode
);
443 fprintf(stderr
, "Faulting IP: 0x%lx.\n", (DWORD
)exception_record
->ExceptionAddress
);
444 if (exception_record
->ExceptionCode
== EXCEPTION_ACCESS_VIOLATION
) {
445 MEMORY_BASIC_INFORMATION mem_info
;
447 if (VirtualQuery(fault_address
, &mem_info
, sizeof mem_info
)) {
448 fprintf(stderr
, "page status: 0x%lx.\n", mem_info
.State
);
451 fprintf(stderr
, "Was writing: %ld, where: 0x%lx.\n",
452 exception_record
->ExceptionInformation
[0],
453 (DWORD
)fault_address
);
458 fake_foreign_function_call(context
);
459 lose("Exception too early in cold init, cannot continue.");
461 /* FIXME: WTF? How are we supposed to end up here? */
462 return ExceptionContinueSearch
;
466 wos_install_interrupt_handlers(struct lisp_exception_frame
*handler
)
468 handler
->next_frame
= get_seh_frame();
469 handler
->handler
= &handle_exception
;
470 set_seh_frame(handler
);
473 void bcopy(const void *src
, void *dest
, size_t n
)
475 MoveMemory(dest
, src
, n
);
479 * The stubs below are replacements for the windows versions,
480 * which can -fail- when used in our memory spaces because they
481 * validate the memory spaces they are passed in a way that
482 * denies our exception handler a chance to run.
485 void *memmove(void *dest
, const void *src
, size_t n
)
489 for (i
= 0; i
< n
; i
++) *(((char *)dest
)+i
) = *(((char *)src
)+i
);
491 while (n
--) *(((char *)dest
)+n
) = *(((char *)src
)+n
);
496 void *memcpy(void *dest
, const void *src
, size_t n
)
498 while (n
--) *(((char *)dest
)+n
) = *(((char *)src
)+n
);
502 char *dirname(char *path
)
504 static char buf
[PATH_MAX
+ 1];
505 size_t pathlen
= strlen(path
);
508 if (pathlen
>= sizeof(buf
)) {
509 lose("Pathname too long in dirname.\n");
514 for (i
= pathlen
; i
>= 0; --i
) {
515 if (buf
[i
] == '/' || buf
[i
] == '\\') {
524 /* This is a manually-maintained version of ldso_stubs.S. */
526 void __stdcall
RtlUnwind(void *, void *, void *, void *); /* I don't have winternl.h */
531 FlushConsoleInputBuffer(0);
532 FormatMessageA(0, 0, 0, 0, 0, 0, 0);
536 GetConsoleOutputCP();
538 GetExitCodeProcess(0, 0);
541 GetProcAddress(0, 0);
542 GetProcessTimes(0, 0, 0, 0, 0);
543 GetSystemTimeAsFileTime(0);
546 PeekConsoleInput(0, 0, 0, 0);
547 PeekNamedPipe(0, 0, 0, 0, 0, 0);
548 ReadFile(0, 0, 0, 0, 0);
550 WriteFile(0, 0, 0, 0, 0);
559 RtlUnwind(0, 0, 0, 0);
560 #ifndef LISP_FEATURE_SB_UNICODE
561 CreateDirectoryA(0,0);
562 GetComputerNameA(0, 0);
563 GetCurrentDirectoryA(0,0);
564 GetEnvironmentVariableA(0, 0, 0);
567 SHGetFolderPathA(0, 0, 0, 0, 0);
568 SetCurrentDirectoryA(0);
569 SetEnvironmentVariableA(0, 0);
571 CreateDirectoryW(0,0);
572 FormatMessageW(0, 0, 0, 0, 0, 0, 0);
573 GetComputerNameW(0, 0);
574 GetCurrentDirectoryW(0,0);
575 GetEnvironmentVariableW(0, 0, 0);
578 SHGetFolderPathW(0, 0, 0, 0, 0);
579 SetCurrentDirectoryW(0);
580 SetEnvironmentVariableW(0, 0);
585 os_get_runtime_executable_path(int external
)
587 char path
[MAX_PATH
+ 1];
588 DWORD bufsize
= sizeof(path
);
591 if ((size
= GetModuleFileNameA(NULL
, path
, bufsize
)) == 0)
593 else if (size
== bufsize
&& GetLastError() == ERROR_INSUFFICIENT_BUFFER
)
596 return copied_string(path
);