Changeset 9556

Timestamp:

May 20, 2008, 2:26:07 AM (17 years ago)

Author:

Gary Byers

Message:

Do raise_thread_interrupt() for Win64.

If the thread is running foreign code when we interrupt it, we set a
bit in its tcr. (This is the same as what happens on other
platforms.) However, on Unix platforms (where this works via signals),
the delivery of a sigmal to the target thread causes any blocking
syscalls to return with EINTR (and thus usualy quickly qreturn to lisp glue
code that checks the interrupt-pending flag.)

If a thread's in an "alertable wait state", using QueueUserAPC might get
it out of that state. I'm not sure how to tell whether or not the thread's
in such as state.

File:

• branches/win64/lisp-kernel/thread_manager.c (modified) (5 diffs)

branches/win64/lisp-kernel/thread_manager.c

@@ -53 +53 @@
 
 #ifdef WINDOWS
+extern pc spentry_start, spentry_end,subprims_start,subprims_end;
+extern pc restore_win64_context_start, restore_win64_context_end,
+  restore_win64_context_load_rcx, restore_win64_context_iret;
+
+extern void interrupt_handler(int, siginfo_t *, ExceptionInformation *);
+
 int
 raise_thread_interrupt(TCR *target)
 {
-}
+  /* GCC doesn't align CONTEXT corrcectly */
+  char _contextbuf[sizeof(CONTEXT)+__alignof(CONTEXT)];
+  CONTEXT  *pcontext;
+  HANDLE hthread = (HANDLE)(target->osid);
+  pc where;
+  area *cs = target->cs_area, *ts = target->cs_area;
+  DWORD rc;
+
+  pcontext = (CONTEXT *)((((natural)&_contextbuf)+15)&~15);
+  rc = SuspendThread(hthread);
+  if (rc == -1) {
+    return -1;
+  }
+  /* What if the suspend count is > 1 at this point ?  I don't think
+     that that matters, but I'm not sure */
+  pcontext->ContextFlags = CONTEXT_ALL;
+  rc = GetThreadContext(hthread, pcontext);
+  if (rc == 0) {
+    wperror("GetThreadContext");
+  }
+  where = (pc)(xpPC(pcontext));
+  
+  if ((target->valence != TCR_STATE_LISP) ||
+      (TCR_INTERRUPT_LEVEL(target) < 0) ||
+      (target->unwinding != 0) ||
+      (!((where < (pc)lisp_global(HEAP_END)) &&
+         (where >= (pc)lisp_global(HEAP_START))) &&
+       !((where < spentry_end) && (where >= spentry_start)) &&
+       !((where < subprims_end) && (where >= subprims_start)) &&
+       !((where < (pc) 0x16000) &&
+         (where >= (pc) 0x15000)) &&
+       !((where < (pc) (ts->high)) &&
+         (where >= (pc) (ts->low))))) {
+    /* If the thread's in a blocking syscall, it'd be nice to
+       get it out of that state here. */
+    target->interrupt_pending = (1LL << (nbits_in_word - 1LL));
+    ResumeThread(hthread);
+    return 0;
+  } else {
+    /* Thread is running lisp code with interupts enabled.  Set it
+       so that it calls out and then returns to the context,
+       handling any necessary pc-lusering. */
+    LispObj foreign_rsp = (((LispObj)(target->foreign_sp))-128)&~15;
+    CONTEXT *icontext = ((CONTEXT *) foreign_rsp) -1;
+    icontext = (CONTEXT *)(((LispObj)icontext)&~15);
+    
+    *icontext = *pcontext;
+    
+    xpGPR(pcontext,REG_RCX) = SIGNAL_FOR_PROCESS_INTERRUPT;
+    xpGPR(pcontext,REG_RDX) = 0;
+    xpGPR(pcontext,REG_R8) = (LispObj) icontext;
+    xpGPR(pcontext,REG_RSP) = ((LispObj *)icontext)-1;
+    *(((LispObj *)icontext)-1) = (LispObj)raise_thread_interrupt;
+    xpPC(pcontext) = (pc)interrupt_handler;
+    SetThreadContext(hthread,pcontext);
+    ResumeThread(hthread);
+    return 0;
+  }
+}
+
 #else
 int
@@ -654 +719 @@
 tsd_get(LispObj key)
 {
-  TlsGetValue((DWORD)key);
+  return TlsGetValue((DWORD)key);
 }
 #else
@@ -1135 +1200 @@
   tcr_cleanup(tcr);
 #endif
-
+  return NULL;
 }
 
@@ -1181 +1246 @@
 xDisposeThread(TCR *tcr)
 {
+  return 0;                     /* I don't think that this is ever called. */
 }
 #else
@@ -1320 +1386 @@
 
 #ifdef WINDOWS
-extern pc spentry_start, spentry_end,subprims_start,subprims_end;
-extern pc restore_win64_context_start, restore_win64_context_end,
-  restore_win64_context_load_rcx, restore_win64_context_iret;
 
 Boolean