Changeset 10220 for release


Ignore:
Timestamp:
Jul 27, 2008, 6:35:02 PM (11 years ago)
Author:
gb
Message:

Propagate recent changes from trunk:

l1-aprims.lisp: static value of *WHOSTATE* is "Reset".
l1-io.lisp: use stack-allocated temporary buffer in WRITE-PNAME.
l1-lisp-threads.lisp: in THREAD-ENABLE, default "wait" to 1 day.
l1-processes.lisp: PROCESS-WHOSTATE detects and handles static binding

of *WHOSTATE*. PROCESS-ENABLE waits for 1 day, which is effectively
infinite and avoids word-size issues.

Location:
release/1.2/source/level-1
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/1.2/source/level-1/l1-aprims.lisp

    r8775 r10220  
    5050(def-standard-initial-binding *lock-conses* (make-list 20)))
    5151(def-standard-initial-binding *whostate* "Reset")
    52 (setq *whostate* "Active")
     52(setq *whostate* "Reset")
    5353(def-standard-initial-binding *error-print-length* 20)
    5454(def-standard-initial-binding *error-print-level* 8)
  • release/1.2/source/level-1/l1-io.lisp

    r8530 r10220  
    986986
    987987
    988 (defvar *pname-buffer* (%cons-pool "12345678901234567890"))
    989 
    990988(defun write-pname (name case stream)
    991989  (declare (type simple-string name) (stream stream)
     
    10231021                           (return nil))
    10241022                         (setq sofar c-case))))))))
    1025         (declare (dynamic-extent slashify? single-case-p))
     1023        (declare (dynamic-extent #'slashify? #'single-case-p))
    10261024        (block alice
    10271025          (let ((len (length name))
     
    10651063            (let* ((outbuf-len (+ len len))
    10661064                   (outbuf-ptr -1)
    1067                    (pool *pname-buffer*)
    1068                    (outbuf (pool.data pool)))
    1069               (declare (fixnum outbuf-ptr) (simple-string outbuf))
    1070               (setf (pool.data pool) nil)   ; grab it.
    1071               (unless (and outbuf (>= (length outbuf) outbuf-len))
    1072                 (setq outbuf (make-array outbuf-len :element-type 'character)))
     1065                   (outbuf (make-string outbuf-len)))
     1066              (declare (fixnum outbuf-ptr outbuf-len)
     1067                       (dynamic-extent outbuf)
     1068                       (simple-string outbuf))
    10731069              (dotimes (pos (the fixnum len))
    10741070                (declare (type fixnum pos))
     
    10851081                    (setf (schar outbuf (incf outbuf-ptr)) #\\))
    10861082                  (setf (schar outbuf (incf outbuf-ptr)) char)))
    1087               (write-string outbuf stream :start  0 :end (1+ outbuf-ptr))
    1088               (setf (pool.data pool) outbuf)))))))
     1083              (write-string outbuf stream :start  0 :end (1+ outbuf-ptr))))))))
    10891084
    10901085#|
  • release/1.2/source/level-1/l1-lisp-threads.lisp

    r8579 r10220  
    395395        (cons function args)))
    396396
    397 (defun thread-enable (thread termination-semaphore allocation-quantum &optional (timeout most-positive-fixnum))
     397(defun thread-enable (thread termination-semaphore allocation-quantum &optional (timeout (* 60 60 24)))
    398398  (let* ((tcr (or (lisp-thread.tcr thread) (new-tcr-for-thread thread))))
    399399    (with-macptrs (s)
  • release/1.2/source/level-1/l1-processes.lisp

    r8130 r10220  
    217217  (if (process-exhausted-p p)
    218218    "Exhausted"
    219     (symbol-value-in-process '*whostate* p)))
     219    (let* ((loc nil))
     220    (if (eq p *current-process*)
     221      (setq loc (%tcr-binding-location (%current-tcr) '*whostate*))
     222      (let* ((tcr (process-tcr p)))
     223        (without-interrupts
     224         (unwind-protect
     225              (progn
     226                (%suspend-tcr tcr)
     227                (setq loc (%tcr-binding-location tcr '*whostate*)))
     228           (%resume-tcr tcr)))))
     229    (if loc
     230      (%fixnum-ref loc)
     231      (if (eq p *initial-process*)
     232        "Active"
     233        "Reset")))))
    220234
    221235(defun (setf process-whostate) (new p)
     
    252266
    253267
    254 (defun process-enable (p &optional (wait 1))
     268(defun process-enable (p &optional (wait (* 60 60 24) wait-p))
    255269  "Begin executing the initial function of a specified process."
    256270  (setq p (require-type p 'process))
    257271  (not-in-current-process p 'process-enable)
     272  (when wait-p
     273    (check-type wait (unsigned-byte 32)))
    258274  (unless (car (process-initial-form p))
    259275    (error "Process ~s has not been preset.  Use PROCESS-PRESET to preset the process." p))
Note: See TracChangeset for help on using the changeset viewer.