mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-02-04 22:50:39 -08:00
Code Issues Projects Releases Packages Wiki Activity

Simplified the inliners for ldb, ldb-test and mask-field introducing a new macro that introduces the type checks and optimizes out constant values.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2013-01-09 15:53:16 +01:00
parent 40ddf4d58d
commit 20ac97795e
3 changed files with 29 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -28,22 +28,10 @@
(define-compiler-macro ldb (&whole whole bytespec integer)
(if (inline-bytespec bytespec)
(let ((size (second bytespec))
(pos (third bytespec)))
(cond ((and (integerp size)
(integerp pos)
(<= (+ size pos) #.(integer-length most-positive-fixnum))
(policy-assume-right-type)
(subtypep (result-type integer) 'FIXNUM))
`(truly-the fixnum (ldb1 ,size ,pos ,integer)))
((or (policy-assume-right-type)
(typep pos 'unsigned-byte))
`(logand (lognot (ash -1 ,size)) (ash ,integer (- ,pos))))
(t
(with-clean-symbols (%pos)
`(let ((%pos (optional-type-assertion ,pos unsigned-byte)))
(logand (lognot (ash -1 ,size))
(ash ,integer (- %pos))))))))
(with-clean-symbols (%pos %size)
`(with-let-type-check ((%size ,(second bytespec) unsigned-byte)
(%pos ,(third bytespec) unsigned-byte))
(logand (lognot (ash -1 %size)) (ash ,integer (- %pos)))))
whole))
(define-compiler-macro ldb-test (&whole whole bytespec integer)
@ -53,11 +41,11 @@
(define-compiler-macro mask-field (&whole whole bytespec integer)
(if (inline-bytespec bytespec)
(let ((size (second bytespec))
(pos (third bytespec)))
`(logand (ash (lognot (ash -1 ,size))
(optional-type-check ,pos unsigned-byte))
,integer))
(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)))
whole))
#+(or)
@ -65,9 +53,11 @@
(if (inline-bytespec bytespec)
(let ((size (second bytespec))
(pos (third bytespec)))
`(logand (ash (lognot (ash -1 ,size))
(optional-type-assertion ,pos unsigned-byte))
,integer))
(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))))
whole))
;;;

15
src/cmp/cmptype.lsp
View file

@ -204,3 +204,18 @@
value
`(assert-type-if-known ,value ,type)))
(defmacro with-let-type-check (triplets &body body &environment env)
(flet ((wrap (let-or-macro var value body)
`(,let-or-macro ((,var ',value))
,body)))
(loop with body = `(progn ,@body)
for (var value type) in (reverse triplets)
do (setf body
(if (policy-assume-right-type)
(wrap 'symbol-macrolet var value body)
(let ((new-value (extract-constant-value value env)))
(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)))))
finally (return body))))

5
src/cmp/sysfun.lsp
View file

@ -798,11 +798,6 @@
(def-inline ext:fixnump :always (t) :bool "ECL_FIXNUMP(#0)")
(def-inline ext:fixnump :always (fixnum) :bool "1")
(def-inline c::ldb1 :always (fixnum fixnum fixnum) :fixnum
"((((~((cl_fixnum)-1 << (#0))) << (#1)) & (cl_fixnum)(#2)) >> (#1))")
(def-inline c::ldb1 :always (fixnum fixnum fixnum) t
"ecl_make_fixnum((((~((cl_fixnum)-1 << (#0))) << (#1)) & (cl_fixnum)(#2)) >> (#1))")
;; Functions only available with threads
#+threads
(def-inline mp:lock-count :unsafe (mp:lock) fixnum "((#0)->lock.count)")