Changeset 6559


Ignore:
Timestamp:
May 16, 2007, 7:31:25 AM (14 years ago)
Author:
gb
Message:

Try to deal with the "SIMPLE-BASE-STRING, all of it" case in
%CSTR-POINTER; deal with all other cases in %CSTR-SEGMENT-POINTER.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-0/l0-aprims.lisp

    r5384 r6559  
    5757
    5858(defun %cstr-pointer (string pointer &optional (nul-terminated t))
    59   (multiple-value-bind (s o n) (dereference-base-string string)
    60     (declare (fixnum o n))
    61     (do* ((i 0 (1+ i))
    62           (o o (1+ o)))
    63          ((= i n))
    64       (declare (fixnum i o))
    65       (setf (%get-unsigned-byte pointer i)
    66             (let* ((code (char-code (schar s o))))
    67               (declare (type (mod #x110000) code))
    68               (if (< code 256)
    69                 code
    70                 (char-code #\Sub)))))
    71     (when nul-terminated
    72       (setf (%get-byte pointer n) 0)))
    73   nil)
     59  (if (typep string 'simple-base-string)
     60    (locally (declare (simple-base-string string)
     61                      (optimize (speed 3) (safety 0)))
     62      (let* ((n (length string)))
     63        (declare (fixnum n))
     64        (dotimes (i n)
     65          (setf (%get-unsigned-byte pointer i)
     66                (let* ((code (%scharcode string i)))
     67                  (declare (type (mod #x110000) code))
     68                  (if (< code 256)
     69                    code
     70                    (char-code #\Sub)))))
     71        (when nul-terminated
     72          (setf (%get-byte pointer n) 0)))
     73      nil))
     74  (%cstr-segment-pointer string pointer 0 (length string) nul-terminated))
    7475
    75 (defun %cstr-segment-pointer (string pointer start end)
     76(defun %cstr-segment-pointer (string pointer start end &optional (nul-terminated t))
    7677  (declare (fixnum start end))
    7778  (let* ((n (- end start)))
    7879    (multiple-value-bind (s o) (dereference-base-string string)
    7980      (declare (fixnum o))
    80           (do* ((i 0 (1+ i))
    81           (o (the fixnum (+ o start)) (1+ o)))
    82          ((= i n))
    83       (declare (fixnum i o))
    84       (setf (%get-unsigned-byte pointer i)
    85             (logand #xff (char-code (schar s o)))))
    86     (setf (%get-byte pointer n) 0)
    87     nil)))
     81      (do* ((i 0 (1+ i))
     82            (o (the fixnum (+ o start)) (1+ o)))
     83           ((= i n))
     84        (declare (fixnum i o))
     85        (setf (%get-unsigned-byte pointer i)
     86              (let* ((code (char-code (schar s o))))
     87                (declare (type (mod #x110000) code))
     88                (if (< code 256)
     89                  code
     90                  (char-code #\Sub))))))
     91    (when nul-terminated
     92      (setf (%get-byte pointer n) 0))
     93    nil))
    8894
    8995(defun string (thing)
Note: See TracChangeset for help on using the changeset viewer.