- (flet ((definition (name lambda-list width pattern)
- `(defun ,name ,lambda-list
- (flet ((prepare-argument (x)
- (declare (integer x))
- (etypecase x
- ((unsigned-byte ,width) x)
- (fixnum (logand x ,pattern))
- (bignum (logand x ,pattern)))))
- (,name ,@(loop for arg in lambda-list
- collect `(prepare-argument ,arg)))))))
- (loop for infos being each hash-value of (sb!c::modular-class-funs sb!c::*unsigned-modular-class*)
- ;; FIXME: We need to process only "toplevel" functions
- when (listp infos)
- do (loop for info in infos
- for name = (sb!c::modular-fun-info-name info)
- and width = (sb!c::modular-fun-info-width info)
- and lambda-list = (sb!c::modular-fun-info-lambda-list info)
- for pattern = (1- (ash 1 width))
- do (forms (definition name lambda-list width pattern)))))
- `(progn ,@(forms)))
-
-#.
-(collect ((forms))
- (flet ((definition (name lambda-list width)
+ (flet ((unsigned-definition (name lambda-list width)
+ (let ((pattern (1- (ash 1 width))))
+ `(defun ,name ,lambda-list
+ (flet ((prepare-argument (x)
+ (declare (integer x))
+ (etypecase x
+ ((unsigned-byte ,width) x)
+ (fixnum (logand x ,pattern))
+ (bignum (logand x ,pattern)))))
+ (,name ,@(loop for arg in lambda-list
+ collect `(prepare-argument ,arg)))))))
+ (signed-definition (name lambda-list width)