mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 07:12:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

Added optimizers for DPB and DEPOSIT-FIELD, and fixed WITH-LET*-TYPE-CHECK.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2013-01-09 16:08:31 +01:00
parent 20ac97795e
commit 2dc822c93a
2 changed files with 24 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

34
src/cmp/cmpopt-bits.lsp
View file

@ -29,8 +29,8 @@
(define-compiler-macro ldb (&whole whole bytespec integer)
(if (inline-bytespec bytespec)
(with-clean-symbols (%pos %size)
`(with-let-type-check ((%size ,(second bytespec) unsigned-byte)
(%pos ,(third bytespec) unsigned-byte))
`(with-let*-type-check ((%size ,(second bytespec) unsigned-byte)
(%pos ,(third bytespec) unsigned-byte))
(logand (lognot (ash -1 %size)) (ash ,integer (- %pos)))))
whole))
@ -42,22 +42,30 @@
(define-compiler-macro mask-field (&whole whole bytespec integer)
(if (inline-bytespec bytespec)
(with-clean-symbols (%pos %size)
`(with-let-type-check ((%size ,(second bytespec) unsigned-byte)
(%pos ,(third bytespec) unsigned-byte))
`(with-let*-type-check ((%size ,(second bytespec) unsigned-byte)
(%pos ,(third bytespec) unsigned-byte))
(logand (ash (lognot (ash -1 %size)) %pos)
,integer)))
whole))
#+(or)
(define-compiler-macro dpb (&whole bytespec integer newbyte)
(define-compiler-macro dpb (&whole whole newbyte bytespec integer)
(if (inline-bytespec bytespec)
(let ((size (second bytespec))
(pos (third bytespec)))
(with-clean-symbols (%pos %size)
`(with-let-type-check ((%size ,(second bytespec) unsigned-byte)
(%pos ,(third bytespec) unsigned-byte))
(logand (ash (lognot (ash -1 %size)) %pos)
,integer))))
(with-clean-symbols (%pos %size %mask)
`(with-let*-type-check ((%size ,(second bytespec) unsigned-byte)
(%pos ,(third bytespec) unsigned-byte)
(%mask (ash (lognot (ash -1 %size)) %pos) t))
(logior (logandc2 ,integer %mask)
(logand (ash ,newbyte %pos) %mask))))
whole))
(define-compiler-macro deposit-field (&whole whole newbyte bytespec integer)
(if (inline-bytespec bytespec)
(with-clean-symbols (%pos %size %mask)
`(with-let*-type-check ((%size ,(second bytespec) unsigned-byte)
(%pos ,(third bytespec) unsigned-byte)
(%mask (ash (lognot (ash -1 %size)) %pos) t))
(logior (logandc2 ,integer %mask)
(logand ,newbyte %mask))))
whole))
;;;

6
src/cmp/cmptype.lsp
View file

@ -204,9 +204,9 @@
value
`(assert-type-if-known ,value ,type)))
(defmacro with-let-type-check (triplets &body body &environment env)
(defmacro with-let*-type-check (triplets &body body &environment env)
(flet ((wrap (let-or-macro var value body)
`(,let-or-macro ((,var ',value))
`(,let-or-macro ((,var ,value))
,body)))
(loop with body = `(progn ,@body)
for (var value type) in (reverse triplets)
@ -217,5 +217,5 @@
(if (or (eq new-value env) ; not constant
(not (typep new-value type)))
(wrap 'let var `(assert-type-if-known ,value ,type) body)
(wrap 'symbol-macrolet var value body)))))
(wrap 'symbol-macrolet var (si::maybe-quote value) body)))))
finally (return body))))