- (declare (optimize (speed 3) (safety 0)))
- (let ((length (1+ (do* ((offset 0)
- (length (length string))
- (index 0 (1+ index)))
- ((= index length) offset)
- (declare (type fixnum offset))
- (let ((bits (char-code (char string index))))
- (cond
- ((< bits #x80) (incf offset 1))
- ((< bits #x800) (incf offset 2))
- ((< bits #x10000) (incf offset 3))
- (t (incf offset 4))))))))
- (let ((vector (make-array length :element-type '(unsigned-byte 8)
- :initial-element 0)))
- (do* ((offset 0)
- (length (length string))
- (index 0 (1+ index)))
- ((= index length) vector)
- (declare (type fixnum offset))
- (let ((bits (char-code (char string index))))
- (cond
- ((< bits #x80)
- (setf (aref vector offset) bits)
- (incf offset))
- ((< bits #x800)
- (setf (aref vector offset) (logior #xc0 (ldb (byte 5 6) bits)))
- (setf (aref vector (1+ offset))
- (logior #x80 (ldb (byte 6 0) bits)))
- (incf offset 2))
- ((< bits #x10000)
- (setf (aref vector offset) (logior #xe0 (ldb (byte 4 12) bits)))
- (setf (aref vector (1+ offset))
- (logior #x80 (ldb (byte 6 6) bits)))
- (setf (aref vector (+ offset 2))
- (logior #x80 (ldb (byte 6 0) bits)))
- (incf offset 3))
- (t
- (setf (aref vector offset) (logior #xf0 (ldb (byte 3 18) bits)))
- (setf (aref vector (1+ offset))
- (logior #x80 (ldb (byte 6 12) bits)))
- (setf (aref vector (+ offset 2))
- (logior #x80 (ldb (byte 6 6) bits)))
- (setf (aref vector (+ offset 3))
- (logior #x80 (ldb (byte 6 0) bits)))
- (incf offset 4)))))))))