diff --git a/pkgs/compiler-lib/compiler/decompile.rkt b/pkgs/compiler-lib/compiler/decompile.rkt index a1bd8049da..f831970442 100644 --- a/pkgs/compiler-lib/compiler/decompile.rkt +++ b/pkgs/compiler-lib/compiler/decompile.rkt @@ -248,22 +248,18 @@ [(? linklet?) (case (system-type 'vm) [(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 [code - (define uncompressed-code - (if (regexp-match? #rx#"^\0\0\0\0chez" code) - code - (vm-eval `(bytevector-uncompress ,code)))) (case fmt [(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)))]) (if (null? args) proc (cons proc (map (vm-primitive 'force-unfasl) args))))] [(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)))] [else '(....)])] diff --git a/racket/src/ChezScheme/s/a6.def b/racket/src/ChezScheme/s/a6.def index 142c4e61ef..2b8fb74073 100644 --- a/racket/src/ChezScheme/s/a6.def +++ b/racket/src/ChezScheme/s/a6.def @@ -3,7 +3,7 @@ (define-constant asm-arg-reg-max 5) (define-constant asm-arg-reg-cnt 3) -(define-constant asm-fpreg-max 2) +(define-constant asm-fpreg-max 8) (define-constant native-endianness 'little) diff --git a/racket/src/ChezScheme/s/print.ss b/racket/src/ChezScheme/s/print.ss index 19bf1f2d74..ffa5f50f68 100644 --- a/racket/src/ChezScheme/s/print.ss +++ b/racket/src/ChezScheme/s/print.ss @@ -756,7 +756,8 @@ floating point returns with (1 0 -1 ...). (and (code-info? info) (code-info-src info))) => (lambda (src) (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) (format "~a.~a" (source-2d-line src) (source-2d-column src)) (source-bfp src))))]))) diff --git a/racket/src/ChezScheme/s/x86_64.ss b/racket/src/ChezScheme/s/x86_64.ss index 19e0f9de9f..17d517ef0c 100644 --- a/racket/src/ChezScheme/s/x86_64.ss +++ b/racket/src/ChezScheme/s/x86_64.ss @@ -37,7 +37,13 @@ [ %r9 %Carg4 #f 9 uptr] [ %rcx %Carg1 #f 1 uptr] ; last to avoid use as a Scheme argument [%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 [%Cfparg1 %Cfpretval #f 0 fp] ; xmm 0-5 are caller-save [%Cfparg2 #f 1 fp] ; xmm 6-15 are callee-save @@ -66,9 +72,15 @@ [ %rdx %Carg3 #f 2 uptr] [ %rcx %Carg4 #f 1 uptr] [%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 - [%Cfparg1 %Cfpretval #f 0 fp] + [%Cfparg1 %Cfpretval #f 0 fp] ; no FP registers are callee-save [%Cfparg2 #f 1 fp] [%Cfparg3 #f 2 fp] [%Cfparg4 #f 3 fp] @@ -2961,15 +2973,15 @@ +---------------------------+ <- 16-byte boundary | | | space for register args | four quads - sp+80/96: | | + sp+128/144: | | +---------------------------+ <- 16-byte boundary | incoming return address | one quad 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) - | | + | | and XMM6-11 (6 quads) +---------------------------+ | pad word / indirect space | one quad sp+0: +---------------------------+<- 16-byte boundary @@ -3146,7 +3158,7 @@ ; risp is where incoming register args are stored ; sisp is where incoming stack args are stored (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) locs (f (cdr types) @@ -3256,7 +3268,7 @@ [else (values (lambda () ;; 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) '())])] [(fp-double-float) @@ -3282,7 +3294,7 @@ '())])) (define (unactivate result-regs) (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)))]) (if (null? result-regs) e @@ -3319,6 +3331,13 @@ ,(%inline push ,%r13) ,(%inline push ,%r14) ,(%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)))) (%seq (set! ,%sp ,(%inline - ,%sp (immediate 136))) @@ -3334,7 +3353,7 @@ (if adjust-active? (%seq ,(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)) (%seq @@ -3350,7 +3369,8 @@ (lambda () (define callee-save-regs (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))) (in-context Tail ((lambda (e) @@ -3367,6 +3387,13 @@ e)) (%seq (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! ,%r14 ,(%inline pop)) (set! ,%r13 ,(%inline pop)) diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index d2f31540bb..ab2352bb21 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -755,8 +755,8 @@ (raise-argument-error 'linklet-fasled-code+arguments "linklet?" linklet)) (case (linklet-preparation linklet) [(faslable faslable-strict faslable-unsafe lazy) - (values (linklet-format linklet) (linklet-code linklet) (linklet-paths linklet))] - [else (values #f #f #f)])) + (values (linklet-format linklet) (linklet-code linklet) (linklet-sfd-paths linklet) (linklet-paths linklet))] + [else (values #f #f #f #f)])) (define (linklet-interpret-jitified? v) (wrapped-code? v))