Changeset 12798 for trunk/source/level-1


Ignore:
Timestamp:
Sep 9, 2009, 8:47:04 AM (10 years ago)
Author:
gb
Message:

Don't copy a thread's termination semaphore to the TCR (so don't
signal it in the last stages of thread termination, possibly after
the lisp pointer to the semaphore has been GCed.)

Do try to signal it from lisp code, at least in cases where the thread
terminates normally (in PROCESS-INITIAL-FORM-EXITED).

Seems to fix ticket:598.

Location:
trunk/source/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-lisp-threads.lisp

    r12463 r12798  
    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
  • trunk/source/level-1/l1-processes.lisp

    r12205 r12798  
    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
Note: See TracChangeset for help on using the changeset viewer.