Patch requires bootstrap to regenerate C source file(s).
See also:
* https://git.adelielinux.org/adelie/packages/-/issues/926
* https://github.com/gambit/gambit/issues/806
From eb287205c10b3bcf5f497b33b520f468837a18ec Mon Sep 17 00:00:00 2001
From: Marc Feeley <feeley@iro.umontreal.ca>
Date: Sun, 18 Dec 2022 07:39:38 -0500
Subject: [PATCH] Avoid fixnum overflow on 32 bit machines in
port-settings-set!
diff --git a/lib/_io#.scm b/lib/_io#.scm
index e205e8ad..f55124dc 100644
--- a/lib/_io#.scm
+++ b/lib/_io#.scm
@@ -2,7 +2,7 @@
;;; File: "_io#.scm"
-;;; Copyright (c) 1994-2021 by Marc Feeley, All Rights Reserved.
+;;; Copyright (c) 1994-2022 by Marc Feeley, All Rights Reserved.
;;;============================================================================
@@ -817,36 +817,37 @@
(##define-macro (macro-default-readtable) #f)
-(##define-macro (macro-char-encoding-shift) 1)
-(##define-macro (macro-char-encoding-range) 32)
-(##define-macro (macro-default-char-encoding) 0)
-(##define-macro (macro-char-encoding-ASCII) 1)
-(##define-macro (macro-char-encoding-ISO-8859-1) 2)
-(##define-macro (macro-char-encoding-UTF-8) 3)
-(##define-macro (macro-char-encoding-UTF-16) 4)
-(##define-macro (macro-char-encoding-UTF-16BE) 5)
-(##define-macro (macro-char-encoding-UTF-16LE) 6)
-(##define-macro (macro-char-encoding-UTF-fallback-ASCII) 7)
-(##define-macro (macro-char-encoding-UTF-fallback-ISO-8859-1) 8)
-(##define-macro (macro-char-encoding-UTF-fallback-UTF-8) 9)
-(##define-macro (macro-char-encoding-UTF-fallback-UTF-16) 10)
-(##define-macro (macro-char-encoding-UTF-fallback-UTF-16BE) 11)
-(##define-macro (macro-char-encoding-UTF-fallback-UTF-16LE) 12)
-(##define-macro (macro-char-encoding-UCS-2) 13)
-(##define-macro (macro-char-encoding-UCS-2BE) 14)
-(##define-macro (macro-char-encoding-UCS-2LE) 15)
-(##define-macro (macro-char-encoding-UCS-4) 16)
-(##define-macro (macro-char-encoding-UCS-4BE) 17)
-(##define-macro (macro-char-encoding-UCS-4LE) 18)
-(##define-macro (macro-char-encoding-wchar) 19)
-(##define-macro (macro-char-encoding-native) 20)
+(##define-macro (macro-char-encoding-shift) 0)
+(##define-macro (macro-char-encoding-mask) (* 31 (expt 2 0)))
+(##define-macro (macro-default-char-encoding) 0)
+(##define-macro (macro-char-encoding-ASCII) 1)
+(##define-macro (macro-char-encoding-ISO-8859-1) 2)
+(##define-macro (macro-char-encoding-UTF-8) 3)
+(##define-macro (macro-char-encoding-UTF-16) 4)
+(##define-macro (macro-char-encoding-UTF-16BE) 5)
+(##define-macro (macro-char-encoding-UTF-16LE) 6)
+(##define-macro (macro-char-encoding-UTF-fallback-ASCII) 7)
+(##define-macro (macro-char-encoding-UTF-fallback-ISO-8859-1)8)
+(##define-macro (macro-char-encoding-UTF-fallback-UTF-8) 9)
+(##define-macro (macro-char-encoding-UTF-fallback-UTF-16) 10)
+(##define-macro (macro-char-encoding-UTF-fallback-UTF-16BE) 11)
+(##define-macro (macro-char-encoding-UTF-fallback-UTF-16LE) 12)
+(##define-macro (macro-char-encoding-UCS-2) 13)
+(##define-macro (macro-char-encoding-UCS-2BE) 14)
+(##define-macro (macro-char-encoding-UCS-2LE) 15)
+(##define-macro (macro-char-encoding-UCS-4) 16)
+(##define-macro (macro-char-encoding-UCS-4BE) 17)
+(##define-macro (macro-char-encoding-UCS-4LE) 18)
+(##define-macro (macro-char-encoding-wchar) 19)
+(##define-macro (macro-char-encoding-native) 20)
(##define-macro (macro-char-encoding-UTF)
`(macro-char-encoding-UTF-fallback-UTF-8))
(##define-macro (macro-max-unescaped-char options)
- `(let ((e (##fxmodulo (##fxquotient ,options (macro-char-encoding-shift))
- (macro-char-encoding-range))))
+ `(let ((e (##fxarithmetic-shift-right
+ (##fxand ,options (macro-char-encoding-mask))
+ (macro-char-encoding-shift))))
(cond ((##fx<= e (macro-char-encoding-ISO-8859-1))
(if (##fx= e (macro-char-encoding-ISO-8859-1))
(##integer->char #xff)
@@ -857,21 +858,21 @@
(else
(##integer->char #x10ffff)))))
-(##define-macro (macro-char-encoding-errors-shift) 32)
-(##define-macro (macro-char-encoding-errors-range) 4)
+(##define-macro (macro-char-encoding-errors-shift) 5)
+(##define-macro (macro-char-encoding-errors-mask) (* 3 (expt 2 5)))
(##define-macro (macro-default-char-encoding-errors) 0)
(##define-macro (macro-char-encoding-errors-on) 1)
(##define-macro (macro-char-encoding-errors-off) 2)
-(##define-macro (macro-eol-encoding-shift) 128)
-(##define-macro (macro-eol-encoding-range) 4)
+(##define-macro (macro-eol-encoding-shift) 7)
+(##define-macro (macro-eol-encoding-mask) (* 3 (expt 2 7)))
(##define-macro (macro-default-eol-encoding) 0)
(##define-macro (macro-eol-encoding-lf) 1)
(##define-macro (macro-eol-encoding-cr) 2)
(##define-macro (macro-eol-encoding-crlf) 3)
-(##define-macro (macro-buffering-shift) 512)
-(##define-macro (macro-buffering-range) 4)
+(##define-macro (macro-buffering-shift) 9)
+(##define-macro (macro-buffering-mask) (* 3 (expt 2 9)))
(##define-macro (macro-default-buffering) 0)
(##define-macro (macro-no-buffering) 1)
(##define-macro (macro-line-buffering) 2)
@@ -883,14 +884,14 @@
(##define-macro (macro-fully-buffered? options)
`(##not (##fx< (##fxand ,options 2047) 1536)))
-(##define-macro (macro-decode-state-shift) 2048)
-(##define-macro (macro-decode-state-range) 4)
+(##define-macro (macro-decode-state-shift) 11)
+(##define-macro (macro-decode-state-mask) (* 3 (expt 2 11)))
(##define-macro (macro-decode-state-none) 0)
(##define-macro (macro-decode-state-lf) 1)
(##define-macro (macro-decode-state-cr) 2)
-(##define-macro (macro-open-state-shift) 8192)
-(##define-macro (macro-open-state-range) 2)
+(##define-macro (macro-open-state-shift) 13)
+(##define-macro (macro-open-state-mask) (* 1 (expt 2 13)))
(##define-macro (macro-open-state-open) 0)
(##define-macro (macro-open-state-closed) 1)
@@ -903,15 +904,15 @@
(##define-macro (macro-unclose! options)
`(##fxand ,options -8193))
-(##define-macro (macro-permanent-close-shift) 16384)
-(##define-macro (macro-permanent-close-range) 2)
+(##define-macro (macro-permanent-close-shift) 14)
+(##define-macro (macro-permanent-close-mask) (* 1 (expt 2 14)))
(##define-macro (macro-permanent-close-no) 0)
(##define-macro (macro-permanent-close-yes) 1)
(##define-macro (macro-perm-close? options)
`(##not (##fx= (##fxand ,options 16384) 0)))
-(##define-macro (macro-direction-shift) 16)
+(##define-macro (macro-direction-shift) 4)
(##define-macro (macro-direction-in) 1)
(##define-macro (macro-direction-out) 2)
(##define-macro (macro-direction-inout) 3)
@@ -926,18 +927,18 @@
(##define-macro (macro-default-directory) #f)
-(##define-macro (macro-append-shift) 8)
+(##define-macro (macro-append-shift) 3)
(##define-macro (macro-no-append) 0)
(##define-macro (macro-append) 1)
(##define-macro (macro-default-append) 2)
-(##define-macro (macro-create-shift) 2)
+(##define-macro (macro-create-shift) 1)
(##define-macro (macro-no-create) 0)
(##define-macro (macro-maybe-create) 1)
(##define-macro (macro-create) 2)
(##define-macro (macro-default-create) 3)
-(##define-macro (macro-truncate-shift) 1)
+(##define-macro (macro-truncate-shift) 0)
(##define-macro (macro-no-truncate) 0)
(##define-macro (macro-truncate) 1)
(##define-macro (macro-default-truncate) 2)
diff --git a/lib/_io.scm b/lib/_io.scm
index d9387536..563d9664 100644
--- a/lib/_io.scm
+++ b/lib/_io.scm
@@ -1046,17 +1046,22 @@
(else
(error-improper-list))))))
-(##define-macro (macro-stream-options-output-shift) 32768)
+(##define-macro (macro-stream-options-output-shift) 15)
+(##define-macro (macro-stream-options-input-mask) 32767)
(define-prim (##psettings->roptions psettings default-options)
(##psettings-options->options
(macro-psettings-roptions psettings)
- (##fxmodulo default-options (macro-stream-options-output-shift))))
+ (##fxand
+ default-options
+ (macro-stream-options-input-mask))))
(define-prim (##psettings->woptions psettings default-options)
(##psettings-options->options
(macro-psettings-woptions psettings)
- (##fxquotient default-options (macro-stream-options-output-shift))))
+ (##fxwraplogical-shift-right
+ default-options
+ (macro-stream-options-output-shift))))
(define-prim (##psettings->input-readtable psettings)
(or (macro-psettings-options-readtable
@@ -1081,45 +1086,52 @@
(macro-psettings-options-char-encoding-errors options)))
(##fx+
(##fx+
- (##fx* (macro-char-encoding-shift)
- (if (##fx= char-encoding (macro-default-char-encoding))
- (##fxmodulo
- (##fxquotient default-options
- (macro-char-encoding-shift))
- (macro-char-encoding-range))
- char-encoding))
- (##fx* (macro-char-encoding-errors-shift)
- (if (##fx= char-encoding-errors (macro-default-char-encoding-errors))
- (##fxmodulo
- (##fxquotient default-options
- (macro-char-encoding-errors-shift))
- (macro-char-encoding-errors-range))
- char-encoding-errors))
+ (##fxarithmetic-shift-left
+ (if (##fx= char-encoding (macro-default-char-encoding))
+ (##fxarithmetic-shift-right
+ (##fxand
+ default-options
+ (macro-char-encoding-mask))
+ (macro-char-encoding-shift))
+ char-encoding)
+ (macro-char-encoding-shift))
+ (##fxarithmetic-shift-left
+ (if (##fx= char-encoding-errors (macro-default-char-encoding-errors))
+ (##fxarithmetic-shift-right
+ (##fxand
+ default-options
+ (macro-char-encoding-errors-mask))
+ (macro-char-encoding-errors-shift))
+ char-encoding-errors)
+ (macro-char-encoding-errors-shift))
(##fx+
(##fx+
- (##fx* (macro-eol-encoding-shift)
- (if (##fx= eol-encoding (macro-default-eol-encoding))
- (##fxmodulo
- (##fxquotient default-options
- (macro-eol-encoding-shift))
- (macro-eol-encoding-range))
- eol-encoding))
+ (##fxarithmetic-shift-left
+ (if (##fx= eol-encoding (macro-default-eol-encoding))
+ (##fxarithmetic-shift-right
+ (##fxand
+ default-options
+ (macro-eol-encoding-mask))
+ (macro-eol-encoding-shift))
+ eol-encoding)
+ (macro-eol-encoding-shift))
(##fx+
- (##fx* (macro-open-state-shift)
- (##fxmodulo
- (##fxquotient default-options
- (macro-open-state-shift))
- (macro-open-state-range)))
+ (##fxand
+ default-options
+ (macro-open-state-mask))
(##fx+
- (##fx* (macro-permanent-close-shift)
- permanent-close)
- (##fx* (macro-buffering-shift)
- (if (##fx= buffering (macro-default-buffering))
- (##fxmodulo
- (##fxquotient default-options
- (macro-buffering-shift))
- (macro-buffering-range))
- buffering))))))))))
+ (##fxarithmetic-shift-left
+ permanent-close
+ (macro-permanent-close-shift))
+ (##fxarithmetic-shift-left
+ (if (##fx= buffering (macro-default-buffering))
+ (##fxarithmetic-shift-right
+ (##fxand
+ default-options
+ (macro-buffering-mask))
+ (macro-buffering-shift))
+ buffering)
+ (macro-buffering-shift))))))))))
(define-prim (##psettings->device-flags psettings)
(let ((direction
@@ -1131,30 +1143,34 @@
(truncate
(macro-psettings-truncate psettings)))
(##fx+
- (##fx* (macro-direction-shift)
- direction)
+ (##fxarithmetic-shift-left
+ direction
+ (macro-direction-shift))
(##fx+
- (##fx* (macro-append-shift)
- (if (##not (##fx= append (macro-default-append)))
- append
- (macro-no-append)))
+ (##fxarithmetic-shift-left
+ (if (##not (##fx= append (macro-default-append)))
+ append
+ (macro-no-append))
+ (macro-append-shift))
(##fx+
- (##fx* (macro-create-shift)
- (cond ((##not (##fx= create (macro-default-create)))
- create)
- ((##fx= direction (macro-direction-out))
- (macro-maybe-create))
- (else
- (macro-no-create))))
- (##fx* (macro-truncate-shift)
- (cond ((##not (##fx= truncate (macro-default-truncate)))
- truncate)
- ((##fx= direction (macro-direction-out))
- (if (##fx= append (macro-append))
- (macro-no-truncate)
- (macro-truncate)))
- (else
- (macro-no-truncate)))))))))
+ (##fxarithmetic-shift-left
+ (cond ((##not (##fx= create (macro-default-create)))
+ create)
+ ((##fx= direction (macro-direction-out))
+ (macro-maybe-create))
+ (else
+ (macro-no-create)))
+ (macro-create-shift))
+ (##fxarithmetic-shift-left
+ (cond ((##not (##fx= truncate (macro-default-truncate)))
+ truncate)
+ ((##fx= direction (macro-direction-out))
+ (if (##fx= append (macro-append))
+ (macro-no-truncate)
+ (macro-truncate)))
+ (else
+ (macro-no-truncate)))
+ (macro-truncate-shift)))))))
(define-prim (##psettings->permissions psettings default-permissions)
(let ((permissions (macro-psettings-permissions psettings)))
@@ -3282,12 +3298,14 @@
(##psettings-options->options
options
(##fx+
- (##fx* (macro-open-state-shift)
- (if (##fx= kind (macro-none-kind))
- (macro-open-state-closed)
- (macro-open-state-open)))
- (##fx* (macro-buffering-shift)
- buffering))))
+ (##fxarithmetic-shift-left
+ (if (##fx= kind (macro-none-kind))
+ (macro-open-state-closed)
+ (macro-open-state-open))
+ (macro-open-state-shift))
+ (##fxarithmetic-shift-left
+ buffering
+ (macro-buffering-shift)))))
;;;----------------------------------------------------------------------------
@@ -6690,8 +6708,9 @@
(macro-port-woptions port))
(woptions
(##psettings->woptions psettings
- (##fx* old-woptions
- (macro-stream-options-output-shift)))))
+ (##fxarithmetic-shift-left
+ old-woptions
+ (macro-stream-options-output-shift)))))
(let ((code
(and (macro-output-port? port)
(##not (##fx= woptions old-woptions))
@@ -6716,8 +6735,9 @@
(##options-set!
port
(##fx+ roptions
- (##fx* woptions
- (macro-stream-options-output-shift)))))))
+ (##fxarithmetic-shift-left
+ woptions
+ (macro-stream-options-output-shift)))))))
(if (##fixnum? result)
(begin
(macro-port-mutex-unlock! port)
diff --git a/lib/_kernel#.scm b/lib/_kernel#.scm
index 9d3578f2..e00a4bba 100644
--- a/lib/_kernel#.scm
+++ b/lib/_kernel#.scm
@@ -249,28 +249,28 @@
;;; Debug settings.
-(##define-macro (macro-debug-settings-level-mask) 15)
+(##define-macro (macro-debug-settings-level-mask) (* 15 (expt 2 0)))
(##define-macro (macro-debug-settings-level-shift) 0)
-(##define-macro (macro-debug-settings-uncaught-mask) 16)
+(##define-macro (macro-debug-settings-uncaught-mask) (* 1 (expt 2 4)))
(##define-macro (macro-debug-settings-uncaught-primordial) 0)
(##define-macro (macro-debug-settings-uncaught-all) 1)
(##define-macro (macro-debug-settings-uncaught-shift) 4)
-(##define-macro (macro-debug-settings-error-mask) 96)
+(##define-macro (macro-debug-settings-error-mask) (* 3 (expt 2 5)))
(##define-macro (macro-debug-settings-error-repl) 0)
(##define-macro (macro-debug-settings-error-single-step) 1)
(##define-macro (macro-debug-settings-error-quit) 2)
(##define-macro (macro-debug-settings-error-shift) 5)
-(##define-macro (macro-debug-settings-repl-mask) 896)
+(##define-macro (macro-debug-settings-repl-mask) (* 7 (expt 2 7)))
(##define-macro (macro-debug-settings-repl-console) 0)
(##define-macro (macro-debug-settings-repl-stdio) 1)
(##define-macro (macro-debug-settings-repl-stdio-and-err) 2)
(##define-macro (macro-debug-settings-repl-client) 3)
(##define-macro (macro-debug-settings-repl-shift) 7)
-(##define-macro (macro-debug-settings-user-intr-mask) 3072)
+(##define-macro (macro-debug-settings-user-intr-mask) (* 3 (expt 2 10)))
(##define-macro (macro-debug-settings-user-intr-repl) 0)
(##define-macro (macro-debug-settings-user-intr-defer) 1)
(##define-macro (macro-debug-settings-user-intr-quit) 2)
--
2.25.1
