#.
(collect ((forms))
- (flet ((definition (name lambda-list prototype width)
+ (flet ((unsigned-definition (name lambda-list prototype width)
`(defun ,name ,lambda-list
- (ldb (byte ,width 0) (,prototype ,@lambda-list)))))
- (loop for infos being each hash-value of (modular-class-funs *unsigned-modular-class*) using (hash-key prototype)
- when (listp infos)
- do (loop for info in infos
- for name = (modular-fun-info-name info)
- and width = (modular-fun-info-width info)
- and lambda-list = (modular-fun-info-lambda-list info)
- do (forms (definition name lambda-list prototype width)))))
- `(progn ,@(forms)))
-
-#.
-(collect ((forms))
- (flet ((definition (name lambda-list prototype width)
+ (ldb (byte ,width 0) (,prototype ,@lambda-list))))
+ (signed-definition (name lambda-list prototype width)
`(defun ,name ,lambda-list
(mask-signed-field ,width (,prototype ,@lambda-list)))))
- (loop for infos being each hash-value of (modular-class-funs *signed-modular-class*) using (hash-key prototype)
- when (listp infos)
- do (loop for info in infos
- for name = (modular-fun-info-name info)
- and width = (modular-fun-info-width info)
- and lambda-list = (modular-fun-info-lambda-list info)
- do (forms (definition name lambda-list prototype width)))))
+ (flet ((do-mfuns (class)
+ (loop for infos being each hash-value of (modular-class-funs class) using (hash-key prototype)
+ when (listp infos)
+ do (loop for info in infos
+ for name = (modular-fun-info-name info)
+ and width = (modular-fun-info-width info)
+ and signedp = (modular-fun-info-signedp info)
+ and lambda-list = (modular-fun-info-lambda-list info)
+ if signedp
+ do (forms (signed-definition name lambda-list prototype width))
+ else
+ do (forms (unsigned-definition name lambda-list prototype width))))))
+ (do-mfuns *untagged-unsigned-modular-class*)
+ (do-mfuns *untagged-signed-modular-class*)
+ (do-mfuns *tagged-modular-class*)))
`(progn ,@(forms)))
-#!+#.(cl:if (cl:= sb!vm:n-machine-word-bits 32) '(and) '(or))
-(defun sb!vm::ash-left-mod32 (integer amount)
- (ldb (byte 32 0) (ash integer amount)))
-#!+#.(cl:if (cl:= sb!vm:n-machine-word-bits 64) '(and) '(or))
-(defun sb!vm::ash-left-mod64 (integer amount)
- (ldb (byte 64 0) (ash integer amount)))
-#!+x86
-(defun sb!vm::ash-left-smod30 (integer amount)
- (mask-signed-field 30 (ash integer amount)))
-#!+x86-64
-(defun sb!vm::ash-left-smod61 (integer amount)
- (mask-signed-field 61 (ash integer amount)))
+#.`
+(defun ,(intern (format nil "ASH-LEFT-MOD~D" sb!vm:n-machine-word-bits)
+ "SB!VM")
+ (integer amount)
+ (ldb (byte ,sb!vm:n-machine-word-bits 0) (ash integer amount)))
+#!+(or x86 x86-64)
+(defun sb!vm::ash-left-modfx (integer amount)
+ (mask-signed-field (- sb!vm:n-word-bits sb!vm:n-fixnum-tag-bits)
+ (ash integer amount)))