Changeset 602


Ignore:
Timestamp:
Mar 1, 2004, 5:05:52 PM (16 years ago)
Author:
gb
Message:

Don't terminate LISP-THREADs.

File:
1 edited

Legend:

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

    r465 r602  
    270270
    271271(defvar *lisp-thread-population*
    272   (%cons-population (list *initial-lisp-thread*) $population_weak-list t))
    273 
    274 
    275 
    276 ; Don't free stack oreas that contain part of the db_link chain.
    277 (defun delete-unused-stack-areas ()
    278   #+later
    279   (without-interrupts
    280    (do-unexhausted-stack-groups (sg)
    281      (macrolet ((do-area (sg.area &optional check-db-link)
    282                   `(let* ((current-p (eq sg *current-stack-group*))
    283                           area younger ,@(and check-db-link '(a)))
    284                      ; It's important that if sg is the current stack group,
    285                      ; then this code does no vsp or tsp pushes until the free-stack-area call.
    286                      (when current-p
    287                        (%normalize-areas))
    288                      (setq area (,sg.area sg)
    289                            younger (%fixnum-ref area ppc32::area.younger))
    290                      (unless (eql younger 0)
    291                        (unless ,(when check-db-link
    292                                   `(progn
    293                                      (setq a younger)
    294                                      (loop
    295                                        (when (if current-p
    296                                                (%db-link-chain-in-current-sg-area a)
    297                                                (%db-link-chain-in-area-p a sg))
    298                                          (return t))
    299                                        (setq a (%fixnum-ref a ppc32::area.younger))
    300                                        (when (eql a 0)
    301                                          (return nil)))))
    302                          (%fixnum-set area ppc32::area.younger 0)
    303                          (%fixnum-set younger ppc32::area.older 0)
    304                          (free-stack-area younger))))))
    305        (do-area sg.ts-area)
    306        (do-area sg.vs-area t)
    307        (%free-younger-cs-areas (sg.cs-area sg))
    308        ))))
     272  (%cons-population (list *initial-lisp-thread*) $population_weak-list nil))
     273
     274
     275
     276
    309277
    310278(defparameter *default-control-stack-size* (ash 1 20))
Note: See TracChangeset for help on using the changeset viewer.