src/runtime/win32-os.c

   1 /*
   2  * the Win32 incarnation of OS-dependent routines.  See also
   3  * $(sbcl_arch)-win32-os.c
   4  *
   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.
  10  */
  11
  12 /*
  13  * This software is part of the SBCL system. See the README file for
  14  * more information.
  15  *
  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.
  21  */
  22
  23 /*
  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.
  27  */
  28
  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"
  47
  48 #include <sys/types.h>
  49 #include <signal.h>
  50 #include <sys/time.h>
  51 #include <sys/stat.h>
  52 #include <unistd.h>
  53
  54 /* KLUDGE: Avoid double definition of boolean by rpcndr.h included via
  55  * shlobj.h.
  56  *
  57  * FIXME: We should probably arrange to use the rpcndr.h boolean on Windows,
  58  * or get rid of our own boolean type.
  59  */
  60 #define boolean rpcndr_boolean
  61 #include <shlobj.h>
  62 #undef boolean
  63
  64 #include <math.h>
  65 #include <float.h>
  66
  67 #include <excpt.h>
  68
  69 #include "validate.h"
  70 #include "thread.h"
  71 size_t os_vm_page_size;
  72
  73 #include "gc.h"
  74 #include "gencgc-internal.h"
  75
  76 #if 0
  77 int linux_sparc_siginfo_bug = 0;
  78 int linux_supports_futex=0;
  79 #endif
  80
  81 /* The exception handling function looks like this: */
  82 EXCEPTION_DISPOSITION handle_exception(EXCEPTION_RECORD *,
  83                                        struct lisp_exception_frame *,
  84                                        CONTEXT *,
  85                                        void *);
  86
  87 void *base_seh_frame;
  88
  89 static void *get_seh_frame(void)
  90 {
  91     void* retval;
  92     asm volatile ("movl %%fs:0,%0": "=r" (retval));
  93     return retval;
  94 }
  95
  96 static void set_seh_frame(void *frame)
  97 {
  98     asm volatile ("movl %0,%%fs:0": : "r" (frame));
  99 }
 100
 101 #if 0
 102 static struct lisp_exception_frame *find_our_seh_frame(void)
 103 {
 104     struct lisp_exception_frame *frame = get_seh_frame();
 105
 106     while (frame->handler != handle_exception)
 107         frame = frame->next_frame;
 108
 109     return frame;
 110 }
 111
 112 inline static void *get_stack_frame(void)
 113 {
 114     void* retval;
 115     asm volatile ("movl %%ebp,%0": "=r" (retval));
 116     return retval;
 117 }
 118 #endif
 119
 120 void os_init(char *argv[], char *envp[])
 121 {
 122     SYSTEM_INFO system_info;
 123
 124     GetSystemInfo(&system_info);
 125     os_vm_page_size = system_info.dwPageSize;
 126
 127     base_seh_frame = get_seh_frame();
 128 }
 129
 130
 131 /*
 132  * So we have three fun scenarios here.
 133  *
 134  * First, we could be being called to reserve the memory areas
 135  * during initialization (prior to loading the core file).
 136  *
 137  * Second, we could be being called by the GC to commit a page
 138  * that has just been decommitted (for easy zero-fill).
 139  *
 140  * Third, we could be being called by create_thread_struct()
 141  * in order to create the sundry and various stacks.
 142  *
 143  * The third case is easy to pick out because it passes an
 144  * addr of 0.
 145  *
 146  * The second case is easy to pick out because it will be for
 147  * a range of memory that is MEM_RESERVE rather than MEM_FREE.
 148  *
 149  * The second case is also an easy implement, because we leave
 150  * the memory as reserved (since we do lazy commits).
 151  */
 152
 153 os_vm_address_t
 154 os_validate(os_vm_address_t addr, os_vm_size_t len)
 155 {
 156     MEMORY_BASIC_INFORMATION mem_info;
 157
 158     if (!addr) {
 159         /* the simple case first */
 160         os_vm_address_t real_addr;
 161         if (!(real_addr = VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE))) {
 162             fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
 163             return 0;
 164         }
 165
 166         return real_addr;
 167     }
 168
 169     if (!VirtualQuery(addr, &mem_info, sizeof mem_info)) {
 170         fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
 171         return 0;
 172     }
 173
 174     if ((mem_info.State == MEM_RESERVE) && (mem_info.RegionSize >=len)) return addr;
 175
 176     if (mem_info.State == MEM_RESERVE) {
 177         fprintf(stderr, "validation of reserved space too short.\n");
 178         fflush(stderr);
 179     }
 180
 181     if (!VirtualAlloc(addr, len, (mem_info.State == MEM_RESERVE)? MEM_COMMIT: MEM_RESERVE, PAGE_EXECUTE_READWRITE)) {
 182         fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
 183         return 0;
 184     }
 185
 186     return addr;
 187 }
 188
 189 /*
 190  * For os_invalidate(), we merely decommit the memory rather than
 191  * freeing the address space. This loses when freeing per-thread
 192  * data and related memory since it leaks address space. It's not
 193  * too lossy, however, since the two scenarios I'm aware of are
 194  * fd-stream buffers, which are pooled rather than torched, and
 195  * thread information, which I hope to pool (since windows creates
 196  * threads at its own whim, and we probably want to be able to
 197  * have them callback without funky magic on the part of the user,
 198  * and full-on thread allocation is fairly heavyweight). Someone
 199  * will probably shoot me down on this with some pithy comment on
 200  * the use of (setf symbol-value) on a special variable. I'm happy
 201  * for them.
 202  */
 203
 204 void
 205 os_invalidate(os_vm_address_t addr, os_vm_size_t len)
 206 {
 207     if (!VirtualFree(addr, len, MEM_DECOMMIT)) {
 208         fprintf(stderr, "VirtualFree: 0x%lx.\n", GetLastError());
 209     }
 210 }
 211
 212 /*
 213  * os_map() is called to map a chunk of the core file into memory.
 214  *
 215  * Unfortunately, Windows semantics completely screws this up, so
 216  * we just add backing store from the swapfile to where the chunk
 217  * goes and read it up like a normal file. We could consider using
 218  * a lazy read (demand page) setup, but that would mean keeping an
 219  * open file pointer for the core indefinately (and be one more
 220  * thing to maintain).
 221  */
 222
 223 os_vm_address_t
 224 os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
 225 {
 226     os_vm_size_t count;
 227
 228 #if 0
 229     fprintf(stderr, "os_map: %d, 0x%x, %p, 0x%x.\n", fd, offset, addr, len);
 230     fflush(stderr);
 231 #endif
 232
 233     if (!VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE)) {
 234         fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
 235         lose("os_map: VirtualAlloc failure");
 236     }
 237
 238     if (lseek(fd, offset, SEEK_SET) == -1) {
 239         lose("os_map: Seek failure.");
 240     }
 241
 242     count = read(fd, addr, len);
 243     if (count != len) {
 244         fprintf(stderr, "expected 0x%x, read 0x%x.\n", len, count);
 245         lose("os_map: Failed to read enough bytes.");
 246     }
 247
 248     return addr;
 249 }
 250
 251 static DWORD os_protect_modes[8] = {
 252     PAGE_NOACCESS,
 253     PAGE_READONLY,
 254     PAGE_READWRITE,
 255     PAGE_READWRITE,
 256     PAGE_EXECUTE,
 257     PAGE_EXECUTE_READ,
 258     PAGE_EXECUTE_READWRITE,
 259     PAGE_EXECUTE_READWRITE,
 260 };
 261
 262 void
 263 os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
 264 {
 265     DWORD old_prot;
 266
 267     if (!VirtualProtect(address, length, os_protect_modes[prot], &old_prot)) {
 268         fprintf(stderr, "VirtualProtect failed, code 0x%lx.\n", GetLastError());
 269         fflush(stderr);
 270     }
 271 }
 272
 273 /* FIXME: Now that FOO_END, rather than FOO_SIZE, is the fundamental
 274  * description of a space, we could probably punt this and just do
 275  * (FOO_START <= x && x < FOO_END) everywhere it's called. */
 276 static boolean
 277 in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
 278 {
 279     char* beg = (char*)((long)sbeg);
 280     char* end = (char*)((long)sbeg) + slen;
 281     char* adr = (char*)a;
 282     return (adr >= beg && adr < end);
 283 }
 284
 285 boolean
 286 is_linkage_table_addr(os_vm_address_t addr)
 287 {
 288     return in_range_p(addr, LINKAGE_TABLE_SPACE_START, LINKAGE_TABLE_SPACE_END);
 289 }
 290
 291 boolean
 292 is_valid_lisp_addr(os_vm_address_t addr)
 293 {
 294     struct thread *th;
 295     if(in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) ||
 296        in_range_p(addr, STATIC_SPACE_START   , STATIC_SPACE_SIZE) ||
 297        in_range_p(addr, DYNAMIC_SPACE_START  , dynamic_space_size))
 298         return 1;
 299     for_each_thread(th) {
 300         if(((os_vm_address_t)th->control_stack_start <= addr) && (addr < (os_vm_address_t)th->control_stack_end))
 301             return 1;
 302         if(in_range_p(addr, (unsigned long)th->binding_stack_start, BINDING_STACK_SIZE))
 303             return 1;
 304     }
 305     return 0;
 306 }
 307
 308 /* A tiny bit of interrupt.c state we want our paws on. */
 309 extern boolean internal_errors_enabled;
 310
 311 /*
 312  * A good explanation of the exception handling semantics is
 313  * http://win32assembly.online.fr/Exceptionhandling.html .
 314  */
 315
 316 EXCEPTION_DISPOSITION
 317 handle_exception(EXCEPTION_RECORD *exception_record,
 318                  struct lisp_exception_frame *exception_frame,
 319                  CONTEXT *context,
 320                  void *dispatcher_context)
 321 {
 322     if (exception_record->ExceptionFlags & (EH_UNWINDING | EH_EXIT_UNWIND)) {
 323         /* If we're being unwound, be graceful about it. */
 324
 325         /* Undo any dynamic bindings. */
 326         unbind_to_here(exception_frame->bindstack_pointer,
 327                        arch_os_get_current_thread());
 328
 329         return ExceptionContinueSearch;
 330     }
 331
 332     /* For EXCEPTION_ACCESS_VIOLATION only. */
 333     void *fault_address = (void *)exception_record->ExceptionInformation[1];
 334
 335     if (single_stepping &&
 336         exception_record->ExceptionCode == EXCEPTION_SINGLE_STEP) {
 337         /* We are doing a displaced instruction. At least function
 338          * end breakpoints uses this. */
 339         restore_breakpoint_from_single_step(context);
 340         return ExceptionContinueExecution;
 341     }
 342
 343     if (exception_record->ExceptionCode == EXCEPTION_BREAKPOINT) {
 344         /* This is just for info in case the monitor wants to print an
 345          * approximation. */
 346         current_control_stack_pointer =
 347             (lispobj *)*os_context_sp_addr(context);
 348         /* Unlike some other operating systems, Win32 leaves EIP
 349          * pointing to the breakpoint instruction. */
 350         context->Eip++;
 351         /* Now EIP points just after the INT3 byte and aims at the
 352          * 'kind' value (eg trap_Cerror). */
 353         trap = *(unsigned char *)(*os_context_pc_addr(context));
 354         handle_trap(context, trap);
 355         /* Done, we're good to go! */
 356         return ExceptionContinueExecution;
 357     }
 358     else if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION &&
 359              (is_valid_lisp_addr(fault_address) ||
 360               is_linkage_table_addr(fault_address))) {
 361         /* Pick off GC-related memory fault next. */
 362         MEMORY_BASIC_INFORMATION mem_info;
 363
 364         if (!VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
 365             fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
 366             lose("handle_exception: VirtualQuery failure");
 367         }
 368
 369         if (mem_info.State == MEM_RESERVE) {
 370             /* First use new page, lets get some memory for it. */
 371             if (!VirtualAlloc(mem_info.BaseAddress, os_vm_page_size,
 372                               MEM_COMMIT, PAGE_EXECUTE_READWRITE)) {
 373                 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
 374                 lose("handle_exception: VirtualAlloc failure");
 375
 376             } else {
 377                 /*
 378                  * Now, if the page is supposedly write-protected and this
 379                  * is a write, tell the gc that it's been hit.
 380                  *
 381                  * FIXME: Are we supposed to fall-through to the Lisp
 382                  * exception handler if the gc doesn't take the wp violation?
 383                  */
 384                 if (exception_record->ExceptionInformation[0]) {
 385                     int index = find_page_index(fault_address);
 386                     if ((index != -1) && (page_table[index].write_protected)) {
 387                         gencgc_handle_wp_violation(fault_address);
 388                     }
 389                 }
 390                 return ExceptionContinueExecution;
 391             }
 392
 393         } else if (gencgc_handle_wp_violation(fault_address)) {
 394             /* gc accepts the wp violation, so resume where we left off. */
 395             return ExceptionContinueExecution;
 396         }
 397
 398         /* All else failed, drop through to the lisp-side exception handler. */
 399     }
 400
 401     /*
 402      * If we fall through to here then we need to either forward
 403      * the exception to the lisp-side exception handler if it's
 404      * set up, or drop to LDB.
 405      */
 406
 407     if (internal_errors_enabled) {
 408         lispobj context_sap;
 409         lispobj exception_record_sap;
 410
 411         /* We're making the somewhat arbitrary decision that having
 412          * internal errors enabled means that lisp has sufficient
 413          * marbles to be able to handle exceptions, but exceptions
 414          * aren't supposed to happen during cold init or reinit
 415          * anyway. */
 416
 417         fake_foreign_function_call(context);
 418
 419         /* Allocate the SAP objects while the "interrupts" are still
 420          * disabled. */
 421         context_sap = alloc_sap(context);
 422         exception_record_sap = alloc_sap(exception_record);
 423
 424         /* The exception system doesn't automatically clear pending
 425          * exceptions, so we lose as soon as we execute any FP
 426          * instruction unless we do this first. */
 427         _clearfp();
 428
 429         /* Call into lisp to handle things. */
 430         funcall2(SymbolFunction(HANDLE_WIN32_EXCEPTION), context_sap,
 431                  exception_record_sap);
 432
 433         /* If Lisp doesn't nlx, we need to put things back. */
 434         undo_fake_foreign_function_call(context);
 435
 436         /* FIXME: HANDLE-WIN32-EXCEPTION should be allowed to decline */
 437         return ExceptionContinueExecution;
 438     }
 439
 440     fprintf(stderr, "Exception Code: 0x%lx.\n", exception_record->ExceptionCode);
 441     fprintf(stderr, "Faulting IP: 0x%lx.\n", (DWORD)exception_record->ExceptionAddress);
 442     if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) {
 443         MEMORY_BASIC_INFORMATION mem_info;
 444
 445         if (VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
 446             fprintf(stderr, "page status: 0x%lx.\n", mem_info.State);
 447         }
 448
 449         fprintf(stderr, "Was writing: %ld, where: 0x%lx.\n",
 450                 exception_record->ExceptionInformation[0],
 451                 (DWORD)fault_address);
 452     }
 453
 454     fflush(stderr);
 455
 456     fake_foreign_function_call(context);
 457     lose("Exception too early in cold init, cannot continue.");
 458
 459     /* FIXME: WTF? How are we supposed to end up here? */
 460     return ExceptionContinueSearch;
 461 }
 462
 463 void
 464 wos_install_interrupt_handlers(struct lisp_exception_frame *handler)
 465 {
 466     handler->next_frame = get_seh_frame();
 467     handler->handler = &handle_exception;
 468     set_seh_frame(handler);
 469 }
 470
 471 void bcopy(const void *src, void *dest, size_t n)
 472 {
 473     MoveMemory(dest, src, n);
 474 }
 475
 476 /*
 477  * The stubs below are replacements for the windows versions,
 478  * which can -fail- when used in our memory spaces because they
 479  * validate the memory spaces they are passed in a way that
 480  * denies our exception handler a chance to run.
 481  */
 482
 483 void *memmove(void *dest, const void *src, size_t n)
 484 {
 485     if (dest < src) {
 486         int i;
 487         for (i = 0; i < n; i++) *(((char *)dest)+i) = *(((char *)src)+i);
 488     } else {
 489         while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
 490     }
 491     return dest;
 492 }
 493
 494 void *memcpy(void *dest, const void *src, size_t n)
 495 {
 496     while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
 497     return dest;
 498 }
 499
 500 char *dirname(char *path)
 501 {
 502     static char buf[PATH_MAX + 1];
 503     size_t pathlen = strlen(path);
 504     int i;
 505
 506     if (pathlen >= sizeof(buf)) {
 507         lose("Pathname too long in dirname.\n");
 508         return NULL;
 509     }
 510
 511     strcpy(buf, path);
 512     for (i = pathlen; i >= 0; --i) {
 513         if (buf[i] == '/' || buf[i] == '\\') {
 514             buf[i] = '\0';
 515             break;
 516         }
 517     }
 518
 519     return buf;
 520 }
 521
 522 /* This is a manually-maintained version of ldso_stubs.S. */
 523
 524 void __stdcall RtlUnwind(void *, void *, void *, void *); /* I don't have winternl.h */
 525
 526 void scratch(void)
 527 {
 528     CloseHandle(0);
 529     FlushConsoleInputBuffer(0);
 530     FormatMessageA(0, 0, 0, 0, 0, 0, 0);
 531     FreeLibrary(0);
 532     GetACP();
 533     GetConsoleCP();
 534     GetConsoleOutputCP();
 535     GetCurrentProcess();
 536     GetExitCodeProcess(0, 0);
 537     GetLastError();
 538     GetOEMCP();
 539     GetProcAddress(0, 0);
 540     GetProcessTimes(0, 0, 0, 0, 0);
 541     GetSystemTimeAsFileTime(0);
 542     LoadLibrary(0);
 543     LocalFree(0);
 544     PeekConsoleInput(0, 0, 0, 0);
 545     PeekNamedPipe(0, 0, 0, 0, 0, 0);
 546     ReadFile(0, 0, 0, 0, 0);
 547     Sleep(0);
 548     WriteFile(0, 0, 0, 0, 0);
 549     _get_osfhandle(0);
 550     _pipe(0,0,0);
 551     access(0,0);
 552     acos(0);
 553     asin(0);
 554     close(0);
 555     cosh(0);
 556     dup(0);
 557     hypot(0, 0);
 558     isatty(0);
 559     sinh(0);
 560     strerror(42);
 561     write(0, 0, 0);
 562     RtlUnwind(0, 0, 0, 0);
 563     #ifndef LISP_FEATURE_SB_UNICODE
 564       CreateDirectoryA(0,0);
 565       GetComputerNameA(0, 0);
 566       GetCurrentDirectoryA(0,0);
 567       GetEnvironmentVariableA(0, 0, 0);
 568       GetVersionExA(0);
 569       MoveFileA(0,0);
 570       SHGetFolderPathA(0, 0, 0, 0, 0);
 571       SetCurrentDirectoryA(0);
 572       SetEnvironmentVariableA(0, 0);
 573     #else
 574       CreateDirectoryW(0,0);
 575       FormatMessageW(0, 0, 0, 0, 0, 0, 0);
 576       GetComputerNameW(0, 0);
 577       GetCurrentDirectoryW(0,0);
 578       GetEnvironmentVariableW(0, 0, 0);
 579       GetVersionExW(0);
 580       MoveFileW(0,0);
 581       SHGetFolderPathW(0, 0, 0, 0, 0);
 582       SetCurrentDirectoryW(0);
 583       SetEnvironmentVariableW(0, 0);
 584     #endif
 585 }
 586
 587 char *
 588 os_get_runtime_executable_path()
 589 {
 590     char path[MAX_PATH + 1];
 591     DWORD bufsize = sizeof(path);
 592     DWORD size;
 593
 594     if ((size = GetModuleFileNameA(NULL, path, bufsize)) == 0)
 595         return NULL;
 596     else if (size == bufsize && GetLastError() == ERROR_INSUFFICIENT_BUFFER)
 597         return NULL;
 598
 599     return copied_string(path);
 600 }
 601
 602 /* EOF */