Changeset 10565


Ignore:
Timestamp:
Aug 26, 2008, 3:24:37 AM (11 years ago)
Author:
gb
Message:

Merge changes from branches/win64.

As well as the expected low-level exception/suspend/interrupt stuff,
these changes also include changes to [f]printf format strings. Note
that on win64, a 'long' is 32-bits wide, which complicates matters:

  • an address (viewed as an integer) or a natural-sized integer isn't

(portably) a long, and so can't be printed with %l.

  • an address (viewed as an integer) or a natural-sized integer isn't

(portably) a long long, and so can't be printed with %ll.

  • an address (viewed as an integer) or a natural-sized integer can be

portably printed with '%p', but implementations differ as to whether
or not '%p' prepends a gratuitous '0x' to the hex address. (Linux
does, other current platforms seem not to.)

The approach that seems to work is to cast arguments to natural, then
to u64_t, then use %ll. That approach probably isn't taken consistently
(yet), so some debugging information printed by the kernel may be
incorrect.

Location:
trunk/source/lisp-kernel
Files:
19 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lisp-kernel/Threads.h

    r10518 r10565  
    2424#include <pthread.h>
    2525#endif
     26#ifdef WINDOWS
     27#include <process.h>
     28#endif
    2629#include <errno.h>
    2730#include <limits.h>
     
    9699#ifdef USE_WINDOWS_SEMAPHORES
    97100
    98 /* Unimplemented */
    99 
    100101typedef void * SEMAPHORE;
    101 #define SEM_WAIT(s)
    102 #define SEM_RAISE(s)
    103 #define SEM_BROADCAST(s, count)
    104 #define SEM_TIMEDWAIT(s,t)
     102#define SEM_WAIT(s) WaitForSingleObject(s,INFINITE)
     103#define SEM_RAISE(s) ReleaseSemaphore(s, 1L, NULL)
     104#define SEM_BROADCAST(s, count) do {while(count) {SEM_RAISE(s);(count)--;}}while(0)
     105#define SEM_TIMEDWAIT(s,t) WaitOnSingleObject(s,t)
    105106
    106107#endif
     
    172173LispObj create_system_thread(size_t stack_size,
    173174                             void* stackaddr,
    174                              void* (*start_routine)(void *),
     175#ifdef WINDOWS
     176                             unsigned (*start_routine)(void *)
     177#else
     178                             void* (*start_routine)(void *)
     179#endif
     180                             ,
    175181                             void* param);
    176182
  • trunk/source/lisp-kernel/area.h

    r10086 r10565  
    173173#ifdef WINDOWS
    174174#ifdef X8664
    175 #define IMAGE_BASE_ADDRESS 0x300000000000LL
     175#define IMAGE_BASE_ADDRESS 0x100000000LL
    176176#endif
    177177#endif
  • trunk/source/lisp-kernel/image.c

    r10085 r10565  
    163163}
    164164
    165 #ifdef WINDOWS
    166 void
    167 load_image_section(int fd, openmcl_image_section_header *sect)
    168 {
    169 }
    170 #else
    171165void
    172166load_image_section(int fd, openmcl_image_section_header *sect)
     
    183177  switch(sect->code) {
    184178  case AREA_READONLY:
    185     addr = mmap(pure_space_active,
    186                 align_to_power_of_2(mem_size,log2_page_size),
    187                 PROT_READ | PROT_EXEC,
    188                 MAP_PRIVATE | MAP_FIXED,
    189                 fd,
    190                 pos);
    191     if (addr != pure_space_active) {
     179    if (!MapFile(pure_space_active,
     180                 pos,
     181                 align_to_power_of_2(mem_size,log2_page_size),
     182                 MEMPROTECT_RX,
     183                 fd)) {
    192184      return;
    193185    }
     
    199191
    200192  case AREA_STATIC:
    201     addr = mmap(static_space_active,
    202                 align_to_power_of_2(mem_size,log2_page_size),
    203                 PROT_READ | PROT_WRITE | PROT_EXEC,
    204                 MAP_PRIVATE | MAP_FIXED,
    205                 fd,
    206                 pos);
    207     if (addr != static_space_active) {
     193    if (!MapFile(static_space_active,
     194                 pos,
     195                 align_to_power_of_2(mem_size,log2_page_size),
     196                 MEMPROTECT_RWX,
     197                 fd)) {
    208198      return;
    209199    }
     
    216206  case AREA_DYNAMIC:
    217207    a = allocate_dynamic_area(mem_size);
    218     addr = mmap(a->low,
    219                 align_to_power_of_2(mem_size,log2_page_size),
    220                 PROT_READ | PROT_WRITE | PROT_EXEC,
    221                 MAP_PRIVATE | MAP_FIXED,
    222                 fd,
    223                 pos);
    224     if (addr != a->low) {
     208    if (!MapFile(a->low,
     209                 pos,
     210                 align_to_power_of_2(mem_size,log2_page_size),
     211                 MEMPROTECT_RWX,
     212                 fd)) {
    225213      return;
    226214    }
    227 
    228215
    229216    a->static_dnodes = sect->static_dnodes;
     
    242229  lseek(fd, pos+advance, SEEK_SET);
    243230}
    244 #endif
    245 
    246 #ifdef WINDOWS
    247 LispObj
    248 load_openmcl_image(int fd, openmcl_image_file_header *h)
    249 {
    250 }
    251 #else
     231
    252232LispObj
    253233load_openmcl_image(int fd, openmcl_image_file_header *h)
     
    334314  return image_nil;
    335315}
    336 #endif
    337316 
    338317void
  • trunk/source/lisp-kernel/lisp-debug.c

    r10264 r10565  
    143143#endif
    144144#ifdef WINDOWS
    145 /* is this correct? */
    146 char* Iregnames[] = {"r8 ","r9 ","r10","r11","r12","r13","r14","r15",
    147                      "rdi","rsi","rbp", "rbx", "rdx", "rax", "rcx","rsp"};
     145char* Iregnames[] = {"rax ","rcx ","rdx","rbx","rsp","rrbp","rsi","rdi",
     146                     "r8","r9","r10", "r11", "r12", "r13", "r14","r15"};
    148147#endif
    149148#endif
     
    175174show_lisp_register(ExceptionInformation *xp, char *label, int r)
    176175{
     176
     177  extern char* print_lisp_object(LispObj);
    177178
    178179  LispObj val = xpGPR(xp, r);
     
    584585{
    585586  char *pname = debug_get_string_value("symbol name");
     587  extern void *plsym(ExceptionInformation *,char*);
    586588 
    587589  if (pname != NULL) {
     
    599601    area *vs_area = tcr->vs_area, *cs_area = tcr->cs_area;
    600602
    601     fprintf(stderr, "Current Thread Context Record (tcr) = 0x%lx\n", tcr);
    602     fprintf(stderr, "Control (C) stack area:  low = 0x%lx, high = 0x%lx\n",
    603             cs_area->low, cs_area->high);
    604     fprintf(stderr, "Value (lisp) stack area: low = 0x%lx, high = 0x%lx\n",
    605             vs_area->low, vs_area->high);
    606     fprintf(stderr, "Exception stack pointer = 0x%lx\n",
    607 #ifdef PPC
    608             xpGPR(xp,1)
     603    fprintf(stderr, "Current Thread Context Record (tcr) = %p\n", (u64_t)(natural)tcr);
     604    fprintf(stderr, "Control (C) stack area:  low = 0x%llx, high = 0x%llx\n",
     605            (u64_t)(natural)(cs_area->low), (u64_t)(natural)(cs_area->high));
     606    fprintf(stderr, "Value (lisp) stack area: low = 0x%llx, high = 0x%llx\n",
     607            (u64_t)(natural)(vs_area->low), (u64_t)(natural)vs_area->high);
     608    fprintf(stderr, "Exception stack pointer = 0x%llx\n",
     609#ifdef PPC
     610            (u64_t) (natural)(xpGPR(xp,1))
    609611#endif
    610612#ifdef X86
    611             xpGPR(xp,Isp)
     613            (u64_t) (natural)(xpGPR(xp,Isp))
    612614#endif
    613615            );
     
    617619     
    618620
    619 #ifdef WINDOWS
    620 debug_command_return
    621 debug_set_gpr(ExceptionInformation *xp, siginfo_t *info, int arg)
    622 {
    623 }
    624 #else
    625621debug_command_return
    626622debug_set_gpr(ExceptionInformation *xp, siginfo_t *info, int arg)
     
    631627  sprintf(buf, "value for GPR %d", arg);
    632628  val = debug_get_natural_value(buf);
    633   set_xpGPR(xp, arg, val);
     629  xpGPR(xp,arg) = val;
    634630  return debug_continue;
    635631}
    636 #endif
    637632
    638633debug_command_return
     
    937932    c = toupper(c);
    938933
    939     for (entry = debug_command_entries; f = entry->f; entry++) {
     934    for (entry = debug_command_entries; (f = entry->f) != NULL; entry++) {
    940935      if (toupper(entry->c) == c) {
    941936        /* If we have an XP or don't need one, call the function */
     
    10291024    abort();
    10301025  }
    1031 #ifdef DARWIN
    1032 #ifdef X8664
    1033   if (xp) {
    1034     extern void *_sigtramp();
    1035     extern int os_major_version;
    1036 
    1037     if (xpPC(xp) == (natural)_sigtramp) {
    1038       xp = (ExceptionInformation *) xpGPR(xp, REG_R8);
    1039       fprintf(stderr, "Exception raised at _sigtramp; using context passed to _sigtramp.  Raw register values (R) may be more interesting then lisp values or lisp backtrace\n");
    1040     }
    1041   }
    1042 #endif
    1043 #endif
    1044 
    1045 
    10461026  if (xp) {
    10471027    if (why > debug_entry_exception) {
     
    10531033  while (state == debug_continue) {
    10541034#ifdef WINDOWS
    1055     fprintf(stderr, "[%d] OpenMCL kernel debugger: ", 23 /* FIXME */);
     1035    fprintf(stderr, "[%d] OpenMCL kernel debugger: ", (int)GetCurrentProcessId());
    10561036#else
    10571037    fprintf(stderr, "[%d] OpenMCL kernel debugger: ", main_thread_pid);
     
    10721052  case debug_kill:
    10731053    terminate_lisp();
     1054  default:
     1055    return 0;
    10741056  }
    10751057}
  • trunk/source/lisp-kernel/lisp.h

    r10010 r10565  
    7676#define PLATFORM_OS_DARWIN 3
    7777#define PLATFORM_OS_FREEBSD 4
    78 #define PLATFORM_OS_WINDOWS 6
     78#define PLATFORM_OS_WINDOWS 5
    7979
    8080#ifdef LINUX
     
    116116#define PLATFORM (PLATFORM_OS|PLATFORM_CPU|PLATFORM_WORD_SIZE)
    117117
     118Boolean check_for_embedded_image (char *);
     119natural xStackSpace();
     120void init_threads(void *, TCR *);
    118121
     122#ifdef WINDOWS
     123void wperror(char *);
     124#endif
  • trunk/source/lisp-kernel/lisptypes.h

    r10090 r10565  
    162162
    163163#ifdef WIN64
    164 typedef EXCEPTION_POINTERS ExceptionInformation;
     164typedef CONTEXT ExceptionInformation;
    165165#endif
    166166
  • trunk/source/lisp-kernel/memory.c

    r10222 r10565  
    2121#include <ctype.h>
    2222#include <stdio.h>
     23#include <stdlib.h>
    2324#include <stddef.h>
    2425#include <string.h>
     
    2627#include <errno.h>
    2728#include <stdio.h>
     29#include <unistd.h>
    2830#ifdef LINUX
    2931#include <strings.h>
     
    3638#endif
    3739
     40#define DEBUG_MEMORY 0
     41
    3842void
    3943allocation_failure(Boolean pointerp, natural size)
    4044{
    4145  char buf[64];
    42   sprintf(buf, "Can't allocate %s of size %ld bytes.", pointerp ? "pointer" : "handle", size);
     46  sprintf(buf, "Can't allocate %s of size %Id bytes.", pointerp ? "pointer" : "handle", size);
    4347  Fatal(":   Kernel memory allocation failure.  ", buf);
    4448}
     
    7579}
    7680
     81#ifdef DARWIN
     82#if WORD_SIZE == 64
     83#define vm_region vm_region_64
     84#endif
     85
     86/*
     87  Check to see if the specified address is unmapped by trying to get
     88  information about the mapped address at or beyond the target.  If
     89  the difference between the target address and the next mapped address
     90  is >= len, we can safely mmap len bytes at addr.
     91*/
     92Boolean
     93address_unmapped_p(char *addr, natural len)
     94{
     95  vm_address_t vm_addr = (vm_address_t)addr;
     96  vm_size_t vm_size;
     97#if WORD_SIZE == 64
     98  vm_region_basic_info_data_64_t vm_info;
     99#else
     100  vm_region_basic_info_data_t vm_info;
     101#endif
     102#if WORD_SIZE == 64
     103  mach_msg_type_number_t vm_info_size = VM_REGION_BASIC_INFO_COUNT_64;
     104#else
     105  mach_msg_type_number_t vm_info_size = VM_REGION_BASIC_INFO_COUNT;
     106#endif
     107  mach_port_t vm_object_name = (mach_port_t) 0;
     108  kern_return_t kret;
     109
     110  kret = vm_region(mach_task_self(),
     111                   &vm_addr,
     112                   &vm_size,
     113#if WORD_SIZE == 64
     114                   VM_REGION_BASIC_INFO_64,
     115#else
     116                   VM_REGION_BASIC_INFO,
     117#endif
     118                   (vm_region_info_t)&vm_info,
     119                   &vm_info_size,
     120                   &vm_object_name);
     121  if (kret != KERN_SUCCESS) {
     122    return false;
     123  }
     124
     125  return vm_addr >= (vm_address_t)(addr+len);
     126}
     127#endif
     128
     129
     130  /*
     131    Through trial and error, we've found that IMAGE_BASE_ADDRESS is
     132    likely to reside near the beginning of an unmapped block of memory
     133    that's at least 1GB in size.  We'd like to load the heap image's
     134    sections relative to IMAGE_BASE_ADDRESS; if we're able to do so,
     135    that'd allow us to file-map those sections (and would enable us to
     136    avoid having to relocate references in the data sections.)
     137
     138    In short, we'd like to reserve 1GB starting at IMAGE_BASE_ADDRESS
     139    by creating an anonymous mapping with mmap().
     140
     141    If we try to insist that mmap() map a 1GB block at
     142    IMAGE_BASE_ADDRESS exactly (by specifying the MAP_FIXED flag),
     143    mmap() will gleefully clobber any mapped memory that's already
     144    there.  (That region's empty at this writing, but some future
     145    version of the OS might decide to put something there.)
     146
     147    If we don't specify MAP_FIXED, mmap() is free to treat the address
     148    we give it as a hint; Linux seems to accept the hint if doing so
     149    wouldn't cause a problem.  Naturally, that behavior's too useful
     150    for Darwin (or perhaps too inconvenient for it): it'll often
     151    return another address, even if the hint would have worked fine.
     152
     153    We call address_unmapped_p() to ask Mach whether using MAP_FIXED
     154    would conflict with anything.  Until we discover a need to do
     155    otherwise, we'll assume that if Linux's mmap() fails to take the
     156    hint, it's because of a legitimate conflict.
     157
     158    If Linux starts ignoring hints, we can parse /proc/<pid>/maps
     159    to implement an address_unmapped_p() for Linux.
     160  */
     161
     162LogicalAddress
     163ReserveMemoryForHeap(LogicalAddress want, natural totalsize)
     164{
     165  LogicalAddress start;
     166  Boolean fixed_map_ok = false;
     167#ifdef DARWIN
     168  fixed_map_ok = address_unmapped_p(want,totalsize);
     169#endif
     170#ifdef SOLARIS
     171  fixed_map_ok = true;
     172#endif
     173  raise_limit();
     174#ifdef WINDOWS
     175  start = VirtualAlloc((void *)want,
     176                       totalsize + heap_segment_size,
     177                       MEM_RESERVE,
     178                       PAGE_NOACCESS);
     179  if (!start) {
     180    fprintf(stderr, "Can't get desired heap address at 0x%Ix\n", want);
     181    start = VirtualAlloc(0,
     182                         totalsize + heap_segment_size,
     183                         MEM_RESERVE,
     184                         PAGE_NOACCESS);
     185    if (!start) {
     186      wperror("VirtualAlloc");
     187      return NULL;
     188    }
     189  }
     190#else
     191  start = mmap((void *)want,
     192               totalsize + heap_segment_size,
     193               PROT_NONE,
     194               MAP_PRIVATE | MAP_ANON | (fixed_map_ok ? MAP_FIXED : 0) | MAP_NORESERVE,
     195               -1,
     196               0);
     197  if (start == MAP_FAILED) {
     198    perror("Initial mmap");
     199    return NULL;
     200  }
     201
     202  if (start != want) {
     203    munmap(start, totalsize+heap_segment_size);
     204    start = (void *)((((natural)start)+heap_segment_size-1) & ~(heap_segment_size-1));
     205    if(mmap(start, totalsize, PROT_NONE, MAP_PRIVATE | MAP_ANON | MAP_FIXED | MAP_NORESERVE, -1, 0) != start) {
     206      return NULL;
     207    }
     208  }
     209  mprotect(start, totalsize, PROT_NONE);
     210#endif
     211#if DEBUG_MEMORY
     212  fprintf(stderr, "Reserving heap at 0x%Ix, size 0x%Ix\n", start, totalsize);
     213#endif
     214  return start;
     215}
     216
     217int
     218CommitMemory (LogicalAddress start, natural len) {
     219  LogicalAddress rc;
     220#if DEBUG_MEMORY
     221  fprintf(stderr, "Committing memory at 0x%Ix, size 0x%Ix\n", start, len);
     222#endif
     223#ifdef WINDOWS
     224  if ((start < ((LogicalAddress)nil_value)) &&
     225      (((LogicalAddress)nil_value) < (start+len))) {
     226    /* nil area is in the executable on Windows, do nothing */
     227    return true;
     228  }
     229  rc = VirtualAlloc(start, len, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
     230  if (!rc) {
     231    wperror("CommitMemory VirtualAlloc");
     232    return false;
     233  }
     234  return true;
     235#else
     236  int i, err;
     237  void *addr;
     238
     239  for (i = 0; i < 3; i++) {
     240    addr = mmap(start, len, MEMPROTECT_RWX, MAP_PRIVATE|MAP_ANON|MAP_FIXED, -1, 0);
     241    if (addr == start) {
     242      return true;
     243    } else {
     244      mmap(addr, len, MEMPROTECT_NONE, MAP_PRIVATE|MAP_ANON|MAP_FIXED, -1, 0);
     245    }
     246  }
     247  return false;
     248#endif
     249}
     250
     251void
     252UnCommitMemory (LogicalAddress start, natural len) {
     253#if DEBUG_MEMORY
     254  fprintf(stderr, "Uncommitting memory at 0x%Ix, size 0x%Ix\n", start, len);
     255#endif
     256#ifdef WINDOWS
     257  int rc = VirtualFree(start, len, MEM_DECOMMIT);
     258  if (!rc) {
     259    wperror("UnCommitMemory VirtualFree");
     260    Fatal("mmap error", "");
     261    return;
     262  }
     263#else
     264  if (len) {
     265    madvise(start, len, MADV_DONTNEED);
     266    if (mmap(start, len, MEMPROTECT_NONE, MAP_PRIVATE|MAP_ANON|MAP_FIXED, -1, 0)
     267        != start) {
     268      int err = errno;
     269      Fatal("mmap error", "");
     270      fprintf(stderr, "errno = %d", err);
     271    }
     272  }
     273#endif
     274}
     275
     276
     277LogicalAddress
     278MapMemory(LogicalAddress addr, natural nbytes, int protection)
     279{
     280#if DEBUG_MEMORY
     281  fprintf(stderr, "Mapping memory at 0x%Ix, size 0x%Ix\n", addr, nbytes);
     282#endif
     283#ifdef WINDOWS
     284  return VirtualAlloc(addr, nbytes, MEM_RESERVE|MEM_COMMIT, MEMPROTECT_RWX);
     285#else
     286  return mmap(addr, nbytes, protection, MAP_PRIVATE|MAP_ANON|MAP_FIXED, -1, 0);
     287#endif
     288}
     289
     290LogicalAddress
     291MapMemoryForStack(natural nbytes)
     292{
     293#if DEBUG_MEMORY
     294  fprintf(stderr, "Mapping stack of size 0x%Ix\n", nbytes);
     295#endif
     296#ifdef WINDOWS
     297  return VirtualAlloc(0, nbytes, MEM_RESERVE|MEM_COMMIT, MEMPROTECT_RWX);
     298#else
     299  return mmap(NULL, nbytes, MEMPROTECT_RWX, MAP_PRIVATE|MAP_ANON|MAP_GROWSDOWN, -1, 0);
     300#endif
     301}
     302
     303int
     304UnMapMemory(LogicalAddress addr, natural nbytes)
     305{
     306#if DEBUG_MEMORY
     307  fprintf(stderr, "Unmapping memory at 0x%Ix, size 0x%Ix\n", addr, nbytes);
     308#endif
     309#ifdef WINDOWS
     310  /* Can't MEM_RELEASE here because we only want to free a chunk */
     311  return VirtualFree(addr, nbytes, MEM_DECOMMIT);
     312#else
     313  return munmap(addr, nbytes);
     314#endif
     315}
     316
    77317int
    78318ProtectMemory(LogicalAddress addr, natural nbytes)
    79319{
     320#if DEBUG_MEMORY
     321  fprintf(stderr, "Protecting memory at 0x%Ix, size 0x%Ix\n", addr, nbytes);
     322#endif
     323#ifdef WINDOWS
     324  DWORD oldProtect;
     325  BOOL status = VirtualProtect(addr, nbytes, MEMPROTECT_RX, &oldProtect);
     326 
     327  if(!status) {
     328    wperror("ProtectMemory VirtualProtect");
     329    Bug(NULL, "couldn't protect %Id bytes at %x, errno = %d", nbytes, addr, status);
     330  }
     331  return status;
     332#else
    80333  int status = mprotect(addr, nbytes, PROT_READ | PROT_EXEC);
    81334 
    82335  if (status) {
    83336    status = errno;
    84     Bug(NULL, "couldn't protect %d bytes at %x, errno = %d", nbytes, addr, status);
     337    Bug(NULL, "couldn't protect %Id bytes at %Ix, errno = %d", nbytes, addr, status);
    85338  }
    86339  return status;
     340#endif
    87341}
    88342
     
    90344UnProtectMemory(LogicalAddress addr, natural nbytes)
    91345{
     346#if DEBUG_MEMORY
     347  fprintf(stderr, "Unprotecting memory at 0x%Ix, size 0x%Ix\n", addr, nbytes);
     348#endif
     349#ifdef WINDOWS
     350  DWORD oldProtect;
     351  return VirtualProtect(addr, nbytes, MEMPROTECT_RWX, &oldProtect);
     352#else
    92353  return mprotect(addr, nbytes, PROT_READ|PROT_WRITE|PROT_EXEC);
     354#endif
     355}
     356
     357int
     358MapFile(LogicalAddress addr, natural pos, natural nbytes, int permissions, int fd)
     359{
     360#ifdef WINDOWS
     361#if 0
     362  /* Lots of hair in here: mostly alignment issues, but also address space reservation */
     363  HANDLE hFile, hFileMapping;
     364  LPVOID rc;
     365  DWORD desiredAccess;
     366
     367  if (permissions == MEMPROTECT_RWX) {
     368    permissions |= PAGE_WRITECOPY;
     369    desiredAccess = FILE_MAP_READ|FILE_MAP_WRITE|FILE_MAP_COPY|FILE_MAP_EXECUTE;
     370  } else {
     371    desiredAccess = FILE_MAP_READ|FILE_MAP_COPY|FILE_MAP_EXECUTE;
     372  }
     373
     374  hFile = _get_osfhandle(fd);
     375  hFileMapping = CreateFileMapping(hFile, NULL, permissions,
     376                                   (nbytes >> 32), (nbytes & 0xffffffff), NULL);
     377 
     378  if (!hFileMapping) {
     379    wperror("CreateFileMapping");
     380    return false;
     381  }
     382
     383  rc = MapViewOfFileEx(hFileMapping,
     384                       desiredAccess,
     385                       (pos >> 32),
     386                       (pos & 0xffffffff),
     387                       nbytes,
     388                       addr);
     389#else
     390  size_t count, total = 0;
     391  size_t opos;
     392
     393  opos = lseek(fd, 0, SEEK_CUR);
     394  CommitMemory(addr, nbytes);
     395  lseek(fd, pos, SEEK_SET);
     396
     397  while (total < nbytes) {
     398    count = read(fd, addr + total, nbytes - total);
     399    total += count;
     400    // fprintf(stderr, "read %Id bytes, for a total of %Id out of %Id so far\n", count, total, nbytes);
     401    if (!(count > 0))
     402      return false;
     403  }
     404
     405  lseek(fd, opos, SEEK_SET);
     406
     407  return true;
     408#endif
     409#else
     410  return mmap(addr, nbytes, permissions, MAP_PRIVATE|MAP_FIXED, fd, pos) != MAP_FAILED;
     411#endif
    93412}
    94413
     
    200519                    natural free_space_size)
    201520{
     521  extern int page_size;
    202522  area *a = active_dynamic_area;
    203   BytePtr newlimit;
     523  BytePtr newlimit, protptr, zptr;
     524  int psize = page_size;
    204525  if (free_space_size) {
    205526    BytePtr lowptr = a->active;
     
    409730  BytePtr
    410731    curfree = a->active,
    411     target_low = target->low;
     732    target_low = target->low,
     733    tenured_low = tenured_area->low;
    412734  natural
     735    dynamic_dnodes = area_dnode(curfree, a->low),
    413736    new_tenured_dnodes = area_dnode(curfree, tenured_area->low);
    414737  bitvector
     
    610933}
    611934
    612 #ifdef WINDOWS
    613935void
    614936release_readonly_area()
    615937{
    616 }
    617 #else
    618 void
    619 release_readonly_area()
    620 {
    621938  area *a = readonly_area;
    622   munmap(a->low,align_to_power_of_2(a->active-a->low, log2_page_size));
     939  UnMapMemory(a->low,align_to_power_of_2(a->active-a->low, log2_page_size));
    623940  a->active = a->low;
    624941  a->ndnodes = 0;
    625942  pure_space_active = pure_space_start;
    626943}
    627 #endif
  • trunk/source/lisp-kernel/memprotect.h

    r8701 r10565  
    3030
    3131#ifdef WINDOWS
    32 #define PROT_NONE (0)
    33 #define PROT_READ (1)
    34 #define PROT_WRITE (2)
    35 #define PROT_EXEC (3)
    36 
    37 #define MAP_PRIVATE (1)
    38 #define MAP_FIXED (2)
    39 #define MAP_ANON (3)
    40 
    41 void *mmap(void *, size_t, int, int, int, off_t);
    42 
    4332#define MAP_FAILED ((void *)(-1))
    4433
     34#define MEMPROTECT_NONE PAGE_NOACCESS
     35#define MEMPROTECT_RO   PAGE_READONLY
     36#define MEMPROTECT_RW   PAGE_READWRITE
     37#define MEMPROTECT_RX   PAGE_EXECUTE_READ
     38#define MEMPROTECT_RWX  PAGE_EXECUTE_READWRITE
     39
     40#else
     41
     42#define MEMPROTECT_NONE PROT_NONE
     43#define MEMPROTECT_RO   PROT_READ
     44#define MEMPROTECT_RW   (PROT_READ|PROT_WRITE)
     45#define MEMPROTECT_RX   (PROT_READ|PROT_EXEC)
     46#define MEMPROTECT_RWX  (PROT_READ|PROT_WRITE|PROT_EXEC)
     47#ifndef MAP_GROWSDOWN
     48#define MAP_GROWSDOWN (0)
    4549#endif
     50
     51
     52#endif
     53
     54LogicalAddress
     55ReserveMemoryForHeap(LogicalAddress want, natural totalsize);
     56
     57int
     58CommitMemory (LogicalAddress start, natural len);
     59
     60void
     61UnCommitMemory (LogicalAddress start, natural len);
     62
     63LogicalAddress
     64MapMemory(LogicalAddress addr, natural nbytes, int protection);
     65
     66LogicalAddress
     67MapMemoryForStack(natural nbytes);
     68
     69int
     70UnMapMemory(LogicalAddress addr, natural nbytes);
    4671
    4772int
     
    5075int
    5176UnProtectMemory(LogicalAddress, natural);
     77
     78int
     79MapFile(LogicalAddress addr, natural pos, natural nbytes, int permissions, int fd);
    5280
    5381typedef enum {
  • trunk/source/lisp-kernel/plsym.c

    r9901 r10565  
    2525  sym += (fulltag_symbol-fulltag_misc);
    2626#endif
    27   Dprintf("Symbol %s at #x%lX", print_lisp_object(sym), sym);
     27  Dprintf("Symbol %s at #x%llX", print_lisp_object(sym), (u64_t) sym);
    2828  Dprintf("  value    : %s", print_lisp_object(rawsym->vcell));
    2929  if (function != nrs_UDF.vcell) {
  • trunk/source/lisp-kernel/pmcl-kernel.c

    r10262 r10565  
    121121#endif
    122122
     123#ifdef WINDOWS
     124#include <windows.h>
     125#include <stdio.h>
     126void
     127wperror(char* message)
     128{
     129  char* buffer;
     130  DWORD last_error = GetLastError();
     131 
     132  FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER|
     133                FORMAT_MESSAGE_FROM_SYSTEM|
     134                FORMAT_MESSAGE_IGNORE_INSERTS,
     135                NULL,
     136                last_error,
     137                MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
     138                (LPTSTR)&buffer,
     139                0, NULL);
     140  fprintf(stderr, "%s: 0x%x %s\n", message, (unsigned) last_error, buffer);
     141  LocalFree(buffer);
     142}
     143#endif
     144
    123145LispObj lisp_nil = (LispObj) 0;
    124146bitvector global_mark_ref_bits = NULL;
     
    158180{
    159181#ifdef WINDOWS
     182
     183  /* On Windows, the stack is allocated on thread creation.  For the
     184     initial thread, the loader does that, and we cannot change the
     185     stack size after the fact.  For threads we create, we can set the
     186     stack size.  A possible solution is putting the initial thread
     187     asleep and using only runtime-created threads.
     188
     189     For now, just refuse any attempt to set another stack size, and
     190     return the linker default. */
     191
     192  return 0x200000;
     193
    160194#else
    161195  struct rlimit limits;
     
    362396#endif
    363397#ifdef WINDOWS
    364 #define MAXIMUM_MAPPABLE_MEMORY (512<<30LL)
     398/* Supposedly, the high-end version of Vista allow 128GB of pageable memory */
     399#define MAXIMUM_MAPPABLE_MEMORY (120LL<<30LL)
    365400#endif
    366401#else
     
    421456*/
    422457
    423 #ifdef WINDOWS
    424458void
    425459uncommit_pages(void *start, size_t len)
    426460{
    427 }
    428 #else
    429 void
    430 uncommit_pages(void *start, size_t len)
    431 {
    432   if (len) {
    433     madvise(start, len, MADV_DONTNEED);
    434     if (mmap(start,
    435              len,
    436              PROT_NONE,
    437              MAP_PRIVATE | MAP_FIXED | MAP_ANON,
    438              -1,
    439              0) != start) {
    440       int err = errno;
    441       Fatal("mmap error", "");
    442       fprintf(stderr, "errno = %d", err);
    443     }
    444   }
    445 }
    446 #endif
     461  UnCommitMemory(start, len);
     462}
    447463
    448464#define TOUCH_PAGES_ON_COMMIT 0
     
    466482}
    467483
    468 #ifdef WINDOWS
    469484Boolean
    470485commit_pages(void *start, size_t len)
    471486{
    472 }
    473 #else
    474 Boolean
    475 commit_pages(void *start, size_t len)
    476 {
    477487  if (len != 0) {
    478     int i;
    479     void *addr;
    480 
    481     for (i = 0; i < 3; i++) {
    482       addr = mmap(start,
    483                   len,
    484                   PROT_READ | PROT_WRITE | PROT_EXEC,
    485                   MAP_PRIVATE | MAP_FIXED | MAP_ANON,
    486                   -1,
    487                   0);
    488       if (addr == start) {
    489         if (touch_all_pages(start, len)) {
    490           return true;
    491         }
    492         else {
    493           mmap(start,
    494                len,
    495                PROT_NONE,
    496                MAP_PRIVATE | MAP_FIXED | MAP_ANON,
    497                -1,
    498                0);
    499         }
     488    if (CommitMemory(start, len)) {
     489      if (touch_all_pages(start, len)) {
     490        return true;
    500491      }
    501492    }
    502     return false;
    503493  }
    504494  return true;
    505495}
    506 #endif
    507496
    508497area *
     
    519508}
    520509
    521 #ifdef WINDOWS
    522 area *
    523 extend_readonly_area(unsigned more)
    524 {
    525 }
    526 #else
    527510area *
    528511extend_readonly_area(unsigned more)
     
    542525    new_start = (BytePtr)(align_to_power_of_2(a->active,log2_page_size));
    543526    new_end = (BytePtr)(align_to_power_of_2(a->active+more,log2_page_size));
    544     if (mmap(new_start,
    545              new_end-new_start,
    546              PROT_READ | PROT_WRITE | PROT_EXEC,
    547              MAP_PRIVATE | MAP_ANON | MAP_FIXED,
    548              -1,
    549              0) != new_start) {
     527    if (!CommitMemory(new_start, new_end-new_start)) {
    550528      return NULL;
    551529    }
     
    554532  return NULL;
    555533}
    556 #endif
    557534
    558535LispObj image_base=0;
    559536BytePtr pure_space_start, pure_space_active, pure_space_limit;
    560537BytePtr static_space_start, static_space_active, static_space_limit;
    561 
    562 #ifdef DARWIN
    563 #if WORD_SIZE == 64
    564 #define vm_region vm_region_64
    565 #endif
    566 
    567 /*
    568   Check to see if the specified address is unmapped by trying to get
    569   information about the mapped address at or beyond the target.  If
    570   the difference between the target address and the next mapped address
    571   is >= len, we can safely mmap len bytes at addr.
    572 */
    573 Boolean
    574 address_unmapped_p(char *addr, natural len)
    575 {
    576   vm_address_t vm_addr = (vm_address_t)addr;
    577   vm_size_t vm_size;
    578 #if WORD_SIZE == 64
    579   vm_region_basic_info_data_64_t vm_info;
    580 #else
    581   vm_region_basic_info_data_t vm_info;
    582 #endif
    583 #if WORD_SIZE == 64
    584   mach_msg_type_number_t vm_info_size = VM_REGION_BASIC_INFO_COUNT_64;
    585 #else
    586   mach_msg_type_number_t vm_info_size = VM_REGION_BASIC_INFO_COUNT;
    587 #endif
    588   mach_port_t vm_object_name = (mach_port_t) 0;
    589   kern_return_t kret;
    590 
    591   kret = vm_region(mach_task_self(),
    592                    &vm_addr,
    593                    &vm_size,
    594 #if WORD_SIZE == 64
    595                    VM_REGION_BASIC_INFO_64,
    596 #else
    597                    VM_REGION_BASIC_INFO,
    598 #endif
    599                    (vm_region_info_t)&vm_info,
    600                    &vm_info_size,
    601                    &vm_object_name);
    602   if (kret != KERN_SUCCESS) {
    603     return false;
    604   }
    605 
    606   return vm_addr >= (vm_address_t)(addr+len);
    607 }
    608 #endif
    609538
    610539void
     
    622551
    623552
    624 #ifdef WINDOWS
    625 area *
    626 create_reserved_area(natural totalsize)
    627 {
    628 }
    629 #else
    630553area *
    631554create_reserved_area(natural totalsize)
     
    639562    want = (BytePtr)IMAGE_BASE_ADDRESS;
    640563  area *reserved;
    641   Boolean fixed_map_ok = false;
    642 
    643   /*
    644     Through trial and error, we've found that IMAGE_BASE_ADDRESS is
    645     likely to reside near the beginning of an unmapped block of memory
    646     that's at least 1GB in size.  We'd like to load the heap image's
    647     sections relative to IMAGE_BASE_ADDRESS; if we're able to do so,
    648     that'd allow us to file-map those sections (and would enable us to
    649     avoid having to relocate references in the data sections.)
    650 
    651     In short, we'd like to reserve 1GB starting at IMAGE_BASE_ADDRESS
    652     by creating an anonymous mapping with mmap().
    653 
    654     If we try to insist that mmap() map a 1GB block at
    655     IMAGE_BASE_ADDRESS exactly (by specifying the MAP_FIXED flag),
    656     mmap() will gleefully clobber any mapped memory that's already
    657     there.  (That region's empty at this writing, but some future
    658     version of the OS might decide to put something there.)
    659 
    660     If we don't specify MAP_FIXED, mmap() is free to treat the address
    661     we give it as a hint; Linux seems to accept the hint if doing so
    662     wouldn't cause a problem.  Naturally, that behavior's too useful
    663     for Darwin (or perhaps too inconvenient for it): it'll often
    664     return another address, even if the hint would have worked fine.
    665 
    666     We call address_unmapped_p() to ask Mach whether using MAP_FIXED
    667     would conflict with anything.  Until we discover a need to do
    668     otherwise, we'll assume that if Linux's mmap() fails to take the
    669     hint, it's because of a legitimate conflict.
    670 
    671     If Linux starts ignoring hints, we can parse /proc/<pid>/maps
    672     to implement an address_unmapped_p() for Linux.
    673   */
    674564
    675565  totalsize = align_to_power_of_2((void *)totalsize, log2_heap_segment_size);
    676566
    677 #ifdef DARWIN
    678   fixed_map_ok = address_unmapped_p(want,totalsize);
    679 #endif
    680 #ifdef SOLARIS
    681   fixed_map_ok = true;
    682 #endif
    683   raise_limit();                /* From Andi Kleen: observe rlimits */
    684   start = mmap((void *)want,
    685                totalsize + heap_segment_size,
    686                PROT_NONE,
    687                MAP_PRIVATE | MAP_ANON | (fixed_map_ok ? MAP_FIXED : 0) | MAP_NORESERVE,
    688                -1,
    689                0);
    690   if (start == MAP_FAILED) {
    691     perror("Initial mmap");
    692     return NULL;
    693   }
    694 
    695   if (start != want) {
    696     munmap(start, totalsize+heap_segment_size);
    697     start = (void *)((((natural)start)+heap_segment_size-1) & ~(heap_segment_size-1));
    698     if(mmap(start, totalsize, PROT_NONE, MAP_PRIVATE | MAP_ANON | MAP_FIXED | MAP_NORESERVE, -1, 0) != start) {
    699       return NULL;
    700     }
    701   }
    702   mprotect(start, totalsize, PROT_NONE);
     567  start = ReserveMemoryForHeap(want, totalsize);
    703568
    704569  h = (Ptr) start;
     
    729594  return reserved;
    730595}
    731 #endif
    732596
    733597void *
     
    765629
    766630  if (new_reloctab_limit > reloctab_limit) {
     631    CommitMemory(global_reloctab, reloctab_size);
    767632    UnProtectMemory(global_reloctab, reloctab_size);
    768633    reloctab_limit = new_reloctab_limit;
     
    770635 
    771636  if (new_markbits_limit > markbits_limit) {
     637    CommitMemory(global_mark_ref_bits, markbits_size);
    772638    UnProtectMemory(global_mark_ref_bits, markbits_size);
    773639    markbits_limit = new_markbits_limit;
     
    793659  a->markbits = reserved_area->markbits;
    794660  reserved_area->markbits = NULL;
    795   UnProtectMemory(start, end-start);
     661  CommitMemory(start, end-start);
    796662  a->h = start;
    797663  a->softprot = NULL;
     
    872738register_sigint_handler()
    873739{
    874   extern void install_signal_handler(int, void*);
     740#ifdef WINDOWS
     741  extern BOOL ControlEventHandler(DWORD);
     742
     743  signal(SIGINT, SIG_IGN);
     744
     745  SetConsoleCtrlHandler(ControlEventHandler,TRUE);
     746#else
    875747  install_signal_handler(SIGINT, (void *)sigint_handler);
     748#endif
    876749}
    877750
     
    881754initial_stack_bottom()
    882755{
     756#ifndef WINDOWS
    883757  extern char **environ;
    884758  char *p = *environ;
     
    887761  }
    888762  return (BytePtr)((((natural) p) +4095) & ~4095);
     763#endif
     764#ifdef WINDOWS
     765  return (BytePtr)((current_stack_pointer() + 4095) & ~ 4095);
     766#endif
    889767}
    890768
     
    913791
    914792
    915 #ifdef DARWIN
     793#if defined(DARWIN) || defined(WINDOWS)
     794#ifdef WINDOWS
     795/* Chop the trailing ".exe" from the kernel image name */
     796char *
     797chop_exe_suffix(char *path)
     798{
     799  int len = strlen(path);
     800  char *copy = malloc(len+1), *tail;
     801
     802  strcpy(copy,path);
     803  tail = strrchr(copy, '.');
     804  if (tail) {
     805    *tail = 0;
     806  }
     807  return copy;
     808}
     809#endif
     810
    916811/*
    917812   The underlying file system may be case-insensitive (e.g., HFS),
     
    922817default_image_name(char *orig)
    923818{
    924   int len = strlen(orig) + strlen(".image") + 1;
     819#ifdef WINDOWS
     820  char *path = chop_exe_suffix(orig);
     821#else
     822  char *path = orig;
     823#endif
     824  int len = strlen(path) + strlen(".image") + 1;
    925825  char *copy = (char *) malloc(len);
    926826
    927827  if (copy) {
    928     strcpy(copy, orig);
     828    strcpy(copy, path);
    929829    strcat(copy, ".image");
    930830  }
     
    1005905  return argv0;
    1006906#endif
     907#ifdef WINDOWS
     908  char path[PATH_MAX], *p;
     909  int len = GetModuleFileName(NULL, path, PATH_MAX);
     910  if (len > 0) {
     911    p = malloc(len + 1);
     912    memmove(p, path, len);
     913    p[len] = 0;
     914    return p;
     915  }
     916  return argv0;
     917#endif
    1007918}
    1008919
     
    1019930    fputs(other_args, stderr);
    1020931  }
    1021   fprintf(stderr, "\t-R, --heap-reserve <n>: reserve <n> (default: %ld)\n",
    1022           reserved_area_size);
     932  fprintf(stderr, "\t-R, --heap-reserve <n>: reserve <n> (default: %lld)\n",
     933          (u64_t) reserved_area_size);
    1023934  fprintf(stderr, "\t\t bytes for heap expansion\n");
    1024935  fprintf(stderr, "\t-S, --stack-size <n>: set  size of initial thread's control stack to <n>\n");
     
    12311142terminate_lisp()
    12321143{
     1144  ExitProcess(EXIT_FAILURE);
    12331145}
    12341146#else
     
    13051217    }
    13061218    xMakeDataExecutable(new, (void*)work-(void*)new);
    1307     mprotect(new, 0x1000, PROT_READ | PROT_EXEC);
     1219    ProtectMemory(new, 0x1000);
    13081220  }
    13091221}
     
    13131225#ifdef X8664
    13141226#ifdef WINDOWS
     1227
     1228/* By using linker tricks, we ensure there's memory between 0x11000
     1229   and 0x21000, so we just need to fix permissions and copy the spjump
     1230   table. */
     1231
    13151232void
    13161233remap_spjump()
    13171234{
     1235  extern opcode spjump_start;
     1236  DWORD old_protect;
     1237
     1238  if (!VirtualProtect((pc) 0x15000,
     1239                      0x1000,
     1240                      PAGE_EXECUTE_READ,
     1241                      &old_protect)) {
     1242    wperror("VirtualProtect spjump");
     1243    _exit(1);
     1244  }
     1245  memmove((pc) 0x15000, &spjump_start, 0x1000);
    13181246}
    13191247#else
     
    13431271{
    13441272#ifdef WINDOWS
     1273  /* We should be able to run with any version of Windows that actually gets here executing the binary, so don't do anything for now. */
    13451274#else
    13461275  struct utsname uts;
     
    14901419
    14911420int
    1492 main(int argc, char *argv[], char *envp[], void *aux)
     1421main(int argc, char *argv[]
     1422#ifndef WINDOWS
     1423, char *envp[], void *aux
     1424#endif
     1425)
    14931426{
    14941427  extern int page_size;
     
    15021435  TCR *tcr;
    15031436
     1437
     1438#ifdef WINDOWS
     1439  extern void init_winsock(void);
     1440  extern void init_windows_io(void);
     1441
     1442  _fmode = O_BINARY;
     1443  _setmode(1, O_BINARY);
     1444  _setmode(2, O_BINARY);
     1445  setvbuf(stderr, NULL, _IONBF, 0);
     1446  init_winsock();
     1447  init_windows_io();
     1448#endif
     1449
    15041450  check_os_version(argv[0]);
    15051451  real_executable_name = determine_executable_name(argv[0]);
    1506   page_size = getpagesize();
     1452  page_size = getpagesize(); /* Implement with GetSystemInfo on Windows w/o MinGW */
    15071453
    15081454  check_bogus_fp_exceptions();
     
    17381684}
    17391685
    1740 int
     1686natural
    17411687xStackSpace()
    17421688{
     
    17491695xGetSharedLibrary(char *path, int mode)
    17501696{
     1697  return NULL;                  /* fix this */
    17511698}
    17521699#else
     
    18841831}
    18851832
    1886 #ifdef WINDOWS
    18871833int
    18881834do_fd_is_set(int fd, fd_set *fdsetp)
    18891835{
    1890 }
    1891 #else
    1892 int
    1893 do_fd_is_set(int fd, fd_set *fdsetp)
    1894 {
    18951836  return FD_ISSET(fd,fdsetp);
    18961837}
    1897 #endif
     1838
    18981839
    18991840void
     
    19041845
    19051846#include "image.h"
     1847
    19061848
    19071849
     
    19401882  }
    19411883  if (image_nil == 0) {
     1884#ifdef WINDOWS
     1885    wperror("Couldn't load lisp heap image");
     1886#else
    19421887    fprintf(stderr, "Couldn't load lisp heap image from %s:\n%s\n", path, strerror(errno));
     1888#endif
    19431889    exit(-1);
    19441890  }
     
    19851931#endif
    19861932#endif
     1933#ifdef WINDOWS
     1934  extern void *windows_find_symbol(void *, char *);
     1935  return windows_find_symbol(handle, name);
     1936#endif
    19871937}
    19881938
  • trunk/source/lisp-kernel/thread_manager.c

    r10464 r10565  
    4444
    4545#ifdef WINDOWS
     46extern pc spentry_start, spentry_end,subprims_start,subprims_end;
     47extern pc restore_win64_context_start, restore_win64_context_end,
     48  restore_win64_context_load_rcx, restore_win64_context_iret;
     49
     50extern void interrupt_handler(int, siginfo_t *, ExceptionInformation *);
     51
     52BOOL (*pCancelIoEx)(HANDLE, OVERLAPPED*) = NULL;
     53
     54
     55extern void *windows_find_symbol(void*, char*);
     56
    4657int
    4758raise_thread_interrupt(TCR *target)
    4859{
     60  /* GCC doesn't align CONTEXT corrcectly */
     61  char _contextbuf[sizeof(CONTEXT)+__alignof(CONTEXT)];
     62  CONTEXT  *pcontext;
     63  HANDLE hthread = (HANDLE)(target->osid);
     64  pc where;
     65  area *cs = target->cs_area, *ts = target->cs_area;
     66  DWORD rc;
     67  BOOL io_pending;
     68
     69  pcontext = (CONTEXT *)((((natural)&_contextbuf)+15)&~15);
     70  rc = SuspendThread(hthread);
     71  if (rc == -1) {
     72    return -1;
     73  }
     74  /* What if the suspend count is > 1 at this point ?  I don't think
     75     that that matters, but I'm not sure */
     76  pcontext->ContextFlags = CONTEXT_ALL;
     77  rc = GetThreadContext(hthread, pcontext);
     78  if (rc == 0) {
     79    wperror("GetThreadContext");
     80  }
     81
     82  where = (pc)(xpPC(pcontext));
     83 
     84  if ((target->valence != TCR_STATE_LISP) ||
     85      (TCR_INTERRUPT_LEVEL(target) < 0) ||
     86      (target->unwinding != 0) ||
     87      (!((where < (pc)lisp_global(HEAP_END)) &&
     88         (where >= (pc)lisp_global(HEAP_START))) &&
     89       !((where < spentry_end) && (where >= spentry_start)) &&
     90       !((where < subprims_end) && (where >= subprims_start)) &&
     91       !((where < (pc) 0x16000) &&
     92         (where >= (pc) 0x15000)) &&
     93       !((where < (pc) (ts->high)) &&
     94         (where >= (pc) (ts->low))))) {
     95    /* If the thread's in a blocking syscall, it'd be nice to
     96       get it out of that state here. */
     97    GetThreadIOPendingFlag(hthread,&io_pending);
     98    target->interrupt_pending = (1LL << (nbits_in_word - 1LL));
     99    ResumeThread(hthread);
     100    if (io_pending) {
     101      pending_io * pending = (pending_io *) (target->foreign_exception_status);
     102      if (pCancelIoEx) {
     103        pCancelIoEx(pending->h, pending->o);
     104      } else {
     105        CancelIo(pending->h);
     106      }
     107    }
     108    return 0;
     109  } else {
     110    /* Thread is running lisp code with interupts enabled.  Set it
     111       so that it calls out and then returns to the context,
     112       handling any necessary pc-lusering. */
     113    LispObj foreign_rsp = (((LispObj)(target->foreign_sp))-0x200)&~15;
     114    CONTEXT *icontext = ((CONTEXT *) foreign_rsp) -1;
     115    icontext = (CONTEXT *)(((LispObj)icontext)&~15);
     116   
     117    *icontext = *pcontext;
     118   
     119    xpGPR(pcontext,REG_RCX) = SIGNAL_FOR_PROCESS_INTERRUPT;
     120    xpGPR(pcontext,REG_RDX) = 0;
     121    xpGPR(pcontext,REG_R8) = (LispObj) icontext;
     122    xpGPR(pcontext,REG_RSP) = (LispObj)(((LispObj *)icontext)-1);
     123    *(((LispObj *)icontext)-1) = (LispObj)raise_thread_interrupt;
     124    xpPC(pcontext) = (LispObj)interrupt_handler;
     125    SetThreadContext(hthread,pcontext);
     126    ResumeThread(hthread);
     127    return 0;
     128  }
    49129}
    50130#else
     
    329409    status = SEM_TIMEDWAIT(s,&q);
    330410#endif
     411#ifdef USE_WINDOWS_SEMAPHORES
     412    status = (WaitForSingleObject(s,1000L) == WAIT_TIMEOUT) ? 1 : 0;
     413#endif
    331414  } while (status != 0);
    332415}
     
    335418wait_on_semaphore(void *s, int seconds, int millis)
    336419{
     420#ifdef USE_POSIX_SEMAPHORES
    337421  int nanos = (millis % 1000) * 1000000;
    338 #ifdef USE_POSIX_SEMAPHORES
    339422  int status;
    340423
     
    356439#endif
    357440#ifdef USE_MACH_SEMAPHORES
     441  int nanos = (millis % 1000) * 1000000;
    358442  mach_timespec_t q = {seconds, nanos};
    359443  int status = SEM_TIMEDWAIT(s, q);
     
    366450  default: return EINVAL;
    367451  }
     452#endif
     453#ifdef USE_WINDOWS_SEMAPHORES
     454  switch (WaitForSingleObject(s, seconds*1000L+(DWORD)millis)) {
     455  case WAIT_OBJECT_0:
     456    return 0;
     457  case WAIT_TIMEOUT:
     458    return ETIMEDOUT;
     459  default:
     460    break;
     461  }
     462  return EINVAL;
    368463
    369464#endif
     
    392487current_thread_osid()
    393488{
     489  TCR *tcr = get_tcr(false);
     490  LispObj current = 0;
     491
     492  if (tcr) {
     493    current = tcr->osid;
     494  }
     495  if (current == 0) {
     496    DuplicateHandle(GetCurrentProcess(),
     497                    GetCurrentThread(),
     498                    GetCurrentProcess(),
     499                    &current,
     500                    0,
     501                    FALSE,
     502                    DUPLICATE_SAME_ACCESS);
     503    if (tcr) {
     504      tcr->osid = current;
     505    }
     506  }
     507  return current;
    394508}
    395509#else
     
    451565#ifdef WINDOWS
    452566void
    453 os_get_stack_bounds(LispObj q,void **base, natural *size)
    454 {
    455 }
    456 #else
    457 void
    458 os_get_stack_bounds(LispObj q,void **base, natural *size)
    459 {
    460   pthread_t p = (pthread_t)(q);
     567os_get_current_thread_stack_bounds(void **base, natural *size)
     568{
     569  natural natbase;
     570  MEMORY_BASIC_INFORMATION info;
     571  void *addr = (void *)current_stack_pointer();
     572 
     573  VirtualQuery(addr, &info, sizeof(info));
     574  natbase = (natural)info.BaseAddress+info.RegionSize;
     575  *size = natbase - (natural)(info.AllocationBase);
     576  *base = (void *)natbase;
     577}
     578#else
     579void
     580os_get_current_thread_stack_bounds(void **base, natural *size)
     581{
     582  pthread_t p = pthread_self();
    461583#ifdef DARWIN
    462584  *base = pthread_get_stackaddr_np(p);
     
    509631  return (void *)(natural)s;
    510632#endif
     633#ifdef USE_WINDOWS_SEMAPHORES
     634  return CreateSemaphore(NULL, count, 0x7fffL, NULL);
     635#endif
    511636}
    512637
     
    556681    semaphore_destroy(mach_task_self(),((semaphore_t)(natural) *s));
    557682#endif
     683#ifdef USE_WINDOWS_SEMAPHORES
     684    CloseHandle(*s);
     685#endif
    558686    *s=NULL;
    559687  }
     
    564692tsd_set(LispObj key, void *datum)
    565693{
     694  TlsSetValue((DWORD)key, datum);
    566695}
    567696
     
    569698tsd_get(LispObj key)
    570699{
     700  return TlsGetValue((DWORD)key);
    571701}
    572702#else
     
    740870  Caller must hold the area_lock.
    741871*/
    742 #ifdef WINDOWS
    743 TCR *
    744 new_tcr(natural vstack_size, natural tstack_size)
    745 {
    746 }
    747 #else
    748872TCR *
    749873new_tcr(natural vstack_size, natural tstack_size)
     
    754878  area *a;
    755879  int i;
     880#ifndef WINDOWS
    756881  sigset_t sigmask;
    757882
    758883  sigemptyset(&sigmask);
    759884  pthread_sigmask(SIG_SETMASK,&sigmask, NULL);
     885#endif
     886
    760887#ifdef HAVE_TLS
    761888  TCR *tcr = &current_tcr;
     
    817944  }
    818945  TCR_INTERRUPT_LEVEL(tcr) = (LispObj) (-1<<fixnum_shift);
     946#ifndef WINDOWS
    819947  tcr->shutdown_count = PTHREAD_DESTRUCTOR_ITERATIONS;
     948#endif
    820949  return tcr;
    821950}
    822 #endif
    823951
    824952void
     
    9271055#endif
    9281056#ifdef WINDOWS
    929           /* ThreadSelf() */ 23
     1057          GetCurrentThreadId()
    9301058#endif
    9311059          );
     
    9801108  natural stack_size = 0;
    9811109
    982   os_get_stack_bounds(current_thread_osid(),&stack_base, &stack_size);
     1110  os_get_current_thread_stack_bounds(&stack_base, &stack_size);
    9831111  thread_init_tcr(tcr, stack_base, stack_size);
    9841112  enqueue_tcr(tcr);
     
    9921120#endif
    9931121
    994 #ifdef WINDOWS
    995 Ptr
    996 create_stack(int size)
    997 {
    998 }
    999 #else
    10001122Ptr
    10011123create_stack(natural size)
     
    10031125  Ptr p;
    10041126  size=align_to_power_of_2(size, log2_page_size);
    1005   p = (Ptr) mmap(NULL,
    1006                  (size_t)size,
    1007                  PROT_READ | PROT_WRITE | PROT_EXEC,
    1008                  MAP_PRIVATE | MAP_ANON | MAP_GROWSDOWN,
    1009                  -1,    /* Darwin insists on this when not mmap()ing
    1010                            a real fd */
    1011                  0);
     1127  p = (Ptr) MapMemoryForStack((size_t)size);
    10121128  if (p != (Ptr)(-1)) {
    10131129    *((size_t *)p) = size;
     
    10171133
    10181134}
    1019 #endif
    10201135
    10211136void *
     
    10251140}
    10261141
    1027 #ifdef WINDOWS
    10281142void
    10291143free_stack(void *s)
    10301144{
    1031 }
    1032 #else
    1033 void
    1034 free_stack(void *s)
    1035 {
    10361145  size_t size = *((size_t *)s);
    1037   munmap(s, size);
    1038 }
    1039 #endif
     1146  UnMapMemory(s, size);
     1147}
    10401148
    10411149Boolean threads_initialized = false;
     
    10461154count_cpus()
    10471155{
     1156  SYSTEM_INFO si;
     1157
     1158  GetSystemInfo(&si);
     1159  if (si.dwNumberOfProcessors > 1) {
     1160    spin_lock_tries = 1024;
     1161  }
    10481162}
    10491163#else
     
    10741188#endif
    10751189
     1190void
     1191init_threads(void * stack_base, TCR *tcr)
     1192{
     1193  lisp_global(INITIAL_TCR) = (LispObj)ptr_to_lispobj(tcr);
    10761194#ifdef WINDOWS
    1077 void
    1078 init_threads(void * stack_base, TCR *tcr)
    1079 {
    1080 }
    1081 void *
    1082 lisp_thread_entry(void *param)
    1083 {
    1084 }
    1085 #else
    1086 void
    1087 init_threads(void * stack_base, TCR *tcr)
    1088 {
    1089   lisp_global(INITIAL_TCR) = (LispObj)ptr_to_lispobj(tcr);
     1195  lisp_global(TCR_KEY) = TlsAlloc();
     1196  pCancelIoEx = windows_find_symbol(NULL, "CancelIoEx");
     1197#else
    10901198  pthread_key_create((pthread_key_t *)&(lisp_global(TCR_KEY)), shutdown_thread_tcr);
    10911199  thread_signal_setup();
    1092 
     1200#endif
     1201 
    10931202#ifndef USE_FUTEX
    10941203  count_cpus();
     
    10981207
    10991208
     1209#ifdef WINDOWS
     1210unsigned
     1211#else
    11001212void *
     1213#endif
    11011214lisp_thread_entry(void *param)
    11021215{
    11031216  thread_activation *activation = (thread_activation *)param;
    11041217  TCR *tcr = new_tcr(activation->vsize, activation->tsize);
     1218#ifndef WINDOWS
    11051219  sigset_t mask, old_mask;
    11061220
    11071221  sigemptyset(&mask);
    11081222  pthread_sigmask(SIG_SETMASK, &mask, &old_mask);
     1223#endif
    11091224
    11101225  register_thread_tcr(tcr);
    11111226
     1227#ifndef WINDOWS
    11121228  pthread_cleanup_push(tcr_cleanup,(void *)tcr);
     1229#endif
    11131230  tcr->vs_area->active -= node_size;
    11141231  *(--tcr->save_vsp) = lisp_nil;
     
    11231240    start_lisp(TCR_TO_TSD(tcr),0);
    11241241  } while (tcr->flags & (1<<TCR_FLAG_BIT_AWAITING_PRESET));
     1242#ifndef WINDOWS
    11251243  pthread_cleanup_pop(true);
    1126 
    1127 }
    1128 #endif
     1244#else
     1245  tcr_cleanup(tcr);
     1246#endif
     1247#ifdef WINDOWS
     1248  return 0;
     1249#else
     1250  return NULL;
     1251#endif
     1252}
    11291253
    11301254void *
     
    11701294xDisposeThread(TCR *tcr)
    11711295{
     1296  return 0;                     /* I don't think that this is ever called. */
    11721297}
    11731298#else
     
    12041329create_system_thread(size_t stack_size,
    12051330                     void* stackaddr,
    1206                      void* (*start_routine)(void *),
     1331                     unsigned (*start_routine)(void *),
    12071332                     void* param)
    12081333{
     1334  HANDLE thread_handle;
     1335
     1336  stack_size = ((stack_size+(((1<<16)-1)))&~((1<<16)-1));
     1337
     1338  thread_handle = (HANDLE)_beginthreadex(NULL,
     1339                                         0/*stack_size*/,
     1340                                         start_routine,
     1341                                         param,
     1342                                         0,
     1343                                         NULL);
     1344
     1345  if (thread_handle == NULL) {
     1346    wperror("CreateThread");
     1347  }
     1348  return (LispObj) ptr_to_lispobj(thread_handle);
    12091349}
    12101350#else
     
    13001440
    13011441#ifdef WINDOWS
     1442
    13021443Boolean
    13031444suspend_tcr(TCR *tcr)
    13041445{
     1446  int suspend_count = atomic_incf(&(tcr->suspend_count));
     1447  DWORD rc;
     1448  if (suspend_count == 1) {
     1449    /* Can't seem to get gcc to align a CONTEXT structure correctly */
     1450    char _contextbuf[sizeof(CONTEXT)+__alignof(CONTEXT)];
     1451
     1452    CONTEXT *suspend_context, *pcontext;
     1453    HANDLE hthread = (HANDLE)(tcr->osid);
     1454    pc where;
     1455    area *cs = tcr->cs_area;
     1456    LispObj foreign_rsp;
     1457
     1458    pcontext = (CONTEXT *)((((natural)&_contextbuf)+15)&~15);
     1459
     1460    rc = SuspendThread(hthread);
     1461    if (rc == -1) {
     1462      /* If the thread's simply dead, we should handle that here */
     1463      wperror("SuspendThread");
     1464      return false;
     1465    }
     1466    pcontext->ContextFlags = CONTEXT_ALL;
     1467    rc = GetThreadContext(hthread, pcontext);
     1468    if (rc == 0) {
     1469      wperror("GetThreadContext");
     1470    }
     1471    where = (pc)(xpPC(pcontext));
     1472
     1473    if (tcr->valence == TCR_STATE_LISP) {
     1474      if ((where >= restore_win64_context_start) &&
     1475          (where < restore_win64_context_end)) {
     1476        /* Thread has started to return from an exception. */
     1477        if (where < restore_win64_context_load_rcx) {
     1478          /* In the process of restoring registers; context still in
     1479             %rcx.  Just make our suspend_context be the context
     1480             we're trying to restore, so that we'll resume from
     1481             the suspend in the same context that we're trying to
     1482             restore */
     1483          *pcontext = * (CONTEXT *)(pcontext->Rcx);
     1484        } else {
     1485          /* Most of the context has already been restored; fix %rcx
     1486             if need be, then restore ss:rsp, cs:rip, and flags. */
     1487          x64_iret_frame *iret_frame = (x64_iret_frame *) (pcontext->Rsp);
     1488          if (where == restore_win64_context_load_rcx) {
     1489            pcontext->Rcx = ((CONTEXT*)(pcontext->Rcx))->Rcx;
     1490          }
     1491          pcontext->Rip = iret_frame->Rip;
     1492          pcontext->SegCs = (WORD) iret_frame->Cs;
     1493          pcontext->EFlags = (DWORD) iret_frame->Rflags;
     1494          pcontext->Rsp = iret_frame->Rsp;
     1495          pcontext->SegSs = (WORD) iret_frame->Ss;
     1496        }
     1497        tcr->suspend_context = NULL;
     1498      } else {
     1499        area *ts = tcr->ts_area;
     1500        /* If we're in the lisp heap, or in x86-spentry64.o, or in
     1501           x86-subprims64.o, or in the subprims jump table at #x15000,
     1502           or on the tstack ... we're just executing lisp code.  Otherwise,
     1503           we got an exception while executing lisp code, but haven't
     1504           yet entered the handler yet (still in Windows exception glue
     1505           or switching stacks or something.)  In the latter case, we
     1506           basically want to get to he handler and have it notice
     1507           the pending exception request, and suspend the thread at that
     1508           point. */
     1509        if (!((where < (pc)lisp_global(HEAP_END)) &&
     1510              (where >= (pc)lisp_global(HEAP_START))) &&
     1511            !((where < spentry_end) && (where >= spentry_start)) &&
     1512            !((where < subprims_end) && (where >= subprims_start)) &&
     1513            !((where < (pc) 0x16000) &&
     1514              (where >= (pc) 0x15000)) &&
     1515            !((where < (pc) (ts->high)) &&
     1516              (where >= (pc) (ts->low)))) {
     1517          /* The thread has lisp valence, but is not executing code
     1518             where we expect lisp code to be and is not exiting from
     1519             an exception handler.  That pretty much means that it's
     1520             on its way into an exception handler; we have to handshake
     1521             until it enters an exception-wait state. */
     1522          /* There are likely race conditions here */
     1523          SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_SUSPEND);
     1524          ResumeThread(hthread);
     1525          SEM_WAIT_FOREVER(tcr->suspend);
     1526          SuspendThread(hthread);
     1527          /* The thread is either waiting for its resume semaphore to
     1528             be signaled or is about to wait.  Signal it now, while
     1529             the thread's suspended. */
     1530          SEM_RAISE(tcr->resume);
     1531          pcontext->ContextFlags = CONTEXT_ALL;
     1532          GetThreadContext(hthread, pcontext);
     1533        }
     1534      }
     1535    } else {
     1536      if (tcr->valence == TCR_STATE_EXCEPTION_RETURN) {
     1537        *pcontext = *tcr->pending_exception_context;
     1538        tcr->pending_exception_context = NULL;
     1539        tcr->valence = TCR_STATE_LISP;
     1540      }
     1541    }
     1542
     1543    /* If the context's stack pointer is pointing into the cs_area,
     1544       copy the context below the stack pointer. else copy it
     1545       below tcr->foreign_rsp. */
     1546    foreign_rsp = xpGPR(pcontext,Isp);
     1547
     1548    if ((foreign_rsp < (LispObj)(cs->low)) ||
     1549        (foreign_rsp >= (LispObj)(cs->high))) {
     1550      foreign_rsp = (LispObj)(tcr->foreign_sp);
     1551    }
     1552    foreign_rsp -= 0x200;
     1553    foreign_rsp &= ~15;
     1554    suspend_context = (CONTEXT *)(foreign_rsp)-1;
     1555    *suspend_context = *pcontext;
     1556    tcr->suspend_context = suspend_context;
     1557    return true;
     1558  }
     1559  return false;
    13051560}
    13061561#else
     
    13311586#endif
    13321587
     1588#ifdef WINDOWS
     1589Boolean
     1590tcr_suspend_ack(TCR *tcr)
     1591{
     1592  return true;
     1593}
     1594#else
    13331595Boolean
    13341596tcr_suspend_ack(TCR *tcr)
     
    13401602  return true;
    13411603}
    1342 
     1604#endif
    13431605     
    13441606
     
    13591621}
    13601622         
    1361 
     1623#ifdef WINDOWS
     1624Boolean
     1625resume_tcr(TCR *tcr)
     1626{
     1627  int suspend_count = atomic_decf(&(tcr->suspend_count)), err;
     1628  DWORD rc;
     1629  if (suspend_count == 0) {
     1630    CONTEXT *context = tcr->suspend_context;
     1631    HANDLE hthread = (HANDLE)(tcr->osid);
     1632
     1633    if (context == NULL) {
     1634      Bug(NULL, "no suspend_context for TCR = 0x%Ix", (natural)tcr);
     1635    }
     1636    tcr->suspend_context = NULL;
     1637    SetThreadContext(hthread,context);
     1638    rc = ResumeThread(hthread);
     1639    if (rc == -1) {
     1640      wperror("ResumeThread");
     1641      return false;
     1642    }
     1643    return true;
     1644  }
     1645  return false;
     1646}   
     1647#else
    13621648Boolean
    13631649resume_tcr(TCR *tcr)
     
    13731659  return false;
    13741660}
     1661#endif
    13751662
    13761663   
  • trunk/source/lisp-kernel/x86-asmutils64.s

    r8575 r10565  
    207207        __(ret)
    208208_endfn
    209         __endif         
     209        __endif
     210
     211        __ifdef([WIN64])
     212/* %rcx = CONTEXT, %rdx = tcr, %r8 = old_valence.  This pretty
     213   much has to be uninterruptible */       
     214_exportfn(C(restore_win64_context))
     215Xrestore_win64_context_start:   
     216        __(subq $0x38,%rsp)
     217        __(xorl %eax,%eax)
     218        __(movq %r8,tcr.valence(%rdx))
     219        __(movq %rax,tcr.pending_exception_context(%rdx))
     220        __(fxrstor win64_context.fpstate(%rcx))
     221        __(movapd win64_context.Xmm0(%rcx),%xmm0)
     222        __(movapd win64_context.Xmm1(%rcx),%xmm1)
     223        __(movapd win64_context.Xmm2(%rcx),%xmm2)
     224        __(movapd win64_context.Xmm3(%rcx),%xmm3)
     225        __(movapd win64_context.Xmm4(%rcx),%xmm4)
     226        __(movapd win64_context.Xmm5(%rcx),%xmm5)
     227        __(movapd win64_context.Xmm6(%rcx),%xmm6)
     228        __(movapd win64_context.Xmm7(%rcx),%xmm7)
     229        __(movapd win64_context.Xmm8(%rcx),%xmm8)
     230        __(movapd win64_context.Xmm9(%rcx),%xmm9)
     231        __(movapd win64_context.Xmm10(%rcx),%xmm10)
     232        __(movapd win64_context.Xmm11(%rcx),%xmm11)
     233        __(movapd win64_context.Xmm12(%rcx),%xmm12)
     234        __(movapd win64_context.Xmm13(%rcx),%xmm13)
     235        __(movapd win64_context.Xmm14(%rcx),%xmm14)
     236        __(movapd win64_context.Xmm15(%rcx),%xmm15)
     237        __(ldmxcsr win64_context.MxCsr(%rcx))
     238        __(movw win64_context.SegSs(%rcx),%ax)
     239        __(movw %ax,0x20(%rsp))
     240        __(movq win64_context.Rsp(%rcx),%rax)
     241        __(movq %rax,0x18(%rsp))
     242        __(movl win64_context.EFlags(%rcx),%eax)
     243        __(movl %eax,0x10(%rsp))
     244        __(movw win64_context.SegCs(%rcx),%ax)
     245        __(movw %ax,8(%rsp))
     246        __(movq win64_context.Rip(%rcx),%rax)
     247        __(movq %rax,(%rsp))
     248        __(movq win64_context.Rax(%rcx),%rax)
     249        __(movq win64_context.Rbx(%rcx),%rbx)
     250        __(movq win64_context.Rdx(%rcx),%rdx)
     251        __(movq win64_context.Rdi(%rcx),%rdi)
     252        __(movq win64_context.Rsi(%rcx),%rsi)
     253        __(movq win64_context.Rbp(%rcx),%rbp)
     254        __(movq win64_context.R8(%rcx),%r8)
     255        __(movq win64_context.R9(%rcx),%r9)
     256        __(movq win64_context.R10(%rcx),%r10)
     257        __(movq win64_context.R11(%rcx),%r11)
     258        __(movq win64_context.R12(%rcx),%r12)
     259        __(movq win64_context.R13(%rcx),%r13)
     260        __(movq win64_context.R14(%rcx),%r14)
     261        __(movq win64_context.R15(%rcx),%r15)
     262Xrestore_win64_context_load_rcx:               
     263        __(movq win64_context.Rcx(%rcx),%rcx)
     264Xrestore_win64_context_iret:           
     265        __(iretq)
     266Xrestore_win64_context_end:             
     267        __(nop)
     268_endfn
     269       
     270_exportfn(C(windows_switch_to_foreign_stack))
     271        __(pop %rax)
     272        __(lea -0x20(%rcx),%rsp)
     273        __(push %rax)
     274        __(movq %r8,%rcx)
     275        __(jmp *%rdx)
     276_endfn       
     277
     278        .data
     279        .globl C(restore_win64_context_start)
     280        .globl C(restore_win64_context_end)
     281        .globl C(restore_win64_context_load_rcx)
     282        .globl C(restore_win64_context_iret)
     283C(restore_win64_context_start):  .quad Xrestore_win64_context_start
     284C(restore_win64_context_end): .quad Xrestore_win64_context_end
     285C(restore_win64_context_load_rcx):  .quad Xrestore_win64_context_load_rcx
     286C(restore_win64_context_iret): .quad Xrestore_win64_context_iret
     287
     288        __endif
     289               
    210290        _endfile
  • trunk/source/lisp-kernel/x86-constants64.h

    r10010 r10565  
    5858
    5959#ifdef WIN64
    60 /* DWORD64 indices in CONTEXT */
    61 #define REG_RAX     15
    62 #define REG_RCX     16
    63 #define REG_RDX     17
    64 #define REG_RBX     18
    65 #define REG_RSP     19
    66 #define REG_RBP     20
    67 #define REG_RSI     21
    68 #define REG_RDI     22
    69 #define REG_R8      23
    70 #define REG_R9      24
    71 #define REG_R10     25
    72 #define REG_R11     26
    73 #define REG_R12     27
    74 #define REG_R13     28
    75 #define REG_R14     29
    76 #define REG_R15     30
    77 #define REG_RIP     31
    78 #define REG_EFL      8  /* In the high 32 bits of the 64-bit word at index 8 */
     60/* DWORD64 indices in &(CONTEXT->Rax) */
     61#define REG_RAX     0
     62#define REG_RCX     1
     63#define REG_RDX     2
     64#define REG_RBX     3
     65#define REG_RSP     4
     66#define REG_RBP     5
     67#define REG_RSI     6
     68#define REG_RDI     7
     69#define REG_R8      8
     70#define REG_R9      9
     71#define REG_R10     10
     72#define REG_R11     11
     73#define REG_R12     12
     74#define REG_R13     13
     75#define REG_R14     14
     76#define REG_R15     15
     77#define REG_RIP     16
    7978#endif
    8079/* Define indices of the GPRs in the mcontext component of a ucontext */
     
    533532#define t_offset (t_value-nil_value)
    534533
     534typedef struct {
     535  natural Rip;
     536  natural Cs;                   /* in low 16 bits */
     537  natural Rflags;               /* in low 32 bits */
     538  natural Rsp;
     539  natural Ss;                   /* in low 16 bits*/
     540} x64_iret_frame;
     541
    535542/*
    536543  These were previously global variables.  There are lots of implicit
  • trunk/source/lisp-kernel/x86-constants64.s

    r8575 r10565  
    955955        _ends
    956956
     957        _struct(win64_context,0)
     958         _field(P1Home, 8)
     959         _field(P2Home, 8)
     960         _field(P3Home, 8)
     961         _field(P4Home, 8)
     962         _field(P5Home, 8)
     963         _field(P6Home, 8)
     964         _field(ContextFlags, 4)
     965         _field(MxCsr, 4)
     966         _field(SegCs, 2)
     967         _field(SegDs, 2)
     968         _field(SegEs, 2)
     969         _field(SegFs, 2)
     970         _field(SegGs, 2)
     971         _field(SegSs, 2)
     972         _field(EFlags, 4)
     973         _field(Dr0, 8)
     974         _field(Dr1, 8)
     975         _field(Dr2, 8)
     976         _field(Dr3, 8)
     977         _field(Dr6, 8)
     978         _field(Dr7, 8)
     979         _field(Rax, 8)
     980         _field(Rcx, 8)
     981         _field(Rdx, 8)
     982         _field(Rbx, 8)
     983         _field(Rsp, 8)
     984         _field(Rbp, 8)
     985         _field(Rsi, 8)
     986         _field(Rdi, 8)
     987         _field(R8, 8)
     988         _field(R9, 8)
     989         _field(R10, 8)
     990         _field(R11, 8)
     991         _field(R12, 8)
     992         _field(R13, 8)
     993         _field(R14, 8)
     994         _field(R15, 8)
     995         _field(Rip, 8)
     996         _struct_label(fpstate)
     997         _field(Header, 32)
     998         _field(Legacy, 128)
     999         _field(Xmm0, 16)
     1000         _field(Xmm1, 16)       
     1001         _field(Xmm2, 16)       
     1002         _field(Xmm3, 16)       
     1003         _field(Xmm4, 16)       
     1004         _field(Xmm5, 16)       
     1005         _field(Xmm6, 16)       
     1006         _field(Xmm7, 16)       
     1007         _field(Xmm8, 16)       
     1008         _field(Xmm9, 16)       
     1009         _field(Xmm10, 16)       
     1010         _field(Xmm11, 16)       
     1011         _field(Xmm12, 16)       
     1012         _field(Xmm13, 16)       
     1013         _field(Xmm14, 16)       
     1014         _field(Xmm15, 16)
     1015         _field(__pad, 96)
     1016         _field(VectorRegister, 416)
     1017         _field(VectorControl, 8)
     1018         _field(DebugControl, 8)
     1019         _field(LastBranchToRip, 8)
     1020         _field(LastBranchFromRip, 8)
     1021         _field(LastExceptionToRip, 8)
     1022         _field(LastExceptionFromRip, 8)
     1023 _ends
    9571024
    9581025       
  • trunk/source/lisp-kernel/x86-exceptions.c

    r10492 r10565  
    3838#include <sys/syslog.h>
    3939#endif
    40 
     40#ifdef WINDOWS
     41#include <windows.h>
     42#include <winternl.h>
     43#include <ntstatus.h>
     44#endif
    4145
    4246int
     
    767771}
    768772
    769 #ifdef WINDOWS
    770773Boolean
    771774handle_fault(TCR *tcr, ExceptionInformation *xp, siginfo_t *info, int old_valence)
    772775{
    773 }
    774 
    775 Boolean
    776 handle_floating_point_exception(TCR *tcr, ExceptionInformation *xp, siginfo_t *info)
    777 {
    778 }
    779 #else
    780 Boolean
    781 handle_fault(TCR *tcr, ExceptionInformation *xp, siginfo_t *info, int old_valence)
    782 {
    783776#ifdef FREEBSD
    784777  BytePtr addr = (BytePtr) xp->uc_mcontext.mc_addr;
    785778#else
     779#ifdef WINDOWS
     780  BytePtr addr = NULL;          /* FIX THIS */
     781#else
    786782  BytePtr addr = (BytePtr) info->si_addr;
     783#endif
    787784#endif
    788785
     
    822819handle_floating_point_exception(TCR *tcr, ExceptionInformation *xp, siginfo_t *info)
    823820{
    824   int code = info->si_code, skip;
     821  int code,skip;
    825822  LispObj  xcf, cmain = nrs_CMAIN.vcell,
    826823    save_vsp = xpGPR(xp,Isp);
     
    830827  LispObj save_ebp = xpGPR(xp,Iebp);
    831828#endif
     829#ifdef WINDOWS
     830  code = info->ExceptionCode;
     831#else
     832  code = info->si_code;
     833#endif 
    832834
    833835  if ((fulltag_of(cmain) == fulltag_misc) &&
     
    847849  }
    848850}
    849 #endif
     851
    850852
    851853Boolean
     
    950952}
    951953
    952 #ifdef WINDOWS
    953 Boolean
    954 handle_exception(int signum, siginfo_t *info, ExceptionInformation  *context, TCR *tcr, int old_valence)
    955 {
    956 }
    957 #else
    958954Boolean
    959955handle_exception(int signum, siginfo_t *info, ExceptionInformation  *context, TCR *tcr, int old_valence)
     
    995991          {
    996992            char msg[512];
    997              
     993
    998994            get_lisp_string(xpGPR(context,Iarg_z),msg, sizeof(msg)-1);
    999995            lisp_Debugger(context, info, debug_entry_dbg, false, msg);
    1000996          }
    1001           return true;
    1002            
     997          return true;
     998         
    1003999        default:
    10041000          return handle_error(tcr, context);
     
    11071103  }
    11081104}
    1109 #endif
     1105
    11101106
    11111107/*
     
    11231119  tcr->valence = TCR_STATE_EXCEPTION_WAIT;
    11241120
     1121#ifdef WINDOWS
     1122  if (tcr->flags & (1<<TCR_FLAG_BIT_PENDING_SUSPEND)) {
     1123    CLR_TCR_FLAG(tcr, TCR_FLAG_BIT_PENDING_SUSPEND);
     1124    SEM_RAISE(tcr->suspend);
     1125    SEM_WAIT_FOREVER(tcr->resume);
     1126  }
     1127#else
    11251128  ALLOW_EXCEPTIONS(context);
     1129#endif
    11261130  return old_valence;
    11271131
     
    13061310#endif
    13071311
    1308 #ifdef WINDOWS
    1309 LispObj *
    1310 copy_ucontext(ExceptionInformation *context, LispObj *current, copy_ucontext_last_arg_t fp)
    1311 {
    1312 }
    1313 #else
     1312#ifndef WINDOWS
    13141313LispObj *
    13151314copy_ucontext(ExceptionInformation *context, LispObj *current, copy_ucontext_last_arg_t fp)
     
    13321331#endif
    13331332
     1333
    13341334LispObj *
    13351335find_foreign_rsp(LispObj rsp, area *foreign_area, TCR *tcr)
     
    13541354#endif
    13551355
     1356#ifndef WINDOWS
    13561357void
    13571358handle_signal_on_foreign_stack(TCR *tcr,
     
    13991400  switch_to_foreign_stack(foreign_rsp,handler,signum,info_copy,xp);
    14001401}
    1401 
    1402 
     1402#endif
     1403
     1404
     1405#ifndef WINDOWS
    14031406#ifndef USE_SIGALTSTACK
    14041407void
     
    14521455}
    14531456#endif
     1457#endif
    14541458
    14551459Boolean
     
    14631467
    14641468#ifdef WINDOWS
    1465 void
    1466 interrupt_handler (int signum, siginfo_t *info, ExceptionInformation *context)
    1467 {
    1468 }
    1469 #else
     1469extern LONG restore_win64_context(ExceptionInformation *, TCR *, int;);
     1470#endif
     1471
    14701472void
    14711473interrupt_handler (int signum, siginfo_t *info, ExceptionInformation *context)
     
    14751477#endif
    14761478  TCR *tcr = get_interrupt_tcr(false);
     1479  int old_valence = tcr->valence;
     1480
    14771481  if (tcr) {
    14781482    if ((TCR_INTERRUPT_LEVEL(tcr) < 0) ||
     
    14851489        ! stack_pointer_on_vstack_p(xpGPR(context,Iebp), tcr)) {
    14861490#endif
    1487       tcr->interrupt_pending = (1L << (nbits_in_word - 1L));
     1491      tcr->interrupt_pending = (((natural) 1)<< (nbits_in_word - ((natural)1)));
    14881492    } else {
    14891493      LispObj cmain = nrs_CMAIN.vcell;
     
    14961500
    14971501        xframe_list xframe_link;
    1498         int old_valence;
    14991502        signed_natural alloc_displacement = 0;
    15001503        LispObj
     
    15311534        tcr->flags |= old_foreign_exception;
    15321535        unlock_exception_lock_in_handler(tcr);
     1536#ifndef WINDOWS
    15331537        exit_signal_handler(tcr, old_valence);
     1538#endif
    15341539      }
    15351540    }
     
    15401545  }
    15411546#endif
     1547#ifdef WINDOWS
     1548  restore_win64_context(context,tcr,old_valence);
     1549#else
    15421550  SIGRETURN(context);
    1543 }
    1544 #endif
    1545 
     1551#endif
     1552}
     1553
     1554
     1555#ifndef WINDOWS
    15461556#ifndef USE_SIGALTSTACK
    15471557void
     
    15961606
    15971607#endif
    1598 
    1599 #ifdef WINDOWS
    1600 void
    1601 install_signal_handler(int signo, void * handler)
    1602 {
    1603 }
    1604 #else
     1608#endif
     1609
     1610#ifndef WINDOWS
    16051611void
    16061612install_signal_handler(int signo, void * handler)
     
    16301636
    16311637#ifdef WINDOWS
     1638BOOL
     1639ControlEventHandler(DWORD event)
     1640{
     1641  switch(event) {
     1642  case CTRL_C_EVENT:
     1643    lisp_global(INTFLAG) = (1 << fixnumshift);
     1644    return TRUE;
     1645    break;
     1646  default:
     1647    return FALSE;
     1648  }
     1649}
     1650
     1651int
     1652map_windows_exception_code_to_posix_signal(DWORD code)
     1653{
     1654  switch (code) {
     1655  case EXCEPTION_ACCESS_VIOLATION:
     1656    return SIGSEGV;
     1657  case EXCEPTION_FLT_DENORMAL_OPERAND:
     1658  case EXCEPTION_FLT_DIVIDE_BY_ZERO:
     1659  case EXCEPTION_FLT_INEXACT_RESULT:
     1660  case EXCEPTION_FLT_INVALID_OPERATION:
     1661  case EXCEPTION_FLT_OVERFLOW:
     1662  case EXCEPTION_FLT_STACK_CHECK:
     1663  case EXCEPTION_FLT_UNDERFLOW:
     1664  case EXCEPTION_INT_DIVIDE_BY_ZERO:
     1665  case EXCEPTION_INT_OVERFLOW:
     1666    return SIGFPE;
     1667  case EXCEPTION_PRIV_INSTRUCTION:
     1668  case EXCEPTION_ILLEGAL_INSTRUCTION:
     1669    return SIGILL;
     1670  case EXCEPTION_IN_PAGE_ERROR:
     1671    return SIGBUS;
     1672  case DBG_PRINTEXCEPTION_C:
     1673    return DBG_PRINTEXCEPTION_C;
     1674  default:
     1675    return -1;
     1676  }
     1677}
     1678
     1679
     1680LONG
     1681windows_exception_handler(EXCEPTION_POINTERS *exception_pointers)
     1682{
     1683  TCR *tcr = get_tcr(false);
     1684  DWORD code = exception_pointers->ExceptionRecord->ExceptionCode;
     1685  int old_valence, signal_number;
     1686  ExceptionInformation *context = exception_pointers->ContextRecord;
     1687  siginfo_t *info = exception_pointers->ExceptionRecord;
     1688  xframe_list xframes;
     1689
     1690  old_valence = prepare_to_wait_for_exception_lock(tcr, context);
     1691  wait_for_exception_lock_in_handler(tcr, context, &xframes);
     1692
     1693  signal_number = map_windows_exception_code_to_posix_signal(code);
     1694 
     1695  if (!handle_exception(signal_number, info, context, tcr, old_valence)) {
     1696    char msg[512];
     1697    Boolean foreign = (old_valence != TCR_STATE_LISP);
     1698
     1699    snprintf(msg, sizeof(msg), "Unhandled exception %d (windows code 0x%x) at 0x%Ix, context->regs at 0x%Ix", signal_number, code, xpPC(context), (natural)xpGPRvector(context));
     1700   
     1701    if (lisp_Debugger(context, info, signal_number,  foreign, msg)) {
     1702      SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PROPAGATE_EXCEPTION);
     1703    }
     1704  }
     1705  unlock_exception_lock_in_handler(tcr);
     1706  return restore_win64_context(context, tcr, old_valence);
     1707}
     1708
     1709LONG windows_switch_to_foreign_stack(LispObj, void*, void*);
     1710
     1711LONG
     1712handle_windows_exception_on_foreign_stack(TCR *tcr,
     1713                                          CONTEXT *context,
     1714                                          void *handler,
     1715                                          EXCEPTION_POINTERS *original_ep)
     1716{
     1717  LispObj foreign_rsp =
     1718    (LispObj) find_foreign_rsp(xpGPR(context,Isp), tcr->cs_area, tcr);
     1719  CONTEXT *new_context;
     1720  siginfo_t *new_info;
     1721  EXCEPTION_POINTERS *new_ep;
     1722
     1723  new_context = ((CONTEXT *)(foreign_rsp&~15))-1;
     1724  *new_context = *context;
     1725  foreign_rsp = (LispObj)new_context;
     1726  new_info = ((siginfo_t *)(foreign_rsp&~15))-1;
     1727  *new_info = *original_ep->ExceptionRecord;
     1728  foreign_rsp = (LispObj)new_info;
     1729  new_ep = ((EXCEPTION_POINTERS *)(foreign_rsp&~15))-1;
     1730  foreign_rsp = (LispObj)new_ep & ~15;
     1731  new_ep->ContextRecord = new_context;
     1732  new_ep->ExceptionRecord = new_info;
     1733  return windows_switch_to_foreign_stack(foreign_rsp,handler,new_ep);
     1734}
     1735
     1736LONG
     1737windows_arbstack_exception_handler(EXCEPTION_POINTERS *exception_pointers)
     1738{
     1739  DWORD code = exception_pointers->ExceptionRecord->ExceptionCode;
     1740 
     1741  if ((code & 0x80000000L) == 0) {
     1742    return EXCEPTION_CONTINUE_SEARCH;
     1743  } else {
     1744    TCR *tcr = get_interrupt_tcr(false);
     1745    area *vs = tcr->vs_area;
     1746    BytePtr current_sp = (BytePtr) current_stack_pointer();
     1747    struct _TEB *teb = NtCurrentTeb();
     1748   
     1749    if ((current_sp >= vs->low) &&
     1750        (current_sp < vs->high)) {
     1751      return
     1752        handle_windows_exception_on_foreign_stack(tcr,
     1753                                                  exception_pointers->ContextRecord,
     1754                                                  windows_exception_handler,
     1755                                                  exception_pointers);
     1756    }
     1757    return windows_exception_handler(exception_pointers);
     1758  }
     1759}
     1760
     1761
    16321762void
    16331763install_pmcl_exception_handlers()
    16341764{
     1765  AddVectoredExceptionHandler(1,windows_arbstack_exception_handler);
    16351766}
    16361767#else
     
    16731804#endif
    16741805
     1806#ifndef WINDOWS
    16751807#ifndef USE_SIGALTSTACK
    16761808void
     
    17281860                                 );
    17291861}
    1730 
     1862#endif
    17311863#endif
    17321864
     
    17401872quit_handler(int signum, siginfo_t *info, ExceptionInformation *xp)
    17411873{
     1874#ifdef DARWIN_GS_HACK
     1875  Boolean gs_was_tcr = ensure_gs_pthread();
     1876#endif
    17421877  TCR *tcr = get_tcr(false);
    17431878  area *a;
     
    17681903#endif
    17691904
     1905#ifndef WINDOWS
    17701906#ifndef USE_SIGALTSTACK
    17711907void
     
    18241960}
    18251961#endif
     1962#endif
    18261963
    18271964#ifdef USE_SIGALTSTACK
     
    19342071#ifdef X8664
    19352072opcode load_allocptr_reg_from_tcr_save_allocptr_instruction[] =
    1936   {0x65,0x48,0x8b,0x1c,0x25,0xd8,0x00,0x00,0x00};
     2073#ifdef WINDOWS
     2074  {0x49,0x8b,0x9b,0xd8,0x00,0x00,0x00}
     2075#else
     2076  {0x65,0x48,0x8b,0x1c,0x25,0xd8,0x00,0x00,0x00}
     2077#endif
     2078;
    19372079opcode compare_allocptr_reg_to_tcr_save_allocbase_instruction[] =
    1938   {0x65,0x48,0x3b,0x1c,0x25,0xe0,0x00,0x00,0x00};
     2080#ifdef WINDOWS
     2081  {0x49,0x3b,0x9b,0xe0,0x00,0x00,0x00}
     2082#else
     2083  {0x65,0x48,0x3b,0x1c,0x25,0xe0,0x00,0x00,0x00}
     2084#endif
     2085
     2086;
    19392087opcode branch_around_alloc_trap_instruction[] =
    19402088  {0x7f,0x02};
     
    19422090  {0xcd,0xc5};
    19432091opcode clear_tcr_save_allocptr_tag_instruction[] =
    1944   {0x65,0x80,0x24,0x25,0xd8,0x00,0x00,0x00,0xf0};
     2092#ifdef WINDOWS
     2093  {0x41,0x80,0xa3,0xd8,0x00,0x00,0x00,0xf0}
     2094#else
     2095  {0x65,0x80,0x24,0x25,0xd8,0x00,0x00,0x00,0xf0}
     2096#endif
     2097;
    19452098opcode set_allocptr_header_instruction[] =
    19462099  {0x48,0x89,0x43,0xf3};
     2100
    19472101
    19482102alloc_instruction_id
     
    19532107  case 0x7f: return ID_branch_around_alloc_trap_instruction;
    19542108  case 0x48: return ID_set_allocptr_header_instruction;
     2109#ifdef WINDOWS
     2110  case 0x41: return ID_clear_tcr_save_allocptr_tag_instruction;
     2111  case 0x49:
     2112    switch(program_counter[1]) {
     2113    case 0x8b: return ID_load_allocptr_reg_from_tcr_save_allocptr_instruction;
     2114    case 0x3b: return ID_compare_allocptr_reg_to_tcr_save_allocbase_instruction;
     2115    }
     2116#else
    19552117  case 0x65:
    19562118    switch(program_counter[1]) {
     
    19622124      }
    19632125    }
     2126#endif
     2127  default: break;
    19642128  }
    19652129  return ID_unrecognized_alloc_instruction;
     
    19972161}
    19982162#endif     
    1999 #ifdef WINDOWS 
    2000 void
    2001 pc_luser_xp(ExceptionInformation *xp, TCR *tcr, signed_natural *interrupt_displacement)
    2002 {
    2003 }
    2004 #else
     2163
    20052164void
    20062165pc_luser_xp(ExceptionInformation *xp, TCR *tcr, signed_natural *interrupt_displacement)
     
    20302189    switch(state) {
    20312190    case ID_set_allocptr_header_instruction:
    2032       /* We were consing a vector and we won.  Set the header of the
    2033          new vector (in the allocptr register) to the header in
    2034          %eax/%rax and skip over this instruction, then fall into the
    2035          next case. */
     2191      /* We were consing a vector and we won.  Set the header of the new vector
     2192         (in the allocptr register) to the header in %rax and skip over this
     2193         instruction, then fall into the next case. */
    20362194      new_vector = xpGPR(xp,Iallocptr);
    20372195      deref(new_vector,0) = xpGPR(xp,Iimm0);
     
    20672225         attempt. */
    20682226      {
    2069         int flags = (int)xpGPR(xp,Iflags);
     2227        int flags = (int)eflags_register(xp);
    20702228       
    20712229        if ((!(flags & (1 << X86_ZERO_FLAG_BIT))) &&
     
    21092267      }
    21102268      break;
     2269    default:
     2270      break;
    21112271    }
    21122272    return;
     
    21212281      if ((program_counter < &egc_store_node_conditional_success_test) ||
    21222282          ((program_counter == &egc_store_node_conditional_success_test) &&
    2123            !(xpGPR(xp, Iflags) & (1 << X86_ZERO_FLAG_BIT)))) {
     2283           !(eflags_register(xp) & (1 << X86_ZERO_FLAG_BIT)))) {
    21242284        /* Back up the PC, try again */
    21252285        xpPC(xp) = (LispObj) &egc_store_node_conditional;
     
    21842344  }
    21852345}
    2186 #endif
     2346
    21872347
    21882348void
  • trunk/source/lisp-kernel/x86-exceptions.h

    r10195 r10565  
    1515*/
    1616
     17#ifndef X86_EXCEPTIONS_H
     18#define X86_EXCEPTIONS_H 1
     19
    1720typedef u8_t opcode, *pc;
    1821
     
    2427#define xpPC(x) (xpGPR(x,Iip))
    2528#define xpMMXreg(x,n)  *((natural *)(&((x)->uc_mcontext.fpregs->_st[n])))
     29#define eflags_register(xp) xpGPR(xp,Iflags)
    2630#endif
    2731#endif
     
    3640#define set_xpGPR(x,gpr,new) xpGPR((x),(gpr)) = (natural)(new)
    3741#define xpPC(x) (xpGPR(x,Iip))
     42#define eflags_register(xp) xpGPR(xp,Iflags)
    3843#define xpFPRvector(x) ((natural *)(&(UC_MCONTEXT(x)->__fs.__fpu_xmm0)))
    3944#define xpMMXreg(x,n)  (xpFPRvector(x)[n])
     
    4348#define set_xpGPR(x,gpr,new) xpGPR((x),(gpr)) = (natural)(new)
    4449#define xpPC(x) (xpGPR(x,Iip))
     50#define eflags_register(xp) xpGPR(xp,Iflags)
    4551#define xpFPRvector(x) ((natural *)(&((x)->uc_mcontext->__fs.__fpu_xmm0)))
    4652/* are you ready for this? */
     
    6268#define xpGPR(x,gprno) (xpGPRvector(x)[gprno])
    6369#define set_xpGPR(x,gpr,new) xpGPR((x),(gpr)) = (natural)(new)
     70#define eflags_register(xp) xpGPR(xp,Iflags)
    6471#define xpPC(x) xpGPR(x,Iip)
    6572#define xpMMXreg(x,n) *((natural *)(&(((struct savefpu *)(&(x)->uc_mcontext.mc_fpstate))->sv_fp[n])))
     
    7481#define set_xpGPR(x,gpr,new) xpGPR((x),(gpr)) = (natural)(new)
    7582#define xpPC(x) xpGPR(x,Iip)
     83#define eflags_register(xp) xpGPR(xp,Iflags)
    7684#define xpXMMregs(x)(&((x)->uc_mcontext.fpregs.fp_reg_set.fpchip_state.xmm[0]))
    7785#endif
     
    7987
    8088#ifdef WIN64
    81 #define xpGPRvector(x) ((DWORD64 *)((x)->ContextRecord))
     89#define xpGPRvector(x) ((DWORD64 *)(&(x)->Rax))
    8290#define xpGPR(x,gprno) (xpGPRvector(x)[gprno])
    8391#define xpPC(x) xpGPR(x,Iip)
     92#define eflags_register(xp) xp->EFlags
    8493#endif
    8594
     
    95104#ifdef SOLARIS
    96105#define SIGNAL_FOR_PROCESS_INTERRUPT SIGUSR1
     106#endif
     107#ifdef WINDOWS
     108#define SIGNAL_FOR_PROCESS_INTERRUPT SIGINT
    97109#endif
    98110
     
    160172#endif
    161173
     174#ifdef WINDOWS
     175#define SIGNUM_FOR_INTN_TRAP SIGSEGV /* Also fake */
     176#define IS_MAYBE_INT_TRAP(info,xp) \
     177  ((info->ExceptionCode == EXCEPTION_ACCESS_VIOLATION) &&       \
     178   (info->ExceptionInformation[0]==0) &&                       \
     179   (info->ExceptionInformation[1]==(ULONG_PTR)(-1L)))
     180#define SIGRETURN(context)      /* for now */
     181#endif
     182
    162183/* Please go away. */
    163184#ifdef DARWIN_GS_HACK
     
    193214extern natural get_mxcsr();
    194215extern void set_mxcsr(natural);
     216
     217#ifdef WINDOWS
     218typedef struct {
     219  HANDLE h;
     220  OVERLAPPED *o;
     221} pending_io;
     222#endif
    195223
    196224#ifdef X8632
     
    202230#define RECOVER_FN_LENGTH 5
    203231#endif
     232
     233#endif /* X86_EXCEPTIONS_H */
     234
  • trunk/source/lisp-kernel/x86-gc.c

    r10263 r10565  
    24072407  impurify_noderef(&(regs[Iarg_y]), low, high, delta);
    24082408  impurify_noderef(&(regs[Iarg_x]), low, high, delta);
     2409#ifndef WINDOWS
    24092410  impurify_noderef(&(regs[Isave3]), low, high, delta);
     2411#endif
    24102412  impurify_noderef(&(regs[Isave2]), low, high, delta);
    24112413  impurify_noderef(&(regs[Isave1]), low, high, delta);
     
    25902592}
    25912593
    2592 #ifdef WINDOWS
    2593 int
    2594 impurify(TCR *tcr, signed_natural param)
    2595 {
    2596 }
    2597 #else
    25982594int
    25992595impurify(TCR *tcr, signed_natural param)
     
    26182614      a->active += n;
    26192615      memmove(oldfree, ro_base, n);
    2620       munmap((void *)ro_base, n);
     2616      UnMapMemory((void *)ro_base, n);
    26212617      a->ndnodes = area_dnode(a, a->active);
    26222618      pure_space_active = r->active = r->low;
     
    26392635  return -1;
    26402636}
    2641 #endif
  • trunk/source/lisp-kernel/x86-spentry64.s

    r10388 r10565  
    4040       
    4141
    42 _spentry(bad_funcall)   
     42_spentry(bad_funcall)
     43Xspentry_start:         
    4344        .globl C(bad_funcall)   
    4445__(tra(C(bad_funcall)))
     
    39293930        __(push %arg_z)
    39303931        __(push %fn)
    3931         __(push %save0)
     3932        __ifndef([WINDOWS])
     3933        __(push %save3) 
     3934        __endif
     3935        __(push %save2)
    39323936        __(push %save1)
    3933         __(push %save2)
    3934         __ifndef([WINDOWS])
    3935         __(push %save3)         /* 11 registers pushed after %rbp */
    3936         __endif
     3937        __(push %save0)       /* 10 or 11 registers pushed after %rbp */
    39373938        __(movq %rsp,rcontext(tcr.save_vsp))
    39383939        __(movq %rbp,rcontext(tcr.save_rbp))
     
    39553956            foreign code has never been safe (unless it's
    39563957            a fixnum */
    3957          __(save_tcr_linear(%save0))
    3958          __(movq %imm1,%save1)
    3959          __(movq %imm0,%save2)
     3958         __(save_tcr_linear(%csave0))
     3959         __(movq %imm1,%csave1)
     3960         __(movq %imm0,%csave2)
    39603961         __(set_foreign_gs_base())
    3961          __(movq %save1,%imm1)
    3962          __(movq %save2,%imm0)
     3962         __(movq %csave1,%imm1)
     3963         __(movq %csave2,%imm0)
    39633964        __endif
    39643965        __ifdef([WINDOWS])
    39653966        /* Preserve TCR pointer */
    3966         __(movq %rcontext_reg, %save0)
     3967        __(movq %rcontext_reg, %csave0)
    39673968        __endif
    39683969LocalLabelPrefix[]ffcall_setup:
    39693970        __(addq $2*node_size,%rsp)
    39703971        __(movq %imm1,%r11)
    3971         __(pop %carg0)
    3972         __(pop %carg1)
    3973         __(pop %carg2)
    3974         __(pop %carg3)
    3975         __ifdef([WINDOWS])
    3976         __(sub $20, %rsp) /* Make room for arg register spill */
    3977         __else
    3978         __(pop %carg4)
    3979         __(pop %carg5)
     3972        __ifdef([WINDOWS])
     3973         /* Leave 0x20 bytes of register spill area on stack */
     3974         __(movq (%rsp),%carg0)
     3975         __(movq 8(%rsp),%carg1)
     3976         __(movq 16(%rsp),%carg2)
     3977         __(movq 24(%rsp),%carg3)
     3978        __else
     3979         __(pop %carg0)
     3980         __(pop %carg1)
     3981         __(pop %carg2)
     3982         __(pop %carg3)
     3983         __(pop %carg4)
     3984         __(pop %carg5)
    39803985        __endif
    39813986LocalLabelPrefix[]ffcall_setup_end:
     
    39833988        __(call *%r11)
    39843989LocalLabelPrefix[]ffcall_call_end:               
     3990        __ifdef([WINDOWS])
     3991        __(add $0x20,%rsp)
     3992        __endif
    39853993        __(movq %rbp,%rsp)
    39863994        __ifdef([DARWIN_GS_HACK])
    3987          /* %rax/%rdx contains the return value (maybe), %save0 still
     3995         /* %rax/%rdx contains the return value (maybe), %csave1 still
    39883996            contains the linear tcr address.  Preserve %rax/%rdx here. */
    3989          __(movq %rax,%save1)
    3990          __(movq %rdx,%save2)
    3991          __(set_gs_base(%save0))
    3992          __(movq %save1,%rax)
    3993          __(movq %save2,%rdx)
     3997         __(movq %rax,%csave1)
     3998         __(movq %rdx,%csave2)
     3999         __(set_gs_base(%csave0))
     4000         __(movq %csave1,%rax)
     4001         __(movq %csave2,%rdx)
    39944002        __endif
    39954003        __ifdef([WINDOWS])
    3996         __(movq %save0, %rcontext_reg)
     4004        __(movq %csave0, %rcontext_reg)
    39974005        __endif
    39984006        __(movq %rsp,rcontext(tcr.foreign_sp))
     
    40194027        __(movq rcontext(tcr.save_rbp),%rbp)
    40204028        __(movq $TCR_STATE_LISP,rcontext(tcr.valence))
     4029        __(pop %save0)
     4030        __(pop %save1)
     4031        __(pop %save2)
    40214032        __ifndef([WINDOWS])
    40224033        __(pop %save3)
    40234034        __endif
    4024         __(pop %save2)
    4025         __(pop %save1)
    4026         __(pop %save0)
    40274035        __(pop %fn)
    40284036        __(pop %arg_z)
     
    41404148        __(push %arg_y)
    41414149        __(push %arg_z)
    4142         __(push %save0)
    4143         __(push %save1)
    4144         __(push %save2)
    41454150        __ifndef([WINDOWS])
    41464151        __(push %save3)
    41474152        __endif
    4148         __(movq macptr.address(%arg_y),%rbx)  /* %rbx non-volatile */
     4153        __(push %save2)
     4154        __(push %save1)
     4155        __(push %save0)
     4156        __(movq macptr.address(%arg_y),%csave0)  /* %rbx non-volatile */
    41494157        __(push %fn)
    41504158        __(movq %rsp,rcontext(tcr.save_vsp))
     
    41624170            all saved, and the foreign arguments are
    41634171            on the foreign stack (about to be popped
    4164             off).  Save the linear TCR address in %save0/%r15
     4172            off).  Save the linear TCR address in %csave1/%r12
    41654173            so that we can restore it later, and preserve
    41664174            the entrypoint somewhere where C won't bash it.
     
    41684176            foreign code has never been safe (unless it's
    41694177            a fixnum */
    4170          __(save_tcr_linear(%save0))
    4171          __(movq %imm0,%save1)
    4172          __(movq %imm1,%save2)
     4178         __(save_tcr_linear(%csave1))
     4179         __(movq %imm0,%csave2)
     4180         __(movq %imm1,%csave3)
    41734181         __(set_foreign_gs_base())
    4174          __(movq %save1,%imm0)
    4175          __(movq %save2,%imm1)
     4182         __(movq %csave2,%imm0)
     4183         __(movq %csave3,%imm1)
    41764184        __endif
    41774185        __ifdef([WINDOWS])
    41784186        /* Preserve TCR pointer */
    4179         __(movq %rcontext_reg, %save0)
     4187        __(movq %rcontext_reg, %csave1)
    41804188        __endif
    41814189        __(movq %imm1,%r11)
     
    41874195        __(pop %carg3)
    41884196        __ifdef([WINDOWS])
    4189         __(sub $20, %rsp) /* Make room for arg register spill */
     4197        __(sub $0x20, %rsp) /* Make room for arg register spill */
    41904198        __else
    41914199        __(pop %carg4)
     
    41954203LocalLabelPrefix[]ffcall_return_registers_call:
    41964204        __(call *%r11)
    4197 LocalLabelPrefix[]ffcall_return_registers_call_end:               
    4198         __(movq %rax,(%rbx))
    4199         __(movq %rdx,8(%rbx))
    4200         __(movsd %xmm0,16(%rbx))
    4201         __(movsd %xmm1,24(%rbx))
     4205LocalLabelPrefix[]ffcall_return_registers_call_end:
     4206        __ifdef([WINDOWS])
     4207        __(add $0x20, %rsp)
     4208        __endif
     4209        __(movq %rax,(%csave0))
     4210        __(movq %rdx,8(%csave0))
     4211        __(movsd %xmm0,16(%csave0))
     4212        __(movsd %xmm1,24(%csave0))
    42024213        __(movq %rbp,%rsp)
    42034214        __ifdef([DARWIN_GS_HACK])
    42044215         /* %rax/%rdx contains the return value (maybe), %save0 still
    42054216            contains the linear tcr address.  Preserve %rax/%rdx here. */
    4206          __(set_gs_base(%save0))
    4207          __(movq (%save2),%rax)
    4208          __(movq 8(%save2),%rdx)
    4209          __(movsd 16(%save2),%xmm0)
    4210          __(movsd 24(%save2),%xmm1)
     4217         __(set_gs_base(%csave1))
     4218         __(movq (%csave3),%rax)
     4219         __(movq 8(%csave3),%rdx)
     4220         __(movsd 16(%csave3),%xmm0)
     4221         __(movsd 24(%csave3),%xmm1)
    42114222        __endif
    42124223        __ifdef([WINDOWS])
    4213         __(movq %save0, %rcontext_reg)
     4224        __(movq %csave1, %rcontext_reg)
    42144225        __endif
    42154226        __(movq %rsp,rcontext(tcr.foreign_sp))       
     
    42374248        __(movq $TCR_STATE_LISP,rcontext(tcr.valence))
    42384249        __(pop %fn)
     4250        __(pop %save0)
     4251        __(pop %save1)
     4252        __(pop %save2)
    42394253        __ifndef([WINDOWS])
    42404254        __(pop %save3)
    42414255        __endif
    4242         __(pop %save2)
    4243         __(pop %save1)
    4244         __(pop %save0)
    42454256        __(pop %arg_z)
    42464257        __(pop %arg_y)
     
    43494360        __(push %arg_y)
    43504361        __(push %arg_z)
     4362        __ifndef([WINDOWS])
     4363         __(push %save3)
     4364        __endif
     4365        __(push %save2)
     4366        __(push %save1)
    43514367        __(push %save0)
    4352         __(push %save1)
    4353         __(push %save2)
    4354         __(push %save3)
    43554368        __(push %fn)
    43564369        __(movq %rsp,rcontext(tcr.save_vsp))
     
    43614374        __(movq (%rsp),%rbp)
    43624375        __(addq $2*node_size,%rsp)
    4363         __(unbox_fixnum(%arg_z,%rax))
    4364         __(pop %rdi)
    4365         __(pop %rsi)
    4366         __(pop %rdx)
    4367         __(pop %r10)            /*  syscalls take 4th param in %r10, not %rcx   */
    4368         __(pop %r8)
    4369         __(pop %r9)
    4370         __(syscall)
    4371         __ifdef([SYSCALL_SETS_CARRY_ON_ERROR])
    4372          __(jnc 0f)
    4373          __(negq %rax)
     4376        __ifdef([WINDOWS])
     4377         __(lea C(windows_syscall_table)(%rip),%rax)
     4378         __(movq %rcontext_reg,%csave0)
     4379         __(pop %carg0)
     4380         __(pop %carg1)
     4381         __(pop %carg2)
     4382         __(pop %carg3)
     4383         __(subq $0x20,%rsp)
     4384         __(call *(%rax,%arg_z))
     4385         __(addq $0x20,%rsp)
     4386        __else
     4387         __(unbox_fixnum(%arg_z,%rax))
     4388         __(pop %rdi)
     4389         __(pop %rsi)
     4390         __(pop %rdx)
     4391         __(pop %r10)           /*  syscalls take 4th param in %r10, not %rcx   */
     4392         __(pop %r8)
     4393         __(pop %r9)
     4394         __(syscall)
     4395         __ifdef([SYSCALL_SETS_CARRY_ON_ERROR])
     4396          __(jnc 0f)
     4397          __(negq %rax)
    437443980:     
    4375         __endif       
     4399         __endif
     4400        __endif
     4401        __ifdef([WINDOWS])
     4402         __(movq %csave0,%rcontext_reg)
     4403        __endif
    43764404        __(movq %rbp,%rsp)
    4377         __(movq %rsp,rcontext(tcr.foreign_sp))       
    4378         __(clr %save3)
     4405        __(movq %rsp,rcontext(tcr.foreign_sp))
     4406        __ifndef([WINDOWS])
     4407         __(clr %save3)
     4408        __endif
    43794409        __(clr %save2)
    43804410        __(clr %save1)
     
    43924422        __(movq $TCR_STATE_LISP,rcontext(tcr.valence))
    43934423        __(pop %fn)
    4394         __(pop %save3)
     4424        __(pop %save0)
     4425        __(pop %save1)
    43954426        __(pop %save2)
    4396         __(pop %save1)
    4397         __(pop %save0)
     4427        __ifndef([WINDOWS])
     4428         __(pop %save3)
     4429        __endif
    43984430        __(pop %arg_z)
    43994431        __(pop %arg_y)
     
    44794511
    44804512
    4481 /* Callback index in %r11         */
     4513/* Callback index in %r11 */
    44824514_spentry(callback)
    44834515        __(push %rbp)
    44844516        __(movq %rsp,%rbp)
    44854517        /* C scalar args   */
    4486         __(push %rdi)   /* -8(%rbp)   */
    4487         __(push %rsi)
    4488         __(push %rdx)
    4489         __(push %rcx)
    4490         __(push %r8)
    4491         __(push %r9)
     4518        __(push %carg0) /* -8(%rbp)   */
     4519        __(push %carg1)
     4520        __(push %carg2)
     4521        __(push %carg3)
     4522        __ifndef([WINDOWS])
     4523        __(push %carg4)
     4524        __(push %carg5)
     4525        __endif
    44924526        /* FP arg regs   */
     4527        __ifdef([WINDOWS])
     4528        __(subq $4*8,%rsp)
     4529        __(movq %xmm0,3*8(%rsp))        /* -40(%rbp) */
     4530        __(movq %xmm1,2*8(%rsp))
     4531        __(movq %xmm2,1*8(%rsp))
     4532        __(movq %xmm3,0*8(%rsp))
     4533        __else
    44934534        __(subq $8*8,%rsp)
    4494         __(movq %xmm0,7*8(%rsp))        /* -56(%rbp)   */
     4535        __(movq %xmm0,7*8(%rsp))        /* -56(%rbp) */
    44954536        __(movq %xmm1,6*8(%rsp))
    44964537        __(movq %xmm2,5*8(%rsp))
     
    45004541        __(movq %xmm6,1*8(%rsp))
    45014542        __(movq %xmm7,0*8(%rsp))
     4543        __endif
     4544        __ifndef([WINDOWS])
     4545        __endif
    45024546        /* C NVRs   */
    4503         __(push %r12)
    4504         __(push %r13)
    4505         __(push %r14)
    4506         __(push %r15)
    4507         __(push %rbx)
     4547        __(push %csave0)
     4548        __(push %csave1)
     4549        __(push %csave2)
     4550        __(push %csave3)
     4551        __(push %csave4)
     4552        __ifdef([WINDOWS])
     4553        __(push %csave5)
     4554        __(push %csave6)
     4555        __endif
    45084556        __(push %rbp)
     4557        __(movq %r11,%csave0)
    45094558        __ifdef([HAVE_TLS])
    45104559         /* TCR initialized for lisp ?   */
    45114560         __ifndef([WINDOWS]) /* FIXME */
    45124561         __(movq %fs:current_tcr@TPOFF+tcr.linear,%rax)
    4513          __endif
    45144562         __(testq %rax,%rax)
    45154563         __(jne 1f)
     4564         __endif
    45164565        __endif
    4517         __(movq %r11,%r12)
    45184566        __(ref_global(get_tcr,%rax))
    4519         __(movq $1,%rdi)
     4567        __(movq $1,%carg0)
     4568        __ifdef([WINDOWS])
     4569        __(sub $0x20, %rsp)
     4570        __endif
    45204571        __(call *%rax)
     4572        __ifdef([WINDOWS])
     4573        __(add $0x20, %rsp)
     4574        __(movq %rax, %rcontext_reg)
     4575        __endif
    45214576        __ifdef([DARWIN_GS_HACK])
    45224577         /* linear TCR address in now in %rax; callback index was
     
    45244579         __(set_gs_base(%rax))
    45254580        __endif
    4526         __(movq %r12,%r11)
    452745811:      /* Align foreign stack for lisp   */
    45284582        __(pushq rcontext(tcr.save_rbp)) /* mark cstack frame's "owner" */
    45294583        __(pushq rcontext(tcr.foreign_sp))
    45304584        /* init lisp registers   */
    4531         __(movq %r11,%rax)
     4585        __(movq %csave0,%rax)
    45324586        __(movq %rsp,rcontext(tcr.foreign_sp))
     4587        __ifndef([WINDOWS])
    45334588        __(clr %save3)
     4589        __endif
    45344590        __(clr %save2)
    45354591        __(clr %save1)
     
    45484604        __(movq rcontext(tcr.save_rbp),%rbp)
    45494605        __(movq $TCR_STATE_LISP,rcontext(tcr.valence))
    4550         __(movq (%rsp),%save3)
    4551         __(movq 8(%rsp),%save2)
    4552         __(movq 16(%rsp),%save1)
    4553         __(movq 24(%rsp),%save0)
     4606        __(movq (%rsp),%save0)
     4607        __(movq 8(%rsp),%save1)
     4608        __(movq 16(%rsp),%save2)
     4609        __ifndef([WINDOWS])
     4610         __(movq 24(%rsp),%save3)
     4611        __endif
    45544612        __(stmxcsr rcontext(tcr.foreign_mxcsr))
    45554613        __(andb $~mxcsr_all_exceptions,rcontext(tcr.foreign_mxcsr))
     
    45754633        __endif
    45764634        __(pop %rbp)
    4577         __(pop %rbx)
    4578         __(pop %r15)
    4579         __(pop %r14)
    4580         __(pop %r13)
    4581         __(pop %r12)
     4635        __ifdef([WINDOWS])
     4636        __(pop %csave6)
     4637        __(pop %csave5)
     4638        __endif
     4639        __(pop %csave4)
     4640        __(pop %csave3)
     4641        __(pop %csave2)
     4642        __(pop %csave1)
     4643        __(pop %csave0)
    45824644        __(movq -8(%rbp),%rax)
    45834645        __(movq -16(%rbp),%rdx)
  • trunk/source/lisp-kernel/x86-subprims64.s

    r8602 r10565  
    3232
    3333_exportfn(toplevel_loop)
     34Xsubprims_start:               
    3435        __(push %rbp)
    3536        __(movq %rsp,%rbp)
     
    8283/* "reset" itself or start running lisp code.  Both of these arguments */
    8384/* are currently ignored (the TCR is maintained in a segment register and */
    84 /*  the reset/panic code doesn't work ...) */
     85/*  the reset/panic code doesn't work ...), except on Windows, where we use */
     86/* the first arg to set up the TCR register */ 
    8587   
    8688_exportfn(C(start_lisp))
     
    9597        __(push %csave5)
    9698        __(push %csave6)
    97         /* FIXME: set up %rcontext_reg a.k.a. r11 */
     99        __(movq %carg0,%rcontext_reg)
    98100        __endif
    99101        __ifdef([DARWIN_GS_HACK])
     
    141143        __(leave)
    142144        __(ret)
     145Xsubprims_end:           
    143146_endfn
    144                
     147
     148        .data
     149        .globl C(subprims_start)
     150        .globl C(subprims_end)
     151C(subprims_start):      .quad Xsubprims_start
     152C(subprims_end):        .quad Xsubprims_end
     153        .text
     154                               
Note: See TracChangeset for help on using the changeset viewer.