Changeset 12799

Timestamp:

Sep 9, 2009, 8:11:16 AM (15 years ago)

Author:

gz

Message:

merge r12798 from trunk

Location:

branches/working-0711/ccl

Files:

• level-1/l1-lisp-threads.lisp (modified) (3 diffs)
• level-1/l1-processes.lisp (modified) (3 diffs)
• lisp-kernel/thread_manager.c (modified) (3 diffs)

branches/working-0711/ccl/level-1/l1-lisp-threads.lisp

@@ -485 +485 @@
 ;;; This doesn't quite activate the thread; see PROCESS-TCR-ENABLE.
 (defun %activate-tcr (tcr termination-semaphore allocation-quantum)
+  (declare (ignore termination-semaphore))
   (if (and tcr (not (eql 0 tcr)))
     (with-macptrs (tcrp)
@@ -490 +491 @@
       (setf (%get-natural tcrp target::tcr.log2-allocation-quantum)
             (or allocation-quantum (default-allocation-quantum)))
-      (setf (%get-ptr tcrp target::tcr.termination-semaphore)
-            (if termination-semaphore
-              (semaphore-value termination-semaphore)
-              (%null-ptr)))
       t)))
                          
@@ -1115 +1112 @@
 (defun %foreign-thread-terminate ()
   (let* ((proc *current-process*))
-    (when proc (remove-from-all-processes proc))))
+    (when proc
+      (remove-from-all-processes proc)
+      (let* ((ts (process-termination-semaphore proc)))
+        (when ts (signal-semaphore ts))))))
+

branches/working-0711/ccl/level-1/l1-processes.lisp

@@ -319 +319 @@
     ))
 
-(defmethod (setf process-termination-semaphore) :after (new (p process))
-  (with-macptrs (tcrp)
-    (%setf-macptr-to-object tcrp (process-tcr p))
-    (unless (%null-ptr-p tcrp)
-      (setf (%get-ptr tcrp target::tcr.termination-semaphore)
-            (if new
-              (semaphore-value new)
-              (%null-ptr))))
-    new))
+
 
 (defun process-resume (p)
@@ -418 +410 @@
 ;;; Separated from run-process-initial-form just so I can change it easily.
 (defun process-initial-form-exited (process kill)
-  ;; Enter the *initial-process* and have it finish us up
   (without-interrupts
    (if (eq kill :shutdown)
@@ -424 +415 @@
        (setq *whostate* "Shutdown")
        (add-to-shutdown-processes process)))
+   (let* ((semaphore (process-termination-semaphore process)))
+     (when semaphore (signal-semaphore semaphore)))
    (maybe-finish-process-kill process kill)))
 

branches/working-0711/ccl/lisp-kernel/thread_manager.c

@@ -1381 +1381 @@
 
   area *vs, *ts, *cs;
-  void *termination_semaphore;
   
   if (current == NULL) {
@@ -1424 +1423 @@
     tcr->osid = 0;
     tcr->interrupt_pending = 0;
-    termination_semaphore = tcr->termination_semaphore;
     tcr->termination_semaphore = NULL;
 #ifdef HAVE_TLS
@@ -1439 +1437 @@
 #endif
     UNLOCK(lisp_global(TCR_AREA_LOCK),current);
-    if (termination_semaphore) {
-      SEM_RAISE(termination_semaphore);
-    }
   } else {
     tsd_set(lisp_global(TCR_KEY), TCR_TO_TSD(tcr));