X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-extensions.lisp;h=c3f2474359ca59d915547548e5ffde8871901417;hb=b7f3ef098847a4cc680f6304cec735b63bb70a0a;hp=01bfd6f680c2fc96d2c02c592f23074f61187c79;hpb=a682f4c392bc874a6a898632889319ebdd8821fc;p=sbcl.git diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 01bfd6f..c3f2474 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -30,6 +30,10 @@ ;;; bound because ANSI specifies it as an exclusive bound.) (def!type index () `(integer 0 (,sb!xc:array-dimension-limit))) +;;; like INDEX, but only up to half the maximum. Used by hash-table +;;; code that does plenty to (aref v (* 2 i)) and (aref v (1+ (* 2 i))). +(def!type index/2 () `(integer 0 (,(floor sb!xc:array-dimension-limit 2)))) + ;;; like INDEX, but augmented with -1 (useful when using the index ;;; to count downwards to 0, e.g. LOOP FOR I FROM N DOWNTO 0, with ;;; an implementation which terminates the loop by testing for the @@ -65,6 +69,30 @@ (* max-offset sb!vm:n-word-bytes)) scale))) +#!+(or x86 x86-64) +(defun displacement-bounds (lowtag element-size data-offset) + (let* ((adjustment (- (* data-offset sb!vm:n-word-bytes) lowtag)) + (bytes-per-element (ceiling element-size sb!vm:n-byte-bits)) + (min (truncate (+ sb!vm::minimum-immediate-offset adjustment) + bytes-per-element)) + (max (truncate (+ sb!vm::maximum-immediate-offset adjustment) + bytes-per-element))) + (values min max))) + +#!+(or x86 x86-64) +(def!type constant-displacement (lowtag element-size data-offset) + (flet ((integerify (x) + (etypecase x + (integer x) + (symbol (symbol-value x))))) + (let ((lowtag (integerify lowtag)) + (element-size (integerify element-size)) + (data-offset (integerify data-offset))) + (multiple-value-bind (min max) (displacement-bounds lowtag + element-size + data-offset) + `(integer ,min ,max))))) + ;;; Similar to FUNCTION, but the result type is "exactly" specified: ;;; if it is an object type, then the function returns exactly one ;;; value, if it is a short form of VALUES, then this short form