From d12f1f55ad2d2d3183d4db7c47a9b42d2589a666 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 4 May 2021 19:11:19 -0600
Subject: [PATCH] x86_64: sign-extend signed integers pass as foreign call
 arguments

I can't see where the ABI pins this down for x86_64, but the default
compiler on Mac OS seems to have started caring that 1-byte and 2-byte
integer arguments are sign-extended in registers. The previous lack of
sign extension would affect only small-structure arguments.
---
 racket/src/ChezScheme/mats/Mf-base |  2 +-
 racket/src/ChezScheme/s/x86_64.ss  | 14 +++++++-------
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/racket/src/ChezScheme/mats/Mf-base b/racket/src/ChezScheme/mats/Mf-base
index 1f6e44c793..458c69f121 100644
--- a/racket/src/ChezScheme/mats/Mf-base
+++ b/racket/src/ChezScheme/mats/Mf-base
@@ -339,7 +339,7 @@ allxhelp:
 # To support an eventual `make patches`, link `errors-$(conf)` to allxhelp output
 # if there's not already a representative for the configuration:
 forpatches = different-from-outdir
-$(forpatches)/errors-$(conf): $(outdir)/errors-$(conf)
+$(forpatches)/errors-$(conf):
 	ln -s $(outdir)/errors-$(conf) errors-$(conf)
 
 config-vars = spi hci ecpf cp0 cis p eval ctb cgr cmg eoc cl rmg
diff --git a/racket/src/ChezScheme/s/x86_64.ss b/racket/src/ChezScheme/s/x86_64.ss
index 875ec3ed59..06d10ee502 100644
--- a/racket/src/ChezScheme/s/x86_64.ss
+++ b/racket/src/ChezScheme/s/x86_64.ss
@@ -2629,7 +2629,7 @@
                           `(set! ,(%mref ,%sp ,offset) (inline ,(make-info-load 'integer-8 #f)
                                                                ,%load ,x ,%zero (immediate ,x-offset)))]))))]
                  [load-content-regs
-                  (lambda (classes size iint ifp)
+                  (lambda (classes size unsigned? iint ifp)
                     (lambda (x) ; requires var
                       (let loop ([size size] [iint iint] [ifp ifp] [classes classes] [x-offset 0])
                         (cond
@@ -2654,13 +2654,13 @@
                           (let loop ([reg (vector-ref vint iint)] [size size] [x-offset x-offset])
                             (cond
                              [(= size 4)
-                              `(set! ,reg (inline ,(make-info-load 'unsigned-32 #f)
+                              `(set! ,reg (inline ,(make-info-load (if unsigned? 'unsigned-32 'integer-32) #f)
                                                   ,%load ,x ,%zero (immediate ,x-offset)))]
                              [(= size 2)
-                              `(set! ,reg (inline ,(make-info-load 'unsigned-16 #f)
+                              `(set! ,reg (inline ,(make-info-load (if unsigned? 'unsigned-16 'integer-16) #f)
                                                   ,%load ,x ,%zero (immediate ,x-offset)))]
                              [(= size 1)
-                              `(set! ,reg (inline ,(make-info-load 'unsigned-8 #f)
+                              `(set! ,reg (inline ,(make-info-load (if unsigned? 'unsigned-8 'integer-8) #f)
                                                   ,%load ,x ,%zero (immediate ,x-offset)))]
                              [(> size 4)
                               ;; 5, 6, or 7: multiple steps to avoid reading too many bytes
@@ -2721,12 +2721,12 @@
                                           (eq? 'float (caar ($ftd->members ftd))))
                                      ;; float or double
                                      (loop (cdr types)
-                                       (cons (load-content-regs '(sse) ($ftd-size ftd) i i) locs)
+                                       (cons (load-content-regs '(sse) ($ftd-size ftd) #t i i) locs)
                                        (add-regs 1 i vint regs) (add-regs 1 i vfp fp-regs) (fx+ i 1) isp)]
                                     [else
                                      ;; integer
                                      (loop (cdr types)
-                                       (cons (load-content-regs '(integer) ($ftd-size ftd) i i) locs)
+                                       (cons (load-content-regs '(integer) ($ftd-size ftd) ($ftd-unsigned? ftd) i i) locs)
                                        (add-regs 1 i vint regs) fp-regs(fx+ i 1) isp)])]
                                   [else
                                    ;; pass as value on the stack
@@ -2790,7 +2790,7 @@
                                   [else
                                    ;; pass in registers
                                    (loop (cdr types)
-                                         (cons (load-content-regs classes ($ftd-size ftd) iint ifp) locs)
+                                         (cons (load-content-regs classes ($ftd-size ftd) ($ftd-unsigned? ftd) iint ifp) locs)
                                          (add-regs ints iint vint regs) (add-regs fps ifp vfp fp-regs)
                                          (fx+ iint ints) (fx+ ifp fps) isp)]))]
                               [else