diff --git a/nibbles.asd b/nibbles.asd index 0198548..abe0ea8 100644 --- a/nibbles.asd +++ b/nibbles.asd @@ -25,6 +25,7 @@ :maintainer "Sharp Lispers " :description "A library for accessing octet-addressed blocks of data in big- and little-endian orders" :license "BSD-style (http://opensource.org/licenses/BSD-3-Clause)" + :weakly-depends-on ("sb-nibbles") :default-component-class nibbles-source-file :components ((:static-file "README.md") (:static-file "LICENSE") diff --git a/sbcl-opt/fndb.lisp b/sbcl-opt/fndb.lisp index 45e20a9..4a3c79c 100644 --- a/sbcl-opt/fndb.lisp +++ b/sbcl-opt/fndb.lisp @@ -4,6 +4,44 @@ #+sbcl (progn +#+#.(cl:if (cl:find-package "SB-NIBBLES") '(:and) '(:or)) (progn + +(macrolet ((def (name size signedp setterp be-p) + (let* ((result-type `(,(if signedp 'signed-byte 'unsigned-byte) ,size)) + (arg-types `(array index ,@(when setterp (list result-type))))) + `(sb-c:defknown ,name ,arg-types ,result-type (sb-c:any) + :overwrite-fndb-silently t)))) + (def ub16ref/be 16 nil nil t) + (def ub16ref/le 16 nil nil nil) + (def ub16set/be 16 nil t t) + (def ub16set/le 16 nil t nil) + (def sb16ref/be 16 t nil t) + (def sb16ref/le 16 t nil nil) + (def sb16set/be 16 t t t) + (def sb16set/le 16 t t nil) + + (def ub32ref/be 32 nil nil t) + (def ub32ref/le 32 nil nil nil) + (def ub32set/be 32 nil t t) + (def ub32set/le 32 nil t nil) + (def sb32ref/be 32 t nil t) + (def sb32ref/le 32 t nil nil) + (def sb32set/be 32 t t t) + (def sb32set/le 32 t t nil) + + (def ub64ref/be 64 nil nil t) + (def ub64ref/le 64 nil nil nil) + (def ub64set/be 64 nil t t) + (def ub64set/le 64 nil t nil) + (def sb64ref/be 64 t nil t) + (def sb64ref/le 64 t nil nil) + (def sb64set/be 64 t t t) + (def sb64set/le 64 t t nil)) + +);#+(find-package "SB-NIBBLES") + +#-#.(cl:if (cl:find-package "SB-NIBBLES") '(:and) '(:or)) (progn + ;;; Efficient array bounds checking (sb-c:defknown %check-bound ((simple-array (unsigned-byte 8) (*)) index (and fixnum sb-vm:word) @@ -42,4 +80,6 @@ ,arg-type (sb-c:any) :overwrite-fndb-silently t) into defknowns finally (return `(progn ,@defknowns))) +);#-(find-package "SB-NIBBLES") + );#+sbcl diff --git a/sbcl-opt/nib-tran.lisp b/sbcl-opt/nib-tran.lisp index 62b1094..4eb8c2d 100644 --- a/sbcl-opt/nib-tran.lisp +++ b/sbcl-opt/nib-tran.lisp @@ -4,6 +4,49 @@ #+sbcl (progn +#+#.(cl:if (cl:find-package "SB-NIBBLES") '(:and) '(:or)) (progn + +(macrolet ((def (name size signedp setterp be-p) + (let* ((arglist `(vector offset ,@(when setterp '(value)))) + (sb-name (find-symbol (symbol-name name) "SB-NIBBLES")) + (result-type `(,(if signedp 'signed-byte 'unsigned-byte) ,size)) + (arg-types `(array index ,@(when setterp (list result-type))))) + (when sb-name + `(sb-c:deftransform ,name (,arglist ,arg-types ,result-type) + `(progn + (,',sb-name vector (sb-nibbles::%check-bound vector (length vector) offset ,',(truncate size 8)) ,@',(when setterp '(value))) + ,@',(when setterp '(value)))))))) + (def ub16ref/be 16 nil nil t) + (def ub16ref/le 16 nil nil nil) + (def ub16set/be 16 nil t t) + (def ub16set/le 16 nil t nil) + (def sb16ref/be 16 t nil t) + (def sb16ref/le 16 t nil nil) + (def sb16set/be 16 t t t) + (def sb16set/le 16 t t nil) + + (def ub32ref/be 32 nil nil t) + (def ub32ref/le 32 nil nil nil) + (def ub32set/be 32 nil t t) + (def ub32set/le 32 nil t nil) + (def sb32ref/be 32 t nil t) + (def sb32ref/le 32 t nil nil) + (def sb32set/be 32 t t t) + (def sb32set/le 32 t t nil) + + (def ub64ref/be 64 nil nil t) + (def ub64ref/le 64 nil nil nil) + (def ub64set/be 64 nil t t) + (def ub64set/le 64 nil t nil) + (def sb64ref/be 64 t nil t) + (def sb64ref/le 64 t nil nil) + (def sb64set/be 64 t t t) + (def sb64set/le 64 t t nil)) + +);#+(find-package "SB-NIBBLES") + +#-#.(cl:if (cl:find-package "SB-NIBBLES") '(:and) '(:or)) (progn + (sb-c:deftransform %check-bound ((vector bound offset n-bytes) ((simple-array (unsigned-byte 8) (*)) index (and fixnum sb-vm:word) @@ -93,4 +136,6 @@ collect generic-little-transform into transforms finally (return `(progn ,@transforms)))) +);#-(find-package "SB-NIBBLES") + );#+sbcl diff --git a/sbcl-opt/x86-64-vm.lisp b/sbcl-opt/x86-64-vm.lisp index afb095b..f07e8c0 100644 --- a/sbcl-opt/x86-64-vm.lisp +++ b/sbcl-opt/x86-64-vm.lisp @@ -3,7 +3,7 @@ #+sbcl (cl:in-package :sb-vm) -#+(and sbcl x86-64) (progn +#+(and sbcl x86-64 #.(cl:if (cl:find-package "SB-NIBBLES") '(:or) '(:and))) (progn (define-vop (%check-bound) (:translate nibbles::%check-bound) @@ -20,7 +20,7 @@ (:vop-var vop) (:generator 5 (let ((error (generate-error-code vop 'invalid-array-index-error - array bound index))) + array bound temp))) ;; We want to check the conditions: ;; ;; 0 <= INDEX @@ -36,9 +36,9 @@ ;; If INDEX + OFFSET <_u BOUND, though, INDEX must be less than ;; BOUND. We *do* need to check for 0 <= INDEX, but that has ;; already been assured by higher-level machinery. - (inst lea temp (ea (fixnumize offset) nil index)) + (inst lea temp (ea (fixnumize (1- offset)) nil index)) (inst cmp temp bound) - (inst jmp :a error) + (inst jmp :ae error) (move result index)))) #.(flet ((frob (bitsize setterp signedp big-endian-p) @@ -134,4 +134,4 @@ collect (frob bitsize setterp signedp big-endian-p) into forms finally (return `(progn ,@forms)))) -);#+(and sbcl x86-64) +);#+(and sbcl x86-64 (not (find-package "SB-NIBBLES"))) diff --git a/sbcl-opt/x86-vm.lisp b/sbcl-opt/x86-vm.lisp index 3d18fe8..ece04ce 100644 --- a/sbcl-opt/x86-vm.lisp +++ b/sbcl-opt/x86-vm.lisp @@ -3,7 +3,7 @@ #+sbcl (cl:in-package :sb-vm) -#+(and sbcl x86) (progn +#+(and sbcl x86 #.(cl:if (cl:find-package "SB-NIBBLES") '(:or) '(:and))) (progn (define-vop (%check-bound) (:translate nibbles::%check-bound) @@ -20,7 +20,7 @@ (:vop-var vop) (:generator 5 (let ((error (generate-error-code vop 'invalid-array-index-error - array bound index))) + array bound temp))) ;; We want to check the conditions: ;; ;; 0 <= INDEX @@ -36,9 +36,9 @@ ;; If INDEX + OFFSET <_u BOUND, though, INDEX must be less than ;; BOUND. We *do* need to check for 0 <= INDEX, but that has ;; already been assured by higher-level machinery. - (inst lea temp (make-ea :dword :index index :disp (fixnumize offset))) + (inst lea temp (make-ea :dword :index index :disp (fixnumize (1- offset)))) (inst cmp temp bound) - (inst jmp :a error) + (inst jmp :ae error) (move result index)))) #.(flet ((frob (setterp signedp big-endian-p) @@ -162,4 +162,4 @@ collect (frob setterp signedp big-endian-p) into forms finally (return `(progn ,@forms)))) -);#+(and sbcl x86) +);#+(and sbcl x86 (not (find-package "SB-NIBBLES")))