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

[gb at clozure.com]

Author: gb
Date: Mon Feb 16 08:51:37 2009
New Revision: 11742

Log:
In suspend_resume_handler: if we don't have a TCR, create one (with
default stack sizes, unfortunately ...) but don't do the whole
foreign_thread_callback stuff that get_tcr(true) does.

cooperative_thread_startup(): a little different from the native
thread case.  Some support for calling the (Carbon Thread Manager)
function SetThreadState, which can be used to make the calling
cooperative thread inelegible for scheduling (until some other
thread changes its state.)

If get_tcr(true) creates a tcr, current stack size is a natural
(not unsigned.)

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 Mon Feb 16 08:51:37 2009
@@ -574,7 +574,18 @@
   Boolean gs_was_tcr =3D ensure_gs_pthread();
 #endif
   TCR *tcr =3D get_interrupt_tcr(false);
-
+  =

+  if (tcr =3D=3D NULL) {
+    /* Got a suspend signal sent to the pthread. */
+    extern natural initial_stack_size;
+    void register_thread_tcr(TCR *);
+    =

+    tcr =3D new_tcr(initial_stack_size, MIN_TSTACK_SIZE);
+    tcr->suspend_count =3D 1;
+    tcr->vs_area->active -=3D node_size;
+    *(--tcr->save_vsp) =3D lisp_nil;
+    register_thread_tcr(tcr);
+  }
   if (TCR_INTERRUPT_LEVEL(tcr) <=3D (-2<<fixnumshift)) {
     SET_TCR_FLAG(tcr,TCR_FLAG_BIT_PENDING_SUSPEND);
   } else {
@@ -1678,6 +1689,50 @@
 #endif
 }
 =

+typedef =

+short (*suspendf)();
+
+
+void
+suspend_current_cooperative_thread()
+{
+  static suspendf cooperative_suspend =3D NULL;
+
+  if (cooperative_suspend =3D=3D NULL) {
+    cooperative_suspend =3D (suspendf)xFindSymbol(NULL, "SetThreadState");
+  }
+  if (cooperative_suspend) {
+    cooperative_suspend(1 /* kCurrentThreadID */,
+                        1 /* kStoppedThreadState */,
+                        0 /* kAnyThreadID */);
+  }
+}
+
+void *
+cooperative_thread_startup(void *arg)
+{
+
+  TCR *tcr =3D get_tcr(0);
+  if (!tcr) {
+    return NULL;
+  }
+#ifndef WINDOWS
+  pthread_cleanup_push(tcr_cleanup,(void *)tcr);
+#endif
+  SET_TCR_FLAG(tcr,TCR_FLAG_BIT_AWAITING_PRESET);
+  do {
+    SEM_RAISE(tcr->reset_completion);
+    suspend_current_cooperative_thread();
+      =

+    start_lisp(tcr, 0);
+  } while (tcr->flags & (1<<TCR_FLAG_BIT_AWAITING_PRESET));
+#ifndef WINDOWS
+  pthread_cleanup_pop(true);
+#else
+  tcr_cleanup(tcr);
+#endif
+}
+
 void *
 xNewThread(natural control_stack_size,
 	   natural value_stack_size,
@@ -1837,7 +1892,7 @@
     LispObj callback_macptr =3D nrs_FOREIGN_THREAD_CONTROL.vcell,
       callback_ptr =3D ((macptr *)ptr_from_lispobj(untag(callback_macptr))=
)->address;
     int i, nbindwords =3D 0;
-    extern unsigned initial_stack_size;
+    extern natural initial_stack_size;
     =

     /* Make one. */
     current =3D new_tcr(initial_stack_size, MIN_TSTACK_SIZE);