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 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