Changeset 885


Ignore:
Timestamp:
Sep 25, 2004, 9:37:31 PM (16 years ago)
Author:
gb
Message:

Kinder, gentler heap-ivector stuff. Use it.

File:
1 edited

Legend:

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

    r710 r885  
    145145
    146146(defloadvar *heap-ivectors* ())
     147(defvar *heap-ivector-lock* (make-lock))
     148
    147149
    148150(defun %make-heap-ivector (subtype size-in-bytes &optional size-in-elts)
     
    153155          (p (%null-ptr)))
    154156      (%vect-data-to-macptr vect p)
    155       (push vect *heap-ivectors*)
     157      (with-lock-grabbed (*heap-ivector-lock*)
     158        (push vect *heap-ivectors*))
    156159      (values vect p))))
    157160
    158 
    159 
    160   ; tag it, return it
    161 
    162 (defun %dispose-heap-ivector (v)
    163   (if  (uvectorp v) ;(%heap-ivector-p v)
     161(defun %heap-ivector-p (v)
     162  (with-lock-grabbed (*heap-ivector-lock*)
     163    (not (null (member v *heap-ivectors* :test #'eq)))))
     164
     165
     166(defun dispose-heap-ivector (v)
     167  (if (%heap-ivector-p v)
    164168    (with-macptrs (p)
    165       (setq *heap-ivectors* (delq v *heap-ivectors*))
     169      (with-lock-grabbed (*heap-ivector-lock*)
     170        (setq *heap-ivectors* (delq v *heap-ivectors*)))
    166171      (%%make-disposable p v)
    167172      (free p))))
    168173
    169 (defun make-heap-buffer (element-type element-count)
    170   (let* ((subtype ppc32::subtag-simple-base-string)
    171          (size-in-octets element-count))
    172     (unless (subtypep element-type 'character)
    173       (case element-type
    174         (unsigned-byte (setq element-type '(unsigned-byte 8)))
    175         (signed-byte (setq element-type '(signed-byte 8))))
    176       (let* ((signed (list 'signed-byte 0))
    177              (unsigned (list 'unsigned-byte 0)))
    178         (declare (dynamic-extent signed unsigned))
    179         (do* ((i 8 (+ i 8))
    180               (octets 1 (1+ octets))
    181               (match nil))             
    182              ((> i 32) (report-bad-arg element-type '(or character
    183                                                       (unsigned-byte 32)
    184                                                       (signed-byte 32))))
    185           (setf (cadr signed) i)
    186           (setf (cadr unsigned) i)
    187           (if (subtypep element-type signed)
    188             (setq match (copy-list signed))
    189             (if (subtypep element-type unsigned)
    190               (setq match (copy-list unsigned))))
    191           (when match
    192             (setq size-in-octets (* octets element-count)
    193                   subtype (element-type-subtype match)
    194                   element-type match)
    195             (return)))))
    196     (multiple-value-bind (buf p)
    197         (%make-heap-ivector subtype element-count size-in-octets)
    198       (values buf p size-in-octets subtype))))
     174(defun %dispose-heap-ivector (v)
     175  (dispose-heap-ivector v))
     176
     177(defun make-heap-ivector (element-count element-type)
     178  (let* ((subtag (ccl::element-type-subtype element-type)))
     179    (unless (= (logand subtag target::fulltagmask)
     180               target::fulltag-immheader)
     181      (error "~s is not an ivector subtype." element-type))
     182    (let* ((size-in-octets (ccl::subtag-bytes subtag element-count)))
     183      (multiple-value-bind (pointer vector)
     184          (ccl::%make-heap-ivector subtag size-in-octets element-count)
     185        (values pointer vector size-in-octets)))))
    199186
    200187
     
    875862      (unless (ioblock-inbuf ioblock)
    876863        (multiple-value-bind (buffer ptr in-size-in-octets)
    877             (make-heap-buffer element-type insize)
     864            (make-heap-ivector insize element-type)
    878865          (setf (ioblock-inbuf ioblock)
    879866                (make-io-buffer :buffer buffer
     
    895882        (unless (ioblock-outbuf ioblock)
    896883          (multiple-value-bind (buffer ptr out-size-in-octets)
    897               (make-heap-buffer element-type outsize)
     884              (make-heap-ivector outsize element-type)
    898885            (setf (ioblock-outbuf ioblock)
    899886                  (make-io-buffer :buffer buffer
Note: See TracChangeset for help on using the changeset viewer.