[flexi-streams-cvs] r60 - branches/edi
eweitz at common-lisp.net
eweitz at common-lisp.net
Sun May 25 21:36:38 UTC 2008
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)))
More information about the Flexi-streams-cvs
mailing list