user/gambit: add patch for overflow on 32-bit platforms. fixes #926.

Previous commits erroneously mentioned issue #924.

1 files changed, 439 insertions, 0 deletions

diff --git a/user/gambit-c/0001-Avoid-fixnum-overflow-on-32-bit-machines-in-port-set.patch b/user/gambit-c/0001-Avoid-fixnum-overflow-on-32-bit-machines-in-port-set.patch
new file mode 100644
index 000000000..9432f10a7
--- /dev/null
+++ b/user/gambit-c/0001-Avoid-fixnum-overflow-on-32-bit-machines-in-port-set.patch
@@ -0,0 +1,439 @@
+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
+