From 1432088f2780aff52cad7639d440e2f932478f60 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 7 May 2021 16:13:09 +0200 Subject: [PATCH] Minor tweak to truncate-bits * module/system/base/types/internal.scm (truncate-bits): Use bits-case in all cases. --- module/system/base/types/internal.scm | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/module/system/base/types/internal.scm b/module/system/base/types/internal.scm index 0514d7b3b..546c6d26c 100644 --- a/module/system/base/types/internal.scm +++ b/module/system/base/types/internal.scm @@ -231,21 +231,18 @@ may not fit into a word on the target platform." (define (truncate-bits x bits signed?) (define-syntax-rule (bits-case bits) - (let ((umax (1- (ash 1 bits))) - (smin (ash -1 (1- bits))) - (smax (1- (ash 1 (1- bits))))) + (let ((umax (1- (ash 1 bits)))) (and (if signed? - (<= smin x smax) + (let ((smin (ash -1 (1- bits))) + (smax (1- (ash 1 (1- bits))))) + (<= smin x smax)) (<= 0 x umax)) (logand x umax)))) (case bits ((16) (bits-case 16)) ((32) (bits-case 32)) ((64) (bits-case 64)) - (else - (let ((x' (logand x (1- (ash 1 bits))))) - (and (eq? x (if signed? (sign-extend x' bits) x')) - x'))))) + (else (bits-case bits)))) ;; See discussion in tags.h and boolean.h. (eval-when (expand)