Changeset 10532

Show
Ignore:
Timestamp:
08/22/08 10:12:03 (3 months ago)
Author:
gb
Message:

Don't use *PNAME-BUFFER* to write pnames (not thread-safe), use
stack-allocated string instead.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • branches/working-0711/ccl/level-1/l1-io.lisp

    r10350 r10532  
    10161016 
    10171017 
    1018 (defvar *pname-buffer* (%cons-pool "12345678901234567890")) 
    10191018 
    10201019(defun write-pname (name case stream) 
    …… 
    10951094            (let* ((outbuf-len (+ len len)) 
    10961095                   (outbuf-ptr -1) 
    1097                    (pool *pname-buffer*) 
    1098                    (outbuf (pool.data pool))) 
    1099               (declare (fixnum outbuf-ptr) (simple-string outbuf)) 
    1100               (setf (pool.data pool) nil)   ; grab it. 
    1101               (unless (and outbuf (>= (length outbuf) outbuf-len)) 
    1102                 (setq outbuf (make-array outbuf-len :element-type 'character))) 
     1096                   (outbuf (make-string outbuf-len))) 
     1097              (declare (fixnum outbuf-ptr outbuf-len) 
     1098                       (dynamic-extent outbuf) 
     1099                       (simple-string outbuf)) 
    11031100              (dotimes (pos (the fixnum len)) 
    11041101                (declare (type fixnum pos)) 
    …… 
    11151112                    (setf (schar outbuf (incf outbuf-ptr)) #\\)) 
    11161113                  (setf (schar outbuf (incf outbuf-ptr)) char))) 
    1117               (write-string outbuf stream :start  0 :end (1+ outbuf-ptr)) 
    1118               (setf (pool.data pool) outbuf))))))) 
     1114              (write-string outbuf stream :start  0 :end (1+ outbuf-ptr)))))))) 
    11191115 
    11201116#| 
    …… 
    11581154  (let* ((readtable *readtable*) 
    11591155         (readcase (readtable-case readtable)) 
    1160          (pool *pname-buffer*) 
    11611156         (outbuf-ptr -1) 
    1162          (outbuf (pool.data pool)) 
     1157         (outbuf (make-string end)) 
    11631158         (word-start t) 
    11641159         (offset 0)) 
    1165     (declare (fixnum offset outbuf-ptr)) 
    1166     (setf (pool.data pool) nil) 
    1167     (unless (and outbuf (>= (length outbuf) end)) 
    1168       (setq outbuf (make-array end :element-type 'character)))  ; this  may be fat string now - do we care? 
     1160    (declare (fixnum offset outbuf-ptr) 
     1161             (dynamic-extent outbuf)) 
    11691162    (when (eq type :studly) 
    11701163      (do ((i 0 (%i+ i 1))) 
    …… 
    12061199              (t (setq word-start t))) 
    12071200        (setf (schar outbuf (incf outbuf-ptr)) c))) 
    1208     (write-string outbuf stream :start  0 :end end) 
    1209     (setf (pool.data pool) outbuf))) 
     1201    (write-string outbuf stream :start  0 :end end))) 
    12101202 
    12111203