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
  65 #include <excpt.h>
  66
  67 #include "validate.h"
  68 #include "thread.h"
  69 size_t os_vm_page_size;
  70
  71 #include "gc.h"
  72 #include "gencgc-internal.h"
  73
  74 #if 0
  75 int linux_sparc_siginfo_bug = 0;
  76 int linux_supports_futex=0;
  77 #endif
  78
  79 /* The exception handling function looks like this: */
  80 EXCEPTION_DISPOSITION handle_exception(EXCEPTION_RECORD *,
  81                                        struct lisp_exception_frame *,
  82                                        CONTEXT *,
  83                                        void *);
  84
  85 void *base_seh_frame;
  86
  87 static void *get_seh_frame(void)
  88 {
  89     void* retval;
  90     asm volatile ("movl %%fs:0,%0": "=r" (retval));
  91     return retval;
  92 }
  93
  94 static void set_seh_frame(void *frame)
  95 {
  96     asm volatile ("movl %0,%%fs:0": : "r" (frame));
  97 }
  98
  99 static struct lisp_exception_frame *find_our_seh_frame(void)
 100 {
 101     struct lisp_exception_frame *frame = get_seh_frame();
 102
 103     while (frame->handler != handle_exception)
 104         frame = frame->next_frame;
 105
 106     return frame;
 107 }
 108
 109 #if 0
 110 inline static void *get_stack_frame(void)
 111 {
 112     void* retval;
 113     asm volatile ("movl %%ebp,%0": "=r" (retval));
 114     return retval;
 115 }
 116 #endif
 117
 118 void os_init(char *argv[], char *envp[])
 119 {
 120     SYSTEM_INFO system_info;
 121
 122     GetSystemInfo(&system_info);
 123     os_vm_page_size = system_info.dwPageSize;
 124
 125     base_seh_frame = get_seh_frame();
 126 }
 127
 128
 129 /*
 130  * So we have three fun scenarios here.
 131  *
 132  * First, we could be being called to reserve the memory areas
 133  * during initialization (prior to loading the core file).
 134  *
 135  * Second, we could be being called by the GC to commit a page
 136  * that has just been decommitted (for easy zero-fill).
 137  *
 138  * Third, we could be being called by create_thread_struct()
 139  * in order to create the sundry and various stacks.
 140  *
 141  * The third case is easy to pick out because it passes an
 142  * addr of 0.
 143  *
 144  * The second case is easy to pick out because it will be for
 145  * a range of memory that is MEM_RESERVE rather than MEM_FREE.
 146  *
 147  * The second case is also an easy implement, because we leave
 148  * the memory as reserved (since we do lazy commits).
 149  */
 150
 151 os_vm_address_t
 152 os_validate(os_vm_address_t addr, os_vm_size_t len)
 153 {
 154     MEMORY_BASIC_INFORMATION mem_info;
 155
 156     if (!addr) {
 157         /* the simple case first */
 158         os_vm_address_t real_addr;
 159         if (!(real_addr = VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE))) {
 160             fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
 161             return 0;
 162         }
 163
 164         return real_addr;
 165     }
 166
 167     if (!VirtualQuery(addr, &mem_info, sizeof mem_info)) {
 168         fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
 169         return 0;
 170     }
 171
 172     if ((mem_info.State == MEM_RESERVE) && (mem_info.RegionSize >=len)) return addr;
 173
 174     if (mem_info.State == MEM_RESERVE) {
 175         fprintf(stderr, "validation of reserved space too short.\n");
 176         fflush(stderr);
 177     }
 178
 179     if (!VirtualAlloc(addr, len, (mem_info.State == MEM_RESERVE)? MEM_COMMIT: MEM_RESERVE, PAGE_EXECUTE_READWRITE)) {
 180         fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
 181         return 0;
 182     }
 183
 184     return addr;
 185 }
 186
 187 /*
 188  * For os_invalidate(), we merely decommit the memory rather than
 189  * freeing the address space. This loses when freeing per-thread
 190  * data and related memory since it leaks address space. It's not
 191  * too lossy, however, since the two scenarios I'm aware of are
 192  * fd-stream buffers, which are pooled rather than torched, and
 193  * thread information, which I hope to pool (since windows creates
 194  * threads at its own whim, and we probably want to be able to
 195  * have them callback without funky magic on the part of the user,
 196  * and full-on thread allocation is fairly heavyweight). Someone
 197  * will probably shoot me down on this with some pithy comment on
 198  * the use of (setf symbol-value) on a special variable. I'm happy
 199  * for them.
 200  */
 201
 202 void
 203 os_invalidate(os_vm_address_t addr, os_vm_size_t len)
 204 {
 205     if (!VirtualFree(addr, len, MEM_DECOMMIT)) {
 206         fprintf(stderr, "VirtualFree: 0x%lx.\n", GetLastError());
 207     }
 208 }
 209
 210 /*
 211  * os_map() is called to map a chunk of the core file into memory.
 212  *
 213  * Unfortunately, Windows semantics completely screws this up, so
 214  * we just add backing store from the swapfile to where the chunk
 215  * goes and read it up like a normal file. We could consider using
 216  * a lazy read (demand page) setup, but that would mean keeping an
 217  * open file pointer for the core indefinately (and be one more
 218  * thing to maintain).
 219  */
 220
 221 os_vm_address_t
 222 os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len)
 223 {
 224     os_vm_size_t count;
 225
 226 #if 0
 227     fprintf(stderr, "os_map: %d, 0x%x, %p, 0x%x.\n", fd, offset, addr, len);
 228     fflush(stderr);
 229 #endif
 230
 231     if (!VirtualAlloc(addr, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE)) {
 232         fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
 233         lose("os_map: VirtualAlloc failure");
 234     }
 235
 236     if (lseek(fd, offset, SEEK_SET) == -1) {
 237         lose("os_map: Seek failure.");
 238     }
 239
 240     count = read(fd, addr, len);
 241     if (count != len) {
 242         fprintf(stderr, "expected 0x%x, read 0x%x.\n", len, count);
 243         lose("os_map: Failed to read enough bytes.");
 244     }
 245
 246     return addr;
 247 }
 248
 249 static DWORD os_protect_modes[8] = {
 250     PAGE_NOACCESS,
 251     PAGE_READONLY,
 252     PAGE_READWRITE,
 253     PAGE_READWRITE,
 254     PAGE_EXECUTE,
 255     PAGE_EXECUTE_READ,
 256     PAGE_EXECUTE_READWRITE,
 257     PAGE_EXECUTE_READWRITE,
 258 };
 259
 260 void
 261 os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot)
 262 {
 263     DWORD old_prot;
 264
 265     if (!VirtualProtect(address, length, os_protect_modes[prot], &old_prot)) {
 266         fprintf(stderr, "VirtualProtect failed, code 0x%lx.\n", GetLastError());
 267         fflush(stderr);
 268     }
 269 }
 270
 271 /* FIXME: Now that FOO_END, rather than FOO_SIZE, is the fundamental
 272  * description of a space, we could probably punt this and just do
 273  * (FOO_START <= x && x < FOO_END) everywhere it's called. */
 274 static boolean
 275 in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
 276 {
 277     char* beg = (char*)((long)sbeg);
 278     char* end = (char*)((long)sbeg) + slen;
 279     char* adr = (char*)a;
 280     return (adr >= beg && adr < end);
 281 }
 282
 283 boolean
 284 is_linkage_table_addr(os_vm_address_t addr)
 285 {
 286     return in_range_p(addr, LINKAGE_TABLE_SPACE_START, LINKAGE_TABLE_SPACE_END);
 287 }
 288
 289 boolean
 290 is_valid_lisp_addr(os_vm_address_t addr)
 291 {
 292     struct thread *th;
 293     if(in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) ||
 294        in_range_p(addr, STATIC_SPACE_START   , STATIC_SPACE_SIZE) ||
 295        in_range_p(addr, DYNAMIC_SPACE_START  , dynamic_space_size))
 296         return 1;
 297     for_each_thread(th) {
 298         if(((os_vm_address_t)th->control_stack_start <= addr) && (addr < (os_vm_address_t)th->control_stack_end))
 299             return 1;
 300         if(in_range_p(addr, (unsigned long)th->binding_stack_start, BINDING_STACK_SIZE))
 301             return 1;
 302     }
 303     return 0;
 304 }
 305
 306 /*
 307  * any OS-dependent special low-level handling for signals
 308  */
 309
 310 /* A tiny bit of interrupt.c state we want our paws on. */
 311 extern boolean internal_errors_enabled;
 312
 313 /*
 314  * FIXME: There is a potential problem with foreign code here.
 315  * If we are running foreign code instead of lisp code and an
 316  * exception occurs we arrange a call into Lisp. If the
 317  * foreign code has installed an exception handler, we run the
 318  * very great risk of throwing through their exception handler
 319  * without asking it to unwind. This is more a problem with
 320  * non-sigtrap (EXCEPTION_BREAKPOINT) exceptions, as they could
 321  * reasonably be expected to happen in foreign code. We need to
 322  * figure out the exception handler unwind semantics and adhere
 323  * to them (probably by abusing the Lisp unwind-protect system)
 324  * if we are going to handle this scenario correctly.
 325  *
 326  * A good explanation of the exception handling semantics is
 327  * http://win32assembly.online.fr/Exceptionhandling.html .
 328  * We will also need to handle this ourselves when foreign
 329  * code tries to unwind -us-.
 330  *
 331  * When unwinding through foreign code we should unwind the
 332  * Lisp stack to the entry from foreign code, then unwind the
 333  * foreign code stack to the entry from Lisp, then resume
 334  * unwinding in Lisp.
 335  */
 336
 337 EXCEPTION_DISPOSITION
 338 sigtrap_emulator(CONTEXT *context,
 339                  struct lisp_exception_frame *exception_frame)
 340 {
 341     if (*((char *)context->Eip + 1) == trap_ContextRestore) {
 342         /* This is the cleanup for what is immediately below, and
 343          * for the generic exception handling further below. We
 344          * have to memcpy() the original context (emulated sigtrap
 345          * or normal exception) over our context and resume it. */
 346         memcpy(context, &exception_frame->context, sizeof(CONTEXT));
 347         return ExceptionContinueExecution;
 348
 349     } else {
 350         /* Not a trap_ContextRestore, must be a sigtrap.
 351          * sigtrap_trampoline is defined in x86-assem.S. */
 352         extern void sigtrap_trampoline;
 353
 354         /*
 355          * Unlike some other operating systems, Win32 leaves EIP
 356          * pointing to the breakpoint instruction.
 357          */
 358         context->Eip++;
 359
 360         /* We're not on an alternate stack like we would be in some
 361          * other operating systems, and we don't want to risk leaking
 362          * any important resources if we throw out of the sigtrap
 363          * handler, so we need to copy off our context to a "safe"
 364          * place and then monkey with the return EIP to point to a
 365          * trampoline which calls another function which copies the
 366          * context out to a really-safe place and then calls the real
 367          * sigtrap handler. When the real sigtrap handler returns, the
 368          * trampoline then contains another breakpoint with a code of
 369          * trap_ContextRestore (see above). Essentially the same
 370          * mechanism is used by the generic exception path. There is
 371          * a small window of opportunity between us copying the
 372          * context to the "safe" place and the sigtrap wrapper copying
 373          * it to the really-safe place (allocated in its stack frame)
 374          * during which the context can be smashed. The only scenario
 375          * I can come up with for this, however, involves a stack
 376          * overflow occuring at just the wrong time (which makes one
 377          * wonder how stack overflow exceptions even happen, given
 378          * that we don't switch stacks for exception processing...) */
 379         memcpy(&exception_frame->context, context, sizeof(CONTEXT));
 380
 381         /* FIXME: Why do we save the old EIP in EAX? The sigtrap_trampoline
 382          * pushes it into stack, but the sigtrap_wrapper where the trampoline
 383          * goes ignores it, and after the wrapper we hit the trap_ContextRestore,
 384          * which nukes the whole context with the original one?
 385          *
 386          * Am I misreading this, or is the EAX here and in the
 387          * trampoline superfluous? --NS 20061024 */
 388         context->Eax = context->Eip;
 389         context->Eip = (unsigned long)&sigtrap_trampoline;
 390
 391         /* and return */
 392         return ExceptionContinueExecution;
 393     }
 394 }
 395
 396 void sigtrap_wrapper(void)
 397 {
 398     /*
 399      * This is the wrapper around the sigtrap handler called from
 400      * the trampoline returned to from the function above.
 401      *
 402      * There actually is a point to some of the commented-out code
 403      * in this function, although it really belongs to the callback
 404      * wrappers. Once it is installed there, it can probably be
 405      * removed from here.
 406      */
 407     extern void sigtrap_handler(int signal, siginfo_t *info, void *context);
 408
 409 /*     volatile struct { */
 410 /*      void *handler[2]; */
 411     CONTEXT context;
 412 /*     } handler; */
 413
 414     struct lisp_exception_frame *frame = find_our_seh_frame();
 415
 416 /*     wos_install_interrupt_handlers(handler); */
 417 /*     handler.handler[0] = get_seh_frame(); */
 418 /*     handler.handler[1] = &handle_exception; */
 419 /*     set_seh_frame(&handler); */
 420
 421     memcpy(&context, &frame->context, sizeof(CONTEXT));
 422     sigtrap_handler(0, NULL, &context);
 423     memcpy(&frame->context, &context, sizeof(CONTEXT));
 424
 425 /*     set_seh_frame(handler.handler[0]); */
 426 }
 427
 428 EXCEPTION_DISPOSITION
 429 handle_exception(EXCEPTION_RECORD *exception_record,
 430                  struct lisp_exception_frame *exception_frame,
 431                  CONTEXT *context,
 432                  void *dc) /* FIXME: What's dc again? */
 433 {
 434     /* For EXCEPTION_ACCESS_VIOLATION only. */
 435     void *fault_address = (void *)exception_record->ExceptionInformation[1];
 436
 437     if (single_stepping &&
 438         exception_record->ExceptionCode == EXCEPTION_SINGLE_STEP) {
 439         /* We are doing a displaced instruction. At least function
 440          * end breakpoints uses this. */
 441         restore_breakpoint_from_single_step(context);
 442         return ExceptionContinueExecution;
 443     }
 444
 445     if (exception_record->ExceptionCode == EXCEPTION_BREAKPOINT) {
 446         /* Pick off sigtrap case first. */
 447         return sigtrap_emulator(context, exception_frame);
 448     }
 449     else if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION &&
 450              (is_valid_lisp_addr(fault_address) ||
 451               is_linkage_table_addr(fault_address))) {
 452         /* Pick off GC-related memory fault next. */
 453         MEMORY_BASIC_INFORMATION mem_info;
 454
 455         if (!VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
 456             fprintf(stderr, "VirtualQuery: 0x%lx.\n", GetLastError());
 457             lose("handle_exception: VirtualQuery failure");
 458         }
 459
 460         if (mem_info.State == MEM_RESERVE) {
 461             /* First use new page, lets get some memory for it. */
 462             if (!VirtualAlloc(mem_info.BaseAddress, os_vm_page_size,
 463                               MEM_COMMIT, PAGE_EXECUTE_READWRITE)) {
 464                 fprintf(stderr, "VirtualAlloc: 0x%lx.\n", GetLastError());
 465                 lose("handle_exception: VirtualAlloc failure");
 466
 467             } else {
 468                 /*
 469                  * Now, if the page is supposedly write-protected and this
 470                  * is a write, tell the gc that it's been hit.
 471                  *
 472                  * FIXME: Are we supposed to fall-through to the Lisp
 473                  * exception handler if the gc doesn't take the wp violation?
 474                  */
 475                 if (exception_record->ExceptionInformation[0]) {
 476                     int index = find_page_index(fault_address);
 477                     if ((index != -1) && (page_table[index].write_protected)) {
 478                         gencgc_handle_wp_violation(fault_address);
 479                     }
 480                 }
 481                 return ExceptionContinueExecution;
 482             }
 483
 484         } else if (gencgc_handle_wp_violation(fault_address)) {
 485             /* gc accepts the wp violation, so resume where we left off. */
 486             return ExceptionContinueExecution;
 487         }
 488
 489         /* All else failed, drop through to the lisp-side exception handler. */
 490     }
 491
 492     /*
 493      * If we fall through to here then we need to either forward
 494      * the exception to the lisp-side exception handler if it's
 495      * set up, or drop to LDB.
 496      */
 497
 498     if (internal_errors_enabled) {
 499         /* exception_trampoline is defined in x86-assem.S. */
 500         extern void exception_trampoline;
 501
 502         /* We're making the somewhat arbitrary decision that having
 503          * internal errors enabled means that lisp has sufficient
 504          * marbles to be able to handle exceptions, but xceptions
 505          * aren't supposed to happen during cold init or reinit
 506          * anyway.
 507          *
 508          * We use the same mechanism as the sigtrap emulator above
 509          * with just a couple changes. We obviously use a different
 510          * trampoline and wrapper function, we kill out any live
 511          * floating point exceptions, and we save off the exception
 512          * record as well as the context. */
 513
 514         /* Save off context and exception information */
 515         memcpy(&exception_frame->context, context, sizeof(CONTEXT));
 516         memcpy(&exception_frame->exception, exception_record, sizeof(EXCEPTION_RECORD));
 517
 518         /* Set up to activate trampoline when we return
 519          *
 520          * FIXME: Why do we save the old EIP in EAX? The
 521          * exception_trampoline pushes it into stack, but the wrapper
 522          * where the trampoline goes ignores it, and then the wrapper
 523          * unwinds from Lisp... WTF?
 524          *
 525          * Am I misreading this, or is the EAX here and in the
 526          * trampoline superfluous? --NS 20061024 */
 527         context->Eax = context->Eip;
 528         context->Eip = (unsigned long)&exception_trampoline;
 529
 530         /* Make sure a floating-point trap doesn't kill us */
 531         context->FloatSave.StatusWord &= ~0x3f;
 532
 533         /* And return. */
 534         return ExceptionContinueExecution;
 535     }
 536
 537     fprintf(stderr, "Exception Code: 0x%lx.\n", exception_record->ExceptionCode);
 538     fprintf(stderr, "Faulting IP: 0x%lx.\n", (DWORD)exception_record->ExceptionAddress);
 539     if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) {
 540         MEMORY_BASIC_INFORMATION mem_info;
 541
 542         if (VirtualQuery(fault_address, &mem_info, sizeof mem_info)) {
 543             fprintf(stderr, "page status: 0x%lx.\n", mem_info.State);
 544         }
 545
 546         fprintf(stderr, "Was writing: %ld, where: 0x%lx.\n",
 547                 exception_record->ExceptionInformation[0],
 548                 (DWORD)fault_address);
 549     }
 550
 551     fflush(stderr);
 552
 553     fake_foreign_function_call(context);
 554     lose("fake_foreign_function_call fell through");
 555
 556     /* FIXME: WTF? How are we supposed to end up here? */
 557     return ExceptionContinueSearch;
 558 }
 559
 560 void handle_win32_exception_wrapper(void)
 561 {
 562     struct lisp_exception_frame *frame = find_our_seh_frame();
 563     CONTEXT context;
 564     EXCEPTION_RECORD exception_record;
 565     lispobj context_sap;
 566     lispobj exception_record_sap;
 567
 568     memcpy(&context, &frame->context, sizeof(CONTEXT));
 569     memcpy(&exception_record, &frame->exception, sizeof(EXCEPTION_RECORD));
 570
 571     fake_foreign_function_call(&context);
 572
 573     /* Allocate the SAP objects while the "interrupts" are still
 574      * disabled. */
 575     context_sap = alloc_sap(&context);
 576     exception_record_sap = alloc_sap(&exception_record);
 577
 578     funcall2(SymbolFunction(HANDLE_WIN32_EXCEPTION), context_sap,
 579              exception_record_sap);
 580
 581     /* FIXME: These never happen, as the Lisp-side call is
 582      * to an ERROR, which means we must do a non-local exit
 583      */
 584     undo_fake_foreign_function_call(&context);
 585     memcpy(&frame->context, &context, sizeof(CONTEXT));
 586 }
 587
 588 void
 589 wos_install_interrupt_handlers(struct lisp_exception_frame *handler)
 590 {
 591     handler->next_frame = get_seh_frame();
 592     handler->handler = &handle_exception;
 593     set_seh_frame(handler);
 594 }
 595
 596 void bcopy(const void *src, void *dest, size_t n)
 597 {
 598     MoveMemory(dest, src, n);
 599 }
 600
 601 /*
 602  * The stubs below are replacements for the windows versions,
 603  * which can -fail- when used in our memory spaces because they
 604  * validate the memory spaces they are passed in a way that
 605  * denies our exception handler a chance to run.
 606  */
 607
 608 void *memmove(void *dest, const void *src, size_t n)
 609 {
 610     if (dest < src) {
 611         int i;
 612         for (i = 0; i < n; i++) *(((char *)dest)+i) = *(((char *)src)+i);
 613     } else {
 614         while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
 615     }
 616     return dest;
 617 }
 618
 619 void *memcpy(void *dest, const void *src, size_t n)
 620 {
 621     while (n--) *(((char *)dest)+n) = *(((char *)src)+n);
 622     return dest;
 623 }
 624
 625 char *dirname(char *path)
 626 {
 627     static char buf[PATH_MAX + 1];
 628     size_t pathlen = strlen(path);
 629     int i;
 630
 631     if (pathlen >= sizeof(buf)) {
 632         lose("Pathname too long in dirname.\n");
 633         return NULL;
 634     }
 635
 636     strcpy(buf, path);
 637     for (i = pathlen; i >= 0; --i) {
 638         if (buf[i] == '/' || buf[i] == '\\') {
 639             buf[i] = '\0';
 640             break;
 641         }
 642     }
 643
 644     return buf;
 645 }
 646
 647 /* This is a manually-maintained version of ldso_stubs.S. */
 648
 649 void scratch(void)
 650 {
 651     CloseHandle(0);
 652     FlushConsoleInputBuffer(0);
 653     FormatMessageA(0, 0, 0, 0, 0, 0, 0);
 654     FreeLibrary(0);
 655     GetACP();
 656     GetConsoleCP();
 657     GetConsoleOutputCP();
 658     GetCurrentProcess();
 659     GetExitCodeProcess(0, 0);
 660     GetLastError();
 661     GetOEMCP();
 662     GetProcAddress(0, 0);
 663     GetProcessTimes(0, 0, 0, 0, 0);
 664     GetSystemTimeAsFileTime(0);
 665     LoadLibrary(0);
 666     LocalFree(0);
 667     PeekConsoleInput(0, 0, 0, 0);
 668     PeekNamedPipe(0, 0, 0, 0, 0, 0);
 669     ReadFile(0, 0, 0, 0, 0);
 670     Sleep(0);
 671     WriteFile(0, 0, 0, 0, 0);
 672     _get_osfhandle(0);
 673     _pipe(0,0,0);
 674     access(0,0);
 675     acos(0);
 676     asin(0);
 677     close(0);
 678     cosh(0);
 679     dup(0);
 680     hypot(0, 0);
 681     isatty(0);
 682     sinh(0);
 683     strerror(42);
 684     write(0, 0, 0);
 685     #ifndef LISP_FEATURE_SB_UNICODE
 686       CreateDirectoryA(0,0);
 687       GetComputerNameA(0, 0);
 688       GetCurrentDirectoryA(0,0);
 689       GetEnvironmentVariableA(0, 0, 0);
 690       GetVersionExA(0);
 691       MoveFileA(0,0);
 692       SHGetFolderPathA(0, 0, 0, 0, 0);
 693       SetCurrentDirectoryA(0);
 694       SetEnvironmentVariableA(0, 0);
 695     #else
 696       CreateDirectoryW(0,0);
 697       FormatMessageW(0, 0, 0, 0, 0, 0, 0);
 698       GetComputerNameW(0, 0);
 699       GetCurrentDirectoryW(0,0);
 700       GetEnvironmentVariableW(0, 0, 0);
 701       GetVersionExW(0);
 702       MoveFileW(0,0);
 703       SHGetFolderPathW(0, 0, 0, 0, 0);
 704       SetCurrentDirectoryW(0);
 705       SetEnvironmentVariableW(0, 0);
 706     #endif
 707 }
 708
 709 char *
 710 os_get_runtime_executable_path()
 711 {
 712     char path[MAX_PATH + 1];
 713     DWORD bufsize = sizeof(path);
 714     DWORD size;
 715
 716     if ((size = GetModuleFileNameA(NULL, path, bufsize)) == 0)
 717         return NULL;
 718     else if (size == bufsize && GetLastError() == ERROR_INSUFFICIENT_BUFFER)
 719         return NULL;
 720
 721     return copied_string(path);
 722 }
 723
 724 /* EOF */