X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fmeta-vmdef.lisp;h=98c4600c2f1a592aedfed91ea866dd4ba5029fdf;hb=69e6aef5e6fb3bd682c7a2cbf774034d2ea58ee8;hp=37fb1fbdcdc39ccd70f9c5b8e440ff8611038583;hpb=953e2961a4e0f130d67da600d1c965d6794a8984;p=sbcl.git

diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp
index 37fb1fb..98c4600 100644
--- 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.
-(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))
@@ -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))
-     (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)
-                 (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")