projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
UPGRADED-ARRAY-ELEMENT-TYPE: more thoroughly signal errors on unknown types.
[sbcl.git]
/
src
/
compiler
/
meta-vmdef.lisp
diff --git
a/src/compiler/meta-vmdef.lisp
b/src/compiler/meta-vmdef.lisp
index
37fb1fb
..
98c4600
100644
(file)
--- a/
src/compiler/meta-vmdef.lisp
+++ b/
src/compiler/meta-vmdef.lisp
@@
-27,7
+27,8
@@
;;;
;;; We enter the basic structure at meta-compile time, and then fill
;;; in the missing slots at load time.
;;;
;;; We enter the basic structure at meta-compile time, and then fill
;;; in the missing slots at load time.
-(defmacro define-storage-base (name kind &key size)
+(defmacro define-storage-base (name kind &key size (size-increment size)
+ (size-alignment 1))
(declare (type symbol name))
(declare (type (member :finite :unbounded :non-packed) kind))
(declare (type symbol name))
(declare (type (member :finite :unbounded :non-packed) kind))
@@
-39,11
+40,16
@@
(error "A size specification is meaningless in a ~S SB." kind)))
((:finite :unbounded)
(unless size (error "Size is not specified in a ~S SB." kind))
(error "A size specification is meaningless in a ~S SB." kind)))
((:finite :unbounded)
(unless size (error "Size is not specified in a ~S SB." kind))
- (aver (typep size 'unsigned-byte))))
+ (aver (typep size 'unsigned-byte))
+ (aver (= 1 (logcount size-alignment)))
+ (aver (not (logtest size (1- size-alignment))))
+ (aver (not (logtest size-increment (1- size-alignment))))))
(let ((res (if (eq kind :non-packed)
(make-sb :name name :kind kind)
(let ((res (if (eq kind :non-packed)
(make-sb :name name :kind kind)
- (make-finite-sb :name name :kind kind :size size))))
+ (make-finite-sb :name name :kind kind :size size
+ :size-increment size-increment
+ :size-alignment size-alignment))))
`(progn
(eval-when (:compile-toplevel :load-toplevel :execute)
(/show0 "about to SETF GETHASH META-SB-NAMES in DEFINE-STORAGE-BASE")
`(progn
(eval-when (:compile-toplevel :load-toplevel :execute)
(/show0 "about to SETF GETHASH META-SB-NAMES in DEFINE-STORAGE-BASE")