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

for non-win32 systems, now setting al register to a count of the

Browse Source 
floating-point register arguments as required for varargs functions
by the System V ABI.
  x86_64.ss,
  foreign.ms
remade boot files

original commit: c5b6fe968f890bbef3488d570756cbe8da211326
This commit is contained in:
dybvig 2017-03-05 17:20:26 -05:00
parent 29351926fa
commit cb0a915f73
3 changed files with 69 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
LOG
View File

@ -345,3 +345,8 @@
fasl.c, gc.c, globals.h, prim.c, prim5.c, scheme.c, schsig.c,
misc.ms, root-experr*,
objects.stex
- for non-win32 systems, now setting al register to a count of the
floating-point register arguments as required for varargs functions
by the System V ABI.
x86_64.ss,
foreign.ms

56
mats/foreign.ms
View File

@ -2577,3 +2577,59 @@
(equal? s3 "#<procedure abort>")
(eqv? pid^ pid)))))))
)
(mat varargs
(begin
(define load-libc
(machine-case
[(i3ob ti3ob a6ob ta6ob i3fb ti3fb a6fb ta6fb a6s2 ta6s2 i3s2 ti3s2 i3qnx ti3qnx i3nb ti3nb a6nb ta6nb)
'(load-shared-object "libc.so")]
[(i3le ti3le a6le ta6le arm32le tarm32le ppc32le tppc32le)
'(load-shared-object "libc.so.6")]
[(i3nt ti3nt a6nt ta6nt)
(load-shared-object "msvcrt.dll")]
[(i3osx ti3osx a6osx ta6osx)
'(load-shared-object "libc.dylib")]
[else (error 'load-libc "unrecognized machine type ~s" (machine-type))]))
#t)
(equal?
(with-input-from-string
(separate-eval
`(begin
,load-libc
(define f (foreign-procedure "printf" (string double) int))
(f "(%g)" 3.5)
(void)))
read)
'(3.5))
(equal?
(with-input-from-string
(separate-eval
`(begin
,load-libc
(define f (foreign-procedure "printf" (string double double double double double double) int))
(f "(%g %g %g %g %g %g)" 3.5 2.5 -1.5 6.75 8.25 -9.5)
(void)))
read)
'(3.5 2.5 -1.5 6.75 8.25 -9.5))
(equal?
(with-input-from-string
(separate-eval
`(begin
,load-libc
(define f (foreign-procedure "printf" (string double double double double double double double double) int))
(f "(%g %g %g %g %g %g %g %g)" 3.5 2.5 -1.5 6.75 8.25 -9.5 1e32 -4.5)
(void)))
read)
'(3.5 2.5 -1.5 6.75 8.25 -9.5 1e32 -4.5))
(equal?
(with-input-from-string
(separate-eval
`(begin
,load-libc
(define f (foreign-procedure "printf" (string double double double double double double double double double double) int))
(f "(%g %g %g %g %g %g %g %g %g %g)" 3.5 2.5 -1.5 6.75 8.25 -9.5 1e32 -4.5 7.25 -0.5)
(void)))
read)
'(3.5 2.5 -1.5 6.75 8.25 -9.5 1e32 -4.5 7.25 -0.5))
)

12
s/x86_64.ss
View File

@ -2441,7 +2441,7 @@
(if-feature windows
(let loop ([types types] [locs '()] [regs '()] [i 0] [isp 0])
(if (null? types)
(values isp locs regs)
(values isp 0 locs regs)
(nanopass-case (Ltype Type) (car types)
[(fp-double-float)
(if (< i 4)
@ -2471,7 +2471,7 @@
regs i (fx+ isp 8)))])))
(let loop ([types types] [locs '()] [regs '()] [iint 0] [ifp 0] [isp 0])
(if (null? types)
(values isp locs regs)
(values isp ifp locs regs)
(nanopass-case (Ltype Type) (car types)
[(fp-double-float)
(if (< ifp 8)
@ -2522,7 +2522,7 @@
[arg-type* (info-foreign-arg-type* info)]
[result-type (info-foreign-result-type info)])
(with-values (do-args arg-type* (make-vint) (make-vfp))
(lambda (frame-size locs live*)
(lambda (frame-size nfp locs live*)
(returnem frame-size locs
(lambda (t0)
(if-feature windows
@ -2530,7 +2530,11 @@
(set! ,%sp ,(%inline - ,%sp (immediate 32)))
(inline ,(make-info-kill*-live* (reg-list %rax) live*) ,%c-call ,t0)
(set! ,%sp ,(%inline + ,%sp (immediate 32))))
`(inline ,(make-info-kill*-live* (reg-list %rax) live*) ,%c-call ,t0)))
(%seq
; System V ABI varargs functions require count of fp regs used in %al register.
; since we don't know if the callee is a varargs function, we always set it.
(set! ,%rax (immediate ,nfp))
(inline ,(make-info-kill*-live* (reg-list %rax) (cons %rax live*)) ,%c-call ,t0))))
(nanopass-case (Ltype Type) result-type
[(fp-double-float)
(lambda (lvalue)