suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

x86_64: sign-extend signed integers pass as foreign call arguments

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2021-05-04 19:11:19 -06:00
parent bee9c46e0d
commit d12f1f55ad
2 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
racket/src/ChezScheme/mats/Mf-base
View File

@ -339,7 +339,7 @@ allxhelp:
# To support an eventual `make patches`, link `errors-$(conf)` to allxhelp output # To support an eventual `make patches`, link `errors-$(conf)` to allxhelp output
# if there's not already a representative for the configuration: # if there's not already a representative for the configuration:
forpatches = different-from-outdir forpatches = different-from-outdir
$(forpatches)/errors-$(conf): $(outdir)/errors-$(conf) $(forpatches)/errors-$(conf):
ln -s $(outdir)/errors-$(conf) errors-$(conf) ln -s $(outdir)/errors-$(conf) errors-$(conf)
config-vars = spi hci ecpf cp0 cis p eval ctb cgr cmg eoc cl rmg config-vars = spi hci ecpf cp0 cis p eval ctb cgr cmg eoc cl rmg

14
racket/src/ChezScheme/s/x86_64.ss
View File

@ -2629,7 +2629,7 @@
`(set! ,(%mref ,%sp ,offset) (inline ,(make-info-load 'integer-8 #f) `(set! ,(%mref ,%sp ,offset) (inline ,(make-info-load 'integer-8 #f)
,%load ,x ,%zero (immediate ,x-offset)))]))))] ,%load ,x ,%zero (immediate ,x-offset)))]))))]
[load-content-regs [load-content-regs
(lambda (classes size iint ifp) (lambda (classes size unsigned? iint ifp)
(lambda (x) ; requires var (lambda (x) ; requires var
(let loop ([size size] [iint iint] [ifp ifp] [classes classes] [x-offset 0]) (let loop ([size size] [iint iint] [ifp ifp] [classes classes] [x-offset 0])
(cond (cond
@ -2654,13 +2654,13 @@
(let loop ([reg (vector-ref vint iint)] [size size] [x-offset x-offset]) (let loop ([reg (vector-ref vint iint)] [size size] [x-offset x-offset])
(cond (cond
[(= size 4) [(= 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)))] ,%load ,x ,%zero (immediate ,x-offset)))]
[(= size 2) [(= 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)))] ,%load ,x ,%zero (immediate ,x-offset)))]
[(= size 1) [(= 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)))] ,%load ,x ,%zero (immediate ,x-offset)))]
[(> size 4) [(> size 4)
;; 5, 6, or 7: multiple steps to avoid reading too many bytes ;; 5, 6, or 7: multiple steps to avoid reading too many bytes
@ -2721,12 +2721,12 @@
(eq? 'float (caar ($ftd->members ftd)))) (eq? 'float (caar ($ftd->members ftd))))
;; float or double ;; float or double
(loop (cdr types) (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)] (add-regs 1 i vint regs) (add-regs 1 i vfp fp-regs) (fx+ i 1) isp)]
[else [else
;; integer ;; integer
(loop (cdr types) (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)])] (add-regs 1 i vint regs) fp-regs(fx+ i 1) isp)])]
[else [else
;; pass as value on the stack ;; pass as value on the stack
@ -2790,7 +2790,7 @@
[else [else
;; pass in registers ;; pass in registers
(loop (cdr types) (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) (add-regs ints iint vint regs) (add-regs fps ifp vfp fp-regs)
(fx+ iint ints) (fx+ ifp fps) isp)]))] (fx+ iint ints) (fx+ ifp fps) isp)]))]
[else [else