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

Chez Scheme: increase FP registers for x86_64

Browse Source
This commit is contained in:
Matthew Flatt 2020-08-04 15:24:02 -06:00
parent 2b73b20704
commit 29a6ca6737
5 changed files with 46 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/compiler-lib/compiler/decompile.rkt
View File

@ -248,22 +248,18 @@
[(? linklet?) [(? linklet?)
(case (system-type 'vm) (case (system-type 'vm)
[(chez-scheme) [(chez-scheme)
(define-values (fmt code args) ((vm-primitive 'linklet-fasled-code+arguments) l)) (define-values (fmt code sfd-paths args) ((vm-primitive 'linklet-fasled-code+arguments) l))
(cond (cond
[code [code
(define uncompressed-code
(if (regexp-match? #rx#"^\0\0\0\0chez" code)
code
(vm-eval `(bytevector-uncompress ,code))))
(case fmt (case fmt
[(compile) [(compile)
(define proc ((vm-eval `(load-compiled-from-port (open-bytevector-input-port ,uncompressed-code))))) (define proc ((vm-eval `(load-compiled-from-port (open-bytevector-input-port ,code) ',sfd-paths))))
(let ([proc (decompile-chez-procedure (if (null? args) proc (apply proc args)))]) (let ([proc (decompile-chez-procedure (if (null? args) proc (apply proc args)))])
(if (null? args) (if (null? args)
proc proc
(cons proc (map (vm-primitive 'force-unfasl) args))))] (cons proc (map (vm-primitive 'force-unfasl) args))))]
[(interpret) [(interpret)
(define bytecode (vm-eval `(fasl-read (open-bytevector-input-port ,uncompressed-code)))) (define bytecode (vm-eval `(fasl-read (open-bytevector-input-port ,code) 'load ',sfd-paths)))
(list `(#%interpret ,(unwrap-chez-interpret-jitified bytecode)))] (list `(#%interpret ,(unwrap-chez-interpret-jitified bytecode)))]
[else [else
'(....)])] '(....)])]

2
racket/src/ChezScheme/s/a6.def
View File

@ -3,7 +3,7 @@
(define-constant asm-arg-reg-max 5) (define-constant asm-arg-reg-max 5)
(define-constant asm-arg-reg-cnt 3) (define-constant asm-arg-reg-cnt 3)
(define-constant asm-fpreg-max 2) (define-constant asm-fpreg-max 8)
(define-constant native-endianness 'little) (define-constant native-endianness 'little)

3
racket/src/ChezScheme/s/print.ss
View File

@ -756,7 +756,8 @@ floating point returns with (1 0 -1 ...).
(and (code-info? info) (code-info-src info))) => (and (code-info? info) (code-info-src info))) =>
(lambda (src) (lambda (src)
(fprintf p " at ~a:~a" (fprintf p " at ~a:~a"
(path-last (source-file-descriptor-name (source-sfd src))) (let ([fn (source-file-descriptor-name (source-sfd src))])
(if (string? fn) (path-last fn) fn))
(if (source-2d? src) (if (source-2d? src)
(format "~a.~a" (source-2d-line src) (source-2d-column src)) (format "~a.~a" (source-2d-line src) (source-2d-column src))
(source-bfp src))))]))) (source-bfp src))))])))

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

@ -37,7 +37,13 @@
[ %r9 %Carg4 #f 9 uptr] [ %r9 %Carg4 #f 9 uptr]
[ %rcx %Carg1 #f 1 uptr] ; last to avoid use as a Scheme argument [ %rcx %Carg1 #f 1 uptr] ; last to avoid use as a Scheme argument
[%fp1 #f 4 fp] [%fp1 #f 4 fp]
[%fp2 #f 5 fp]) [%fp2 #f 5 fp]
[%fp3 #t 6 fp]
[%fp4 #t 7 fp]
[%fp5 #t 8 fp]
[%fp6 #t 9 fp]
[%fp7 #t 10 fp]
[%fp8 #t 11 fp])
(machine-dependent (machine-dependent
[%Cfparg1 %Cfpretval #f 0 fp] ; xmm 0-5 are caller-save [%Cfparg1 %Cfpretval #f 0 fp] ; xmm 0-5 are caller-save
[%Cfparg2 #f 1 fp] ; xmm 6-15 are callee-save [%Cfparg2 #f 1 fp] ; xmm 6-15 are callee-save
@ -66,9 +72,15 @@
[ %rdx %Carg3 #f 2 uptr] [ %rdx %Carg3 #f 2 uptr]
[ %rcx %Carg4 #f 1 uptr] [ %rcx %Carg4 #f 1 uptr]
[%fp1 #f 8 fp] [%fp1 #f 8 fp]
[%fp2 #f 9 fp]) [%fp2 #f 9 fp]
[%fp3 #f 10 fp]
[%fp4 #f 11 fp]
[%fp5 #f 12 fp]
[%fp6 #f 13 fp]
[%fp7 #f 14 fp]
[%fp8 #f 15 fp])
(machine-dependent (machine-dependent
[%Cfparg1 %Cfpretval #f 0 fp] [%Cfparg1 %Cfpretval #f 0 fp] ; no FP registers are callee-save
[%Cfparg2 #f 1 fp] [%Cfparg2 #f 1 fp]
[%Cfparg3 #f 2 fp] [%Cfparg3 #f 2 fp]
[%Cfparg4 #f 3 fp] [%Cfparg4 #f 3 fp]
@ -2961,15 +2973,15 @@
+---------------------------+ <- 16-byte boundary +---------------------------+ <- 16-byte boundary
| | | |
| space for register args | four quads | space for register args | four quads
sp+80/96: | | sp+128/144: | |
+---------------------------+ <- 16-byte boundary +---------------------------+ <- 16-byte boundary
| incoming return address | one quad | incoming return address | one quad
incoming sp: +---------------------------+ incoming sp: +---------------------------+
sp+72: | active state | zero or two quads sp+120: | active state | zero or two quads
+---------------------------+ +---------------------------+
| | | |
| callee-save registers | RBX, RBP, RDI, RSI, R12, R13, R14, R15 (8 quads) | callee-save registers | RBX, RBP, RDI, RSI, R12, R13, R14, R15 (8 quads)
| | | | and XMM6-11 (6 quads)
+---------------------------+ +---------------------------+
| pad word / indirect space | one quad | pad word / indirect space | one quad
sp+0: +---------------------------+<- 16-byte boundary sp+0: +---------------------------+<- 16-byte boundary
@ -3146,7 +3158,7 @@
; risp is where incoming register args are stored ; risp is where incoming register args are stored
; sisp is where incoming stack args are stored ; sisp is where incoming stack args are stored
(if-feature windows (if-feature windows
(let f ([types types] [locs '()] [isp (if adjust-active? 96 80)]) (let f ([types types] [locs '()] [isp (if adjust-active? 144 128)])
(if (null? types) (if (null? types)
locs locs
(f (cdr types) (f (cdr types)
@ -3256,7 +3268,7 @@
[else [else
(values (lambda () (values (lambda ()
;; Return pointer that was filled; destination was the first argument ;; Return pointer that was filled; destination was the first argument
`(set! ,%Cretval ,(%mref ,%sp ,(if-feature windows (if adjust-active? 96 80) 48)))) `(set! ,%Cretval ,(%mref ,%sp ,(if-feature windows (if adjust-active? 144 128) 48))))
(list %Cretval) (list %Cretval)
'())])] '())])]
[(fp-double-float) [(fp-double-float)
@ -3282,7 +3294,7 @@
'())])) '())]))
(define (unactivate result-regs) (define (unactivate result-regs)
(let ([e `(seq (let ([e `(seq
(set! ,%Carg1 ,(%mref ,%sp ,(+ (push-registers-size result-regs) (if-feature windows 72 176)))) (set! ,%Carg1 ,(%mref ,%sp ,(+ (push-registers-size result-regs) (if-feature windows 120 176))))
,(as-c-call (%inline unactivate-thread ,%Carg1)))]) ,(as-c-call (%inline unactivate-thread ,%Carg1)))])
(if (null? result-regs) (if (null? result-regs)
e e
@ -3319,6 +3331,13 @@
,(%inline push ,%r13) ,(%inline push ,%r13)
,(%inline push ,%r14) ,(%inline push ,%r14)
,(%inline push ,%r15) ,(%inline push ,%r15)
(set! ,%sp ,(%inline - ,%sp (immediate 48)))
(set! ,(%mref ,%sp ,%zero 0 fp) ,%fp3)
(set! ,(%mref ,%sp ,%zero 8 fp) ,%fp4)
(set! ,(%mref ,%sp ,%zero 16 fp) ,%fp5)
(set! ,(%mref ,%sp ,%zero 24 fp) ,%fp6)
(set! ,(%mref ,%sp ,%zero 32 fp) ,%fp7)
(set! ,(%mref ,%sp ,%zero 40 fp) ,%fp8)
(set! ,%sp ,(%inline - ,%sp (immediate 8)))) (set! ,%sp ,(%inline - ,%sp (immediate 8))))
(%seq (%seq
(set! ,%sp ,(%inline - ,%sp (immediate 136))) (set! ,%sp ,(%inline - ,%sp (immediate 136)))
@ -3334,7 +3353,7 @@
(if adjust-active? (if adjust-active?
(%seq (%seq
,(as-c-call `(set! ,%rax ,(%inline activate-thread))) ,(as-c-call `(set! ,%rax ,(%inline activate-thread)))
(set! ,(%mref ,%sp ,(if-feature windows 72 176)) ,%rax) (set! ,(%mref ,%sp ,(if-feature windows 120 176)) ,%rax)
,e) ,e)
e)) e))
(%seq (%seq
@ -3350,7 +3369,8 @@
(lambda () (lambda ()
(define callee-save-regs (define callee-save-regs
(if-feature windows (if-feature windows
(list %rbx %rbp %rdi %rsi %r12 %r13 %r14 %r15) (list %rbx %rbp %rdi %rsi %r12 %r13 %r14 %r15
%fp3 %fp4 %fp5 %fp6 %fp7 %fp8)
(list %rbx %rbp %r12 %r13 %r14 %r15))) (list %rbx %rbp %r12 %r13 %r14 %r15)))
(in-context Tail (in-context Tail
((lambda (e) ((lambda (e)
@ -3367,6 +3387,13 @@
e)) e))
(%seq (%seq
(set! ,%sp ,(%inline + ,%sp (immediate 8))) (set! ,%sp ,(%inline + ,%sp (immediate 8)))
(set! ,%fp3 ,(%mref ,%sp ,%zero 0 fp))
(set! ,%fp4 ,(%mref ,%sp ,%zero 8 fp))
(set! ,%fp5 ,(%mref ,%sp ,%zero 16 fp))
(set! ,%fp6 ,(%mref ,%sp ,%zero 24 fp))
(set! ,%fp7 ,(%mref ,%sp ,%zero 32 fp))
(set! ,%fp8 ,(%mref ,%sp ,%zero 40 fp))
(set! ,%sp ,(%inline + ,%sp (immediate 48)))
(set! ,%r15 ,(%inline pop)) (set! ,%r15 ,(%inline pop))
(set! ,%r14 ,(%inline pop)) (set! ,%r14 ,(%inline pop))
(set! ,%r13 ,(%inline pop)) (set! ,%r13 ,(%inline pop))

4
racket/src/cs/linklet.sls
View File

@ -755,8 +755,8 @@
(raise-argument-error 'linklet-fasled-code+arguments "linklet?" linklet)) (raise-argument-error 'linklet-fasled-code+arguments "linklet?" linklet))
(case (linklet-preparation linklet) (case (linklet-preparation linklet)
[(faslable faslable-strict faslable-unsafe lazy) [(faslable faslable-strict faslable-unsafe lazy)
(values (linklet-format linklet) (linklet-code linklet) (linklet-paths linklet))] (values (linklet-format linklet) (linklet-code linklet) (linklet-sfd-paths linklet) (linklet-paths linklet))]
[else (values #f #f #f)])) [else (values #f #f #f #f)]))
(define (linklet-interpret-jitified? v) (define (linklet-interpret-jitified? v)
(wrapped-code? v)) (wrapped-code? v))