Author: eweitz Date: Sun May 25 17:36:37 2008 New Revision: 60

Modified: branches/edi/encode.lisp branches/edi/util.lisp Log: Help some Lisps optimize the encoding functions

Modified: branches/edi/encode.lisp ============================================================================== --- branches/edi/encode.lisp (original) +++ branches/edi/encode.lisp Sun May 25 17:36:37 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.22 2008/05/25 20:44:03 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.23 2008/05/25 21:26:12 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -203,65 +203,67 @@ (octet-writer octet))))

(define-char-encoders (flexi-utf-8-format flexi-cr-utf-8-format flexi-crlf-utf-8-format) + ;; the old version using LDB was more elegant, but some Lisps had + ;; trouble optimizing it (let ((char-code (char-code char-getter))) (tagbody (cond ((< char-code #x80) (octet-writer char-code) (go zero)) ((< char-code #x800) - (octet-writer (logior #b11000000 (ldb (byte 5 6) char-code))) + (octet-writer (logior* #b11000000 (ash* char-code -6))) (go one)) ((< char-code #x10000) - (octet-writer (logior #b11100000 (ldb (byte 4 12) char-code))) + (octet-writer (logior* #b11100000 (ash* char-code -12))) (go two)) (t - (octet-writer (logior #b11110000 (ldb (byte 3 18) char-code))))) - (octet-writer (logior #b10000000 (ldb (byte 6 12) char-code))) + (octet-writer (logior* #b11110000 (ash* char-code -18))))) + (octet-writer (logior* #b10000000 (logand* #b00111111 (ash* char-code -12)))) two - (octet-writer (logior #b10000000 (ldb (byte 6 6) char-code))) + (octet-writer (logior* #b10000000 (logand* #b00111111 (ash* char-code -6)))) one - (octet-writer (logior #b10000000 (ldb (byte 6 0) char-code))) + (octet-writer (logior* #b10000000 (logand* #b00111111 char-code))) zero)))

(define-char-encoders (flexi-utf-16-le-format flexi-cr-utf-16-le-format flexi-crlf-utf-16-le-format) (flet ((write-word (word) - (octet-writer (ldb (byte 8 0) word)) - (octet-writer (ldb (byte 8 8) word)))) + (octet-writer (logand* #x00ff word)) + (octet-writer (ash* (logand* #xff00 word) -8)))) (declare (inline write-word)) (let ((char-code (char-code char-getter))) (declare (type char-code-integer char-code)) (cond ((< char-code #x10000) (write-word char-code)) (t (decf char-code #x10000) - (write-word (logior #xd800 (ldb (byte 10 10) char-code))) - (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))) + (write-word (logior* #xd800 (ash* char-code -10))) + (write-word (logior* #xdc00 (logand* #x03ff char-code))))))))

(define-char-encoders (flexi-utf-16-be-format flexi-cr-utf-16-be-format flexi-crlf-utf-16-be-format) (flet ((write-word (word) - (octet-writer (ldb (byte 8 8) word)) - (octet-writer (ldb (byte 8 0) word)))) + (octet-writer (ash* (logand* #xff00 word) -8)) + (octet-writer (logand* #x00ff word)))) (declare (inline write-word)) (let ((char-code (char-code char-getter))) (declare (type char-code-integer char-code)) (cond ((< char-code #x10000) (write-word char-code)) (t (decf char-code #x10000) - (write-word (logior #xd800 (ldb (byte 10 10) char-code))) - (write-word (logior #xdc00 (ldb (byte 10 0) char-code)))))))) + (write-word (logior* #xd800 (ash* char-code -10))) + (write-word (logior* #xdc00 (logand* #x03ff char-code))))))))

(define-char-encoders (flexi-utf-32-le-format flexi-cr-utf-32-le-format flexi-crlf-utf-32-le-format) (let ((char-code (char-code char-getter))) - (octet-writer (ldb (byte 8 0) char-code)) - (octet-writer (ldb (byte 8 8) char-code)) - (octet-writer (ldb (byte 8 16) char-code)) - (octet-writer (ldb (byte 8 24) char-code)))) + (octet-writer (logand* #x00ff char-code)) + (octet-writer (logand* #x00ff (ash* char-code -8))) + (octet-writer (logand* #x00ff (ash* char-code -16))) + (octet-writer (logand* #x00ff (ash* char-code -24)))))

(define-char-encoders (flexi-utf-32-be-format flexi-cr-utf-32-be-format flexi-crlf-utf-32-be-format) (let ((char-code (char-code char-getter))) - (octet-writer (ldb (byte 8 24) char-code)) - (octet-writer (ldb (byte 8 16) char-code)) - (octet-writer (ldb (byte 8 8) char-code)) - (octet-writer (ldb (byte 8 0) char-code)))) + (octet-writer (logand* #x00ff (ash* char-code -24))) + (octet-writer (logand* #x00ff (ash* char-code -16))) + (octet-writer (logand* #x00ff (ash* char-code -8))) + (octet-writer (logand* #x00ff char-code))))

(defmethod char-to-octets ((format flexi-cr-mixin) char writer) (declare #.*fixnum-optimize-settings*)

Modified: branches/edi/util.lisp ============================================================================== --- branches/edi/util.lisp (original) +++ branches/edi/util.lisp Sun May 25 17:36:37 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.23 2008/05/25 03:07:59 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.24 2008/05/25 21:26:12 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -192,4 +192,16 @@ "Tries to `rewind' the (binary) stream STREAM by OCTETS octets. Returns a true value if it succeeds." (when-let (position (file-position stream)) - (file-position stream (- position octets)))) \ No newline at end of file + (file-position stream (- position octets)))) + +(defmacro logand* (x y) + "Solely for optimization purposes. Some Lisps need it, some don't." + `(the fixnum (logand ,x ,y))) + +(defmacro logior* (x y) + "Solely for optimization purposes. Some Lisps need it, some don't." + `(the fixnum (logior ,x ,y))) + +(defmacro ash* (integer count) + "Solely for optimization purposes. Some Lisps need it, some don't." + `(the fixnum (ash ,integer ,count)))