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
  47 #include <sys/types.h>
  48 #include <signal.h>
  49 #include <sys/time.h>
  50 #include <sys/stat.h>
  51 #include <unistd.h>
  52
  53 /* KLUDGE: Avoid double definition of boolean by rpcndr.h included via
  54  * shlobj.h.
  55  *
  56  * FIXME: We should probably arrange to use the rpcndr.h boolean on Windows,
  57  * or get rid of our own boolean type.
  58  */
  59 #define boolean rpcndr_boolean
  60 #include <shlobj.h>
  61 #undef boolean
  62
  63 #include <math.h>
  64 #include <float.h>
  65
  66 #include <excpt.h>
  67
  68 #include "validate.h"
  69 #include "thread.h"
  70 size_t os_vm_page_size;
  71
  72 #include "gc.h"
  73 #include "gencgc-internal.h"
  74
  75 #if 0
  76 int linux_sparc_siginfo_bug = 0;
  77 int linux_supports_futex=0;
  78 #endif
  79
  80 /* The exception handling function looks like this: */
  81 EXCEPTION_DISPOSITION handle_exception(EXCEPTION_RECORD *,
  82                                        struct lisp_exception_frame *,
  83                                        CONTEXT *,
  84                                        void *);
  85
  86 void *base_seh_frame;
  87
  88 static void *get_seh_frame(void)
  89 {
  90     void* retval;
  91     asm volatile ("movl %%fs:0,%0": "=r" (retval));
  92     return retval;
  93 }
  94
  95 static void set_seh_frame(void *frame)
  96 {
  97     asm volatile ("movl %0,%%fs:0": : "r" (frame));
  98 }
  99
 100 #if 0
 101 static struct lisp_exception_frame *find_our_seh_frame(void)
 102 {
 103     struct lisp_exception_frame *frame = get_seh_frame();
 104
 105     while (frame->handler != handle_exception)
 106         frame = frame->next_frame;
 107
 108     return frame;
 109 }
 110
 111 inline static void *get_stack_frame(void)
 112 {
 113     void* retval;
 114     asm volatile ("movl %%ebp,%0": "=r" (retval));
 115     return retval;
 116 }
 117 #endif
 118
 119 void os_init(char *argv[], char *envp[])
 120 {
 121     SYSTEM_INFO system_info;
 122
 123     GetSystemInfo(&system_info);
 124     os_vm_page_size = system_info.dwPageSize;
 125
 126     base_seh_frame = get_seh_frame();
 127 }
 128
 129
 130 /*
 131  * So we have three fun scenarios here.
 132  *
 133  * First, we could be being called to reserve the memory areas
 134  * during initialization (prior to loading the core file).
 135  *
 136  * Second, we could be being called by the GC to commit a page
 137  * that has just been decommitted (for easy zero-fill).
 138  *
 139  * Third, we could be being called by create_thread_struct()
 140  * in order to create the sundry and various stacks.
 141  *
 142  * The third case is easy to pick out because it passes an
 143  * addr of 0.
 144  *
 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.
 147  *
 148  * The second case is also an easy implement, because we leave
 149  * the memory as reserved (since we do lazy commits).
 150  */
 151
 152 os_vm_address_t
 153 os_validate(os_vm_address_t addr, os_vm_size_t len)
 154 {
 155     MEMORY_BASIC_INFORMATION mem_info;
 156
 157     if (!addr) {
 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());
 162             return 0;
 163         }
 164
 165         return real_addr;
 166     }
 167
 168     if (!VirtualQuery(addr, &mem_info, sizeof mem_info)) {
 169         fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
 170         return 0;
 171     }
 172
 173     if ((mem_info.State == MEM_RESERVE) && (mem_info.RegionSize >=len)) return addr;
 174
 175     if (mem_info.State == MEM_RESERVE) {
 176         fprintf(stderr, "validation of reserved space too short.\n");
 177         fflush(stderr);
 178     }
 179
 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());
 182         return 0;
 183     }
 184
 185     return addr;
 186 }
 187
 188 /*
 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
 200  * for them.
 201  */
 202
 203 void
 204 os_invalidate(os_vm_address_t addr, os_vm_size_t len)
 205 {
 206     if (!VirtualFree(addr, len, MEM_DECOMMIT)) {
 207         fprintf(stderr, "VirtualFree: 0x%lx.\n", GetLastError());
 208     }
 209 }
 210
 211 /*
 212  * os_map() is called to map a chunk of the core file into memory.
 213  *
 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).
 220  */
 221
 222 os_vm_address_t
 223 os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
 224 {
 225     os_vm_size_t count;
 226
 227 #if 0
 228     fprintf(stderr, "os_map: %d, 0x%x, %p, 0x%x.\n", fd, offset, addr, len);
 229     fflush(stderr);
 230 #endif
 231
 232     if (!VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE)) {
 233         fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
 234         lose("os_map: VirtualAlloc failure");
 235     }
 236
 237     if (lseek(fd, offset, SEEK_SET) == -1) {
 238         lose("os_map: Seek failure.");
 239     }
 240
 241     count = read(fd, addr, len);
 242     if (count != len) {
 243         fprintf(stderr, "expected 0x%x, read 0x%x.\n", len, count);
 244         lose("os_map: Failed to read enough bytes.");
 245     }
 246
 247     return addr;
 248 }
 249
 250 static DWORD os_protect_modes[8] = {
 251     PAGE_NOACCESS,
 252     PAGE_READONLY,
 253     PAGE_READWRITE,
 254     PAGE_READWRITE,
 255     PAGE_EXECUTE,
 256     PAGE_EXECUTE_READ,
 257     PAGE_EXECUTE_READWRITE,
 258     PAGE_EXECUTE_READWRITE,
 259 };
 260
 261 void
 262 os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
 263 {
 264     DWORD old_prot;
 265
 266     if (!VirtualProtect(address, length, os_protect_modes[prot], &old_prot)) {
 267         fprintf(stderr, "VirtualProtect failed, code 0x%lx.\n", GetLastError());
 268         fflush(stderr);
 269     }
 270 }
 271
 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. */
 275 static boolean
 276 in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
 277 {
 278     char* beg = (char*)((long)sbeg);
 279     char* end = (char*)((long)sbeg) + slen;
 280     char* adr = (char*)a;
 281     return (adr >= beg && adr < end);
 282 }
 283
 284 boolean
 285 is_linkage_table_addr(os_vm_address_t addr)
 286 {
 287     return in_range_p(addr, LINKAGE_TABLE_SPACE_START, LINKAGE_TABLE_SPACE_END);
 288 }
 289
 290 boolean
 291 is_valid_lisp_addr(os_vm_address_t addr)
 292 {
 293     struct thread *th;
 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))
 297         return 1;
 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))
 300             return 1;
 301         if(in_range_p(addr, (unsigned long)th->binding_stack_start, BINDING_STACK_SIZE))
 302             return 1;
 303     }
 304     return 0;
 305 }
 306
 307 /*
 308  * any OS-dependent special low-level handling for signals
 309  */
 310
 311 /* A tiny bit of interrupt.c state we want our paws on. */
 312 extern boolean internal_errors_enabled;
 313
 314 /*
 315  * A good explanation of the exception handling semantics is
 316  * http://win32assembly.online.fr/Exceptionhandling.html .
 317  */
 318
 319 EXCEPTION_DISPOSITION
 320 handle_exception(EXCEPTION_RECORD *exception_record,
 321                  struct lisp_exception_frame *exception_frame,
 322                  CONTEXT *context,
 323                  void *dc) /* FIXME: What's dc again? */
 324 {
 325     /* For EXCEPTION_ACCESS_VIOLATION only. */
 326     void *fault_address = (void *)exception_record->ExceptionInformation[1];
 327
 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;
 334     }
 335
 336     if (exception_record->ExceptionCode == EXCEPTION_BREAKPOINT) {
 337         /* Pick off sigtrap case first. */
 338
 339         extern void sigtrap_handler(int signal, siginfo_t *info, void *context);
 340         /*
 341          * Unlike some other operating systems, Win32 leaves EIP
 342          * pointing to the breakpoint instruction.
 343          */
 344         context->Eip++;
 345
 346         sigtrap_handler(0, NULL, context);
 347
 348         return ExceptionContinueExecution;
 349     }
 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;
 355
 356         if (!VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
 357             fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
 358             lose("handle_exception: VirtualQuery failure");
 359         }
 360
 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");
 367
 368             } else {
 369                 /*
 370                  * Now, if the page is supposedly write-protected and this
 371                  * is a write, tell the gc that it's been hit.
 372                  *
 373                  * FIXME: Are we supposed to fall-through to the Lisp
 374                  * exception handler if the gc doesn't take the wp violation?
 375                  */
 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);
 380                     }
 381                 }
 382                 return ExceptionContinueExecution;
 383             }
 384
 385         } else if (gencgc_handle_wp_violation(fault_address)) {
 386             /* gc accepts the wp violation, so resume where we left off. */
 387             return ExceptionContinueExecution;
 388         }
 389
 390         /* All else failed, drop through to the lisp-side exception handler. */
 391     }
 392
 393     /*
 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.
 397      */
 398
 399     if (internal_errors_enabled) {
 400         lispobj context_sap;
 401         lispobj exception_record_sap;
 402
 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
 407          * anyway. */
 408
 409         fake_foreign_function_call(context);
 410
 411         /* Allocate the SAP objects while the "interrupts" are still
 412          * disabled. */
 413         context_sap = alloc_sap(context);
 414         exception_record_sap = alloc_sap(exception_record);
 415
 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. */
 419         _clearfp();
 420
 421         /* Call into lisp to handle things. */
 422         funcall2(SymbolFunction(HANDLE_WIN32_EXCEPTION), context_sap,
 423                  exception_record_sap);
 424
 425         /* If Lisp doesn't nlx, we need to put things back. */
 426         undo_fake_foreign_function_call(context);
 427
 428         /* FIXME: HANDLE-WIN32-EXCEPTION should be allowed to decline */
 429         return ExceptionContinueExecution;
 430     }
 431
 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;
 436
 437         if (VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
 438             fprintf(stderr, "page status: 0x%lx.\n", mem_info.State);
 439         }
 440
 441         fprintf(stderr, "Was writing: %ld, where: 0x%lx.\n",
 442                 exception_record->ExceptionInformation[0],
 443                 (DWORD)fault_address);
 444     }
 445
 446     fflush(stderr);
 447
 448     fake_foreign_function_call(context);
 449     lose("fake_foreign_function_call fell through");
 450
 451     /* FIXME: WTF? How are we supposed to end up here? */
 452     return ExceptionContinueSearch;
 453 }
 454
 455 void
 456 wos_install_interrupt_handlers(struct lisp_exception_frame *handler)
 457 {
 458     handler->next_frame = get_seh_frame();
 459     handler->handler = &handle_exception;
 460     set_seh_frame(handler);
 461 }
 462
 463 void bcopy(const void *src, void *dest, size_t n)
 464 {
 465     MoveMemory(dest, src, n);
 466 }
 467
 468 /*
 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.
 473  */
 474
 475 void *memmove(void *dest, const void *src, size_t n)
 476 {
 477     if (dest < src) {
 478         int i;
 479         for (i = 0; i < n; i++) *(((char *)dest)+i) = *(((char *)src)+i);
 480     } else {
 481         while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
 482     }
 483     return dest;
 484 }
 485
 486 void *memcpy(void *dest, const void *src, size_t n)
 487 {
 488     while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
 489     return dest;
 490 }
 491
 492 char *dirname(char *path)
 493 {
 494     static char buf[PATH_MAX + 1];
 495     size_t pathlen = strlen(path);
 496     int i;
 497
 498     if (pathlen >= sizeof(buf)) {
 499         lose("Pathname too long in dirname.\n");
 500         return NULL;
 501     }
 502
 503     strcpy(buf, path);
 504     for (i = pathlen; i >= 0; --i) {
 505         if (buf[i] == '/' || buf[i] == '\\') {
 506             buf[i] = '\0';
 507             break;
 508         }
 509     }
 510
 511     return buf;
 512 }
 513
 514 /* This is a manually-maintained version of ldso_stubs.S. */
 515
 516 void __stdcall RtlUnwind(void *, void *, void *, void *); /* I don't have winternl.h */
 517
 518 void scratch(void)
 519 {
 520     CloseHandle(0);
 521     FlushConsoleInputBuffer(0);
 522     FormatMessageA(0, 0, 0, 0, 0, 0, 0);
 523     FreeLibrary(0);
 524     GetACP();
 525     GetConsoleCP();
 526     GetConsoleOutputCP();
 527     GetCurrentProcess();
 528     GetExitCodeProcess(0, 0);
 529     GetLastError();
 530     GetOEMCP();
 531     GetProcAddress(0, 0);
 532     GetProcessTimes(0, 0, 0, 0, 0);
 533     GetSystemTimeAsFileTime(0);
 534     LoadLibrary(0);
 535     LocalFree(0);
 536     PeekConsoleInput(0, 0, 0, 0);
 537     PeekNamedPipe(0, 0, 0, 0, 0, 0);
 538     ReadFile(0, 0, 0, 0, 0);
 539     Sleep(0);
 540     WriteFile(0, 0, 0, 0, 0);
 541     _get_osfhandle(0);
 542     _pipe(0,0,0);
 543     access(0,0);
 544     acos(0);
 545     asin(0);
 546     close(0);
 547     cosh(0);
 548     dup(0);
 549     hypot(0, 0);
 550     isatty(0);
 551     sinh(0);
 552     strerror(42);
 553     write(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);
 560       GetVersionExA(0);
 561       MoveFileA(0,0);
 562       SHGetFolderPathA(0, 0, 0, 0, 0);
 563       SetCurrentDirectoryA(0);
 564       SetEnvironmentVariableA(0, 0);
 565     #else
 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);
 571       GetVersionExW(0);
 572       MoveFileW(0,0);
 573       SHGetFolderPathW(0, 0, 0, 0, 0);
 574       SetCurrentDirectoryW(0);
 575       SetEnvironmentVariableW(0, 0);
 576     #endif
 577 }
 578
 579 char *
 580 os_get_runtime_executable_path()
 581 {
 582     char path[MAX_PATH + 1];
 583     DWORD bufsize = sizeof(path);
 584     DWORD size;
 585
 586     if ((size = GetModuleFileNameA(NULL, path, bufsize)) == 0)
 587         return NULL;
 588     else if (size == bufsize && GetLastError() == ERROR_INSUFFICIENT_BUFFER)
 589         return NULL;
 590
 591     return copied_string(path);
 592 }
 593
 594 /* EOF */