Changeset 12799


Ignore:
Timestamp:
Sep 9, 2009, 3:11:16 PM (10 years ago)
Author:
gz
Message:

merge r12798 from trunk

Location:
branches/working-0711/ccl
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-lisp-threads.lisp

    r12408 r12799  
    485485;;; This doesn't quite activate the thread; see PROCESS-TCR-ENABLE.
    486486(defun %activate-tcr (tcr termination-semaphore allocation-quantum)
     487  (declare (ignore termination-semaphore))
    487488  (if (and tcr (not (eql 0 tcr)))
    488489    (with-macptrs (tcrp)
     
    490491      (setf (%get-natural tcrp target::tcr.log2-allocation-quantum)
    491492            (or allocation-quantum (default-allocation-quantum)))
    492       (setf (%get-ptr tcrp target::tcr.termination-semaphore)
    493             (if termination-semaphore
    494               (semaphore-value termination-semaphore)
    495               (%null-ptr)))
    496493      t)))
    497494                         
     
    11151112(defun %foreign-thread-terminate ()
    11161113  (let* ((proc *current-process*))
    1117     (when proc (remove-from-all-processes proc))))
     1114    (when proc
     1115      (remove-from-all-processes proc)
     1116      (let* ((ts (process-termination-semaphore proc)))
     1117        (when ts (signal-semaphore ts))))))
     1118
  • branches/working-0711/ccl/level-1/l1-processes.lisp

    r12224 r12799  
    319319    ))
    320320
    321 (defmethod (setf process-termination-semaphore) :after (new (p process))
    322   (with-macptrs (tcrp)
    323     (%setf-macptr-to-object tcrp (process-tcr p))
    324     (unless (%null-ptr-p tcrp)
    325       (setf (%get-ptr tcrp target::tcr.termination-semaphore)
    326             (if new
    327               (semaphore-value new)
    328               (%null-ptr))))
    329     new))
     321
    330322
    331323(defun process-resume (p)
     
    418410;;; Separated from run-process-initial-form just so I can change it easily.
    419411(defun process-initial-form-exited (process kill)
    420   ;; Enter the *initial-process* and have it finish us up
    421412  (without-interrupts
    422413   (if (eq kill :shutdown)
     
    424415       (setq *whostate* "Shutdown")
    425416       (add-to-shutdown-processes process)))
     417   (let* ((semaphore (process-termination-semaphore process)))
     418     (when semaphore (signal-semaphore semaphore)))
    426419   (maybe-finish-process-kill process kill)))
    427420
  • branches/working-0711/ccl/lisp-kernel/thread_manager.c

    r12753 r12799  
    13811381
    13821382  area *vs, *ts, *cs;
    1383   void *termination_semaphore;
    13841383 
    13851384  if (current == NULL) {
     
    14241423    tcr->osid = 0;
    14251424    tcr->interrupt_pending = 0;
    1426     termination_semaphore = tcr->termination_semaphore;
    14271425    tcr->termination_semaphore = NULL;
    14281426#ifdef HAVE_TLS
     
    14391437#endif
    14401438    UNLOCK(lisp_global(TCR_AREA_LOCK),current);
    1441     if (termination_semaphore) {
    1442       SEM_RAISE(termination_semaphore);
    1443     }
    14441439  } else {
    14451440    tsd_set(lisp_global(TCR_KEY), TCR_TO_TSD(tcr));
Note: See TracChangeset for help on using the changeset viewer.