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