Changeset 6552


Ignore:
Timestamp:
May 14, 2007, 6:37:01 PM (15 years ago)
Author:
gb
Message:

WITH-ENCODED-CSTR: accept arguments as produced by WITH-ENCODED-CSTRS.
Handle 0-termination a little more sanely.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/lib/macros.lisp

    r6504 r6552  
    15931593   (with-specs-aux 'with-cstr speclist body))
    15941594
    1595 (defmacro with-encoded-cstr (encoding-name (sym string &optional start end)
    1596                                  &rest body &environment env)
     1595(defmacro with-encoded-cstr ((encoding-name (sym string &optional start end))
     1596                             &rest body &environment env)
    15971597  (let* ((encoding (get-character-encoding encoding-name))
    1598          (nul-vector (character-encoding-nul-encoding encoding))
    15991598         (str (gensym))
    16001599         (len (gensym))
    1601          (i (gensym)))
    1602     (multiple-value-bind (body decls) (parse-body body env nil)
    1603       `(let* ((,str ,string))
    1604         (%stack-block ((,sym (cstring-encoded-length-in-bytes ,encoding ,str ,start ,end) :clear t))
    1605           ,@decls
    1606           (let* ((,len (encode-string-to-memory ,encoding ,sym 0 ,str ,start ,end)))
    1607             (declare (fixnum ,len))
    1608             (dotimes (,i (length ,nul-vector))
    1609               (setf (%get-unsigned-byte ,sym ,len) (aref ,nul-vector ,i))
    1610               (incf ,len)))
    1611           ,@body)))))
     1600         (nzeros (floor (character-encoding-code-unit-size encoding) 8)))
     1601    (collect ((trailing-zeros))
     1602      (case nzeros
     1603        (1 (trailing-zeros `(setf (%get-unsigned-byte ,sym ,len) 0)))
     1604        (2 (trailing-zeros `(setf (%get-unsigned-word ,sym ,len) 0)))
     1605        (4 (trailing-zeros `(setf (%get-unsigned-long ,sym ,len) 0)))
     1606        (t
     1607         (dotimes (i nzeros)
     1608           (trailing-zeros `(setf (%get-unsigned-byte ,sym (the fixnum (+ ,len ,i))) 0)))))
     1609      (multiple-value-bind (body decls) (parse-body body env nil)
     1610        `(let* ((,str ,string))
     1611          (%stack-block ((,sym (cstring-encoded-length-in-bytes ,encoding ,str ,start ,end)))
     1612            ,@decls
     1613            (let* ((,len (encode-string-to-memory ,encoding ,sym 0 ,str ,start ,end)))
     1614              (declare (fixnum ,len))
     1615              ,@(trailing-zeros)
     1616              ,@body)))))))
    16121617
    16131618(defmacro with-encoded-cstrs (encoding-name bindings &body body)
     
    16171622
    16181623
    1619 (defun with-specs-aux (name spec-list body)
    1620   (setq body (cons 'progn body))
    1621   (dolist (spec (reverse spec-list))
    1622      (setq body (list name spec body)))
    1623   body)
     1624(defun with-specs-aux (name spec-list original-body)
     1625  (multiple-value-bind (body decls) (parse-body original-body nil)
     1626    (when decls (error "declarations not allowed in ~s" original-body))
     1627    (setq body (cons 'progn body))
     1628    (dolist (spec (reverse spec-list))
     1629      (setq body (list name spec body)))
     1630    body))
    16241631
    16251632
Note: See TracChangeset for help on using the changeset viewer.