[Openmcl-cvs-notifications] r11231 - /trunk/source/lisp-kernel/thread_manager.c

[gb at clozure.com]

Author: gb
Date: Sun Oct 26 20:17:51 2008
New Revision: 11231

Log:
In windows suspend_tcr(): writing to a (new, uncommitted) page on
another thread's c stack doesn't work on Windows.  Since we can
only have one active suspend_suspend context, pre-allocated one
and store a pointer to it in tcr.native_thread_info.

Still need to handle the interrupt case (where there can be
more than one pending interrupt context on a thread), and need
to verify that exception handling (where there's only one thread
involved) works.

Modified:
    trunk/source/lisp-kernel/thread_manager.c

Modified: trunk/source/lisp-kernel/thread_manager.c
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lisp-kernel/thread_manager.c (original)
+++ trunk/source/lisp-kernel/thread_manager.c Sun Oct 26 20:17:51 2008
@@ -1284,6 +1284,8 @@
 #ifdef WIN32
     CloseHandle((HANDLE)tcr->io_datum);
     tcr->io_datum =3D NULL;
+    free(tcr->native_thread_info);
+    tcr->native_thread_info =3D NULL;
 #endif
     UNLOCK(lisp_global(TCR_AREA_LOCK),current);
     if (termination_semaphore) {
@@ -1380,6 +1382,7 @@
 #endif
 #ifdef WINDOWS
   tcr->io_datum =3D (VOID *)CreateEvent(NULL, true, false, NULL);
+  tcr->native_thread_info =3D malloc(sizeof(CONTEXT));
 #endif
   tcr->log2_allocation_quantum =3D unbox_fixnum(lisp_global(DEFAULT_ALLOCA=
TION_QUANTUM));
 }
@@ -1734,17 +1737,15 @@
   int suspend_count =3D atomic_incf(&(tcr->suspend_count));
   DWORD rc;
   if (suspend_count =3D=3D 1) {
-    /* Can't seem to get gcc to align a CONTEXT structure correctly */
-    char _contextbuf[sizeof(CONTEXT)+__alignof(CONTEXT)];
-
-    CONTEXT *suspend_context, *pcontext;
+    CONTEXT  *pcontext =3D (CONTEXT *)tcr->native_thread_info;
     HANDLE hthread =3D (HANDLE)(tcr->osid);
     pc where;
     area *cs =3D tcr->cs_area;
     LispObj foreign_rsp;
 =

-    pcontext =3D (CONTEXT *)((((natural)&_contextbuf)+15)&~15);
-
+    if (hthread =3D=3D NULL) {
+      return false;
+    }
     rc =3D SuspendThread(hthread);
     if (rc =3D=3D -1) {
       /* If the thread's simply dead, we should handle that here */
@@ -1793,8 +1794,8 @@
         tcr->suspend_context =3D NULL;
       } else {
         area *ts =3D tcr->ts_area;
-        /* If we're in the lisp heap, or in x86-spentry64.o, or in
-           x86-subprims64.o, or in the subprims jump table at #x15000,
+        /* If we're in the lisp heap, or in x86-spentry??.o, or in
+           x86-subprims??.o, or in the subprims jump table at #x15000,
            or on the tstack ... we're just executing lisp code.  Otherwise,
            we got an exception while executing lisp code, but haven't
            entered the handler yet (still in Windows exception glue
@@ -1830,26 +1831,15 @@
       }
     } else {
       if (tcr->valence =3D=3D TCR_STATE_EXCEPTION_RETURN) {
+        if (!tcr->pending_exception_context) {
+          FBug(pcontext, "we're confused here.");
+        }
         *pcontext =3D *tcr->pending_exception_context;
         tcr->pending_exception_context =3D NULL;
         tcr->valence =3D TCR_STATE_LISP;
       }
     }
-
-    /* If the context's stack pointer is pointing into the cs_area,
-       copy the context below the stack pointer. else copy it
-       below tcr->foreign_rsp. */
-    foreign_rsp =3D xpGPR(pcontext,Isp);
-
-    if ((foreign_rsp < (LispObj)(cs->low)) ||
-        (foreign_rsp >=3D (LispObj)(cs->high))) {
-      foreign_rsp =3D (LispObj)(tcr->foreign_sp);
-    }
-    foreign_rsp -=3D 0x200;
-    foreign_rsp &=3D ~15;
-    suspend_context =3D (CONTEXT *)(foreign_rsp)-1;
-    *suspend_context =3D *pcontext;
-    tcr->suspend_context =3D suspend_context;
+    tcr->suspend_context =3D pcontext;
     return true;
   }
   return false;
@@ -1959,6 +1949,7 @@
     HANDLE hthread =3D (HANDLE)(tcr->osid);
 =

     if (context) {
+      context->ContextFlags =3D CONTEXT_ALL;
       tcr->suspend_context =3D NULL;
       SetThreadContext(hthread,context);
       rc =3D ResumeThread(hthread);