Ignore:
Timestamp:
Jan 19, 2012, 1:47:48 AM (8 years ago)
Author:
gb
Message:

Except on the PPC (which has LAP versions of %EXTEND-VECTOR), define
%EXTEND-VECTOR in terms of %UVECTOR-REPLACE, which can use things like
%COPY-IVECTOR-TO-IVECTOR.

Make %UVECTOR-REPLACE work on non-CL-array uvector types, too.

When creating an fd-based stream (in MAKE-FD-STREAM and MAKE-FILE-STREAM),
if the stream is capable of character I/O it'll be buffered by an octet
vector, so call OPTIMAL-BUFFER-SIZE with the appropriate element type.
On Windows, use the arbitrary buffer size of 4K octets (rather than #$BUFSIZ).

In %IOBLOCK-UNENCODED-READ-LINE, if we haven't seen a newline in the first
few bufferfuls of data, stop expecting to do so (and grow the string in
larger increments less often.)

In the more generic READ-LINE cases, use a SIMPLE-STRING (and track
its length and current position manually) rather than a string with a
fill-pointer.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/l0-array.lisp

    r15158 r15165  
    399399;;; Both TARGET and SOURCE are (SIMPLE-ARRAY (*) *), and all of the
    400400;;; indices are fixnums and in bounds.
     401;;; (Actually, we allow some internal uvector types as well as CL vectors.)
    401402(defun %uvector-replace (target target-start source source-start n typecode)
    402403  (declare (fixnum target-start n source-start n typecode)
    403404           (optimize (speed 3) (safety 0)))
    404   (ecase typecode
    405     (#.target::subtag-simple-vector
    406      (if (and (eq source target)
    407               (> target-start source-start))
    408        (do* ((i 0 (1+ i))
    409              (source-pos (1- (the fixnum (+ source-start n)))
    410                          (1- source-pos))
    411              (target-pos (1- (the fixnum (+ target-start n)))
    412                          (1- target-pos)))
    413             ((= i n))
    414          (declare (fixnum i source-pos target-pos))
    415          (setf (svref target target-pos) (svref source source-pos)))
    416        (dotimes (i n)
    417          (setf (svref target target-start) (svref source source-start))
    418          (incf target-start)
    419          (incf source-start))))
    420     (#.target::subtag-bit-vector
    421      (if (and (eq source target)
    422               (> target-start source-start))
    423        (do* ((i 0 (1+ i))
    424              (source-pos (1- (the fixnum (+ source-start n)))
    425                          (1- source-pos))
    426              (target-pos (1- (the fixnum (+ target-start n)))
    427                          (1- target-pos)))
    428             ((= i n))
    429          (declare (fixnum i source-pos target-pos))
    430          (setf (sbit target target-pos) (sbit source source-pos)))
    431        (dotimes (i n)
    432          (setf (sbit target target-start) (sbit source source-start))
    433          (incf target-start)
    434          (incf source-start))))
    435     ;; All other cases can be handled with %COPY-IVECTOR-TO-IVECTOR,
    436     ;; which knows how to handle overlap
    437     ((#.target::subtag-s8-vector
    438       #.target::subtag-u8-vector)
    439      (%copy-ivector-to-ivector source
    440                                source-start
    441                                target
    442                                target-start
    443                                n))
    444     ((#.target::subtag-s16-vector
    445       #.target::subtag-u16-vector)
    446      (%copy-ivector-to-ivector source
    447                                (the fixnum (* source-start 2))
    448                                target
    449                                (the fixnum (* target-start 2))
    450                                (the fixnum (* n 2))))
    451     ((#.target::subtag-s32-vector
    452       #.target::subtag-u32-vector
    453       #.target::subtag-single-float-vector
    454       #.target::subtag-simple-base-string
    455       #+32-bit-target #.target::subtag-fixnum-vector)
    456      (%copy-ivector-to-ivector source
    457                                (the fixnum (* source-start 4))
    458                                target
    459                                (the fixnum (* target-start 4))
    460                                (the fixnum (* n 4))))
    461     ((#.target::subtag-double-float-vector
    462       #+64-bit-target #.target::subtag-s64-vector
    463       #+64-bit-target #.target::subtag-u64-vector
    464       #+64-bit-target #.target::subtag-fixnum-vector)
    465      (%copy-ivector-to-ivector source
    466                                (the fixnum
    467                                  (+ (the fixnum (- target::misc-dfloat-offset
    468                                                    target::misc-data-offset))
    469                                     (the fixnum (* source-start 8))))
    470                                target
    471                                (the fixnum
    472                                  (+ (the fixnum (- target::misc-dfloat-offset
    473                                                    target::misc-data-offset))
    474                                     (the fixnum (* target-start 8))))
    475                                (the fixnum (* n 8)))))
     405  (if (gvectorp target)
     406    (if (and (eq source target)
     407             (> target-start source-start))
     408      (do* ((i 0 (1+ i))
     409            (source-pos (1- (the fixnum (+ source-start n)))
     410                        (1- source-pos))
     411            (target-pos (1- (the fixnum (+ target-start n)))
     412                        (1- target-pos)))
     413           ((= i n))
     414        (declare (fixnum i source-pos target-pos))
     415        (setf (%svref target target-pos) (%svref source source-pos)))
     416      (dotimes (i n)
     417        (setf (%svref target target-start) (%svref source source-start))
     418        (incf target-start)
     419        (incf source-start)))
     420    (ecase typecode
     421      (#.target::subtag-bit-vector
     422       (if (and (eq source target)
     423                (> target-start source-start))
     424         (do* ((i 0 (1+ i))
     425               (source-pos (1- (the fixnum (+ source-start n)))
     426                           (1- source-pos))
     427               (target-pos (1- (the fixnum (+ target-start n)))
     428                           (1- target-pos)))
     429              ((= i n))
     430           (declare (fixnum i source-pos target-pos))
     431           (setf (sbit target target-pos) (sbit source source-pos)))
     432         (dotimes (i n)
     433           (setf (sbit target target-start) (sbit source source-start))
     434           (incf target-start)
     435           (incf source-start))))
     436      ;; All other cases can be handled with %COPY-IVECTOR-TO-IVECTOR,
     437      ;; which knows how to handle overlap
     438      ((#.target::subtag-s8-vector
     439        #.target::subtag-u8-vector)
     440       (%copy-ivector-to-ivector source
     441                                 source-start
     442                                 target
     443                                 target-start
     444                                 n))
     445      ((#.target::subtag-s16-vector
     446        #.target::subtag-u16-vector)
     447       (%copy-ivector-to-ivector source
     448                                 (the fixnum (* source-start 2))
     449                                 target
     450                                 (the fixnum (* target-start 2))
     451                                 (the fixnum (* n 2))))
     452      ((#.target::subtag-s32-vector
     453        #.target::subtag-u32-vector
     454        #.target::subtag-single-float-vector
     455        #.target::subtag-simple-base-string
     456        #.target::subtag-bignum
     457        #.target::subtag-single-float
     458        #.target::subtag-double-float
     459        #+32-bit-target #.target::subtag-fixnum-vector)
     460       (%copy-ivector-to-ivector source
     461                                 (the fixnum (* source-start 4))
     462                                 target
     463                                 (the fixnum (* target-start 4))
     464                                 (the fixnum (* n 4))))
     465      ((#.target::subtag-double-float-vector
     466        #+64-bit-target #.target::subtag-s64-vector
     467        #+64-bit-target #.target::subtag-u64-vector
     468        #+64-bit-target #.target::subtag-fixnum-vector)
     469       (%copy-ivector-to-ivector source
     470                                 (the fixnum
     471                                   (+ (the fixnum (- target::misc-dfloat-offset
     472                                                     target::misc-data-offset))
     473                                      (the fixnum (* source-start 8))))
     474                                 target
     475                                 (the fixnum
     476                                   (+ (the fixnum (- target::misc-dfloat-offset
     477                                                     target::misc-data-offset))
     478                                      (the fixnum (* target-start 8))))
     479                                 (the fixnum (* n 8))))))
    476480  target)
    477481
     
    867871  (%misc-set v i new))
    868872
     873#-ppc-target
     874(defun %extend-vector (start oldv newsize)
     875  (declare (fixnum start))
     876  (let* ((typecode (typecode oldv))
     877         (new (%alloc-misc newsize typecode))
     878         (oldsize (uvsize oldv)))
     879    (declare (fixnum oldsize) (type (unsigned-byte 8) typecode))
     880    (%uvector-replace  new start oldv 0 oldsize typecode)))
     881
    869882
    870883
Note: See TracChangeset for help on using the changeset viewer.