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

repairs for arm32le

Browse Source 
Includes a repair by @cjfrisz at cisco/ChezScheme#510

original commit: e7ee15332bd8f0e5f0887cff9f6ee45b8b38a4f1
This commit is contained in:
Matthew Flatt 2020-06-04 15:00:22 -06:00
parent c103184272
commit d2069742ee
5 changed files with 75 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
s/arm32.ss
View File

@ -77,8 +77,8 @@
#;[%yp] #;[%yp]
[ %r0 %Carg1 %Cretval #f 0 uptr] [ %r0 %Carg1 %Cretval #f 0 uptr]
[ %r1 %Carg2 #f 1 uptr] [ %r1 %Carg2 #f 1 uptr]
[ %r2 %Carg3 #f 2 uptr] [ %r2 %Carg3 %reify1 #f 2 uptr]
[ %r3 %Carg4 #f 3 uptr] [ %r3 %Carg4 %reify2 #f 3 uptr]
[ %lr #f 14 uptr] ; %lr is trashed by 'c' calls including calls to hand-coded routines like get-room [ %lr #f 14 uptr] ; %lr is trashed by 'c' calls including calls to hand-coded routines like get-room
[%fp1 %Cfparg5 %d4 %s8 #f 8 fp] [%fp1 %Cfparg5 %d4 %s8 #f 8 fp]
[%fp2 %Cfparg6 %d5 %s10 #f 10 fp] [%fp2 %Cfparg6 %d5 %s10 #f 10 fp]
@ -104,8 +104,7 @@
#;[ %d16 #t 32 fp] ; >= 32: high bit goes in D, N, or M bit, low bits go in Vd, Vn, Vm #;[ %d16 #t 32 fp] ; >= 32: high bit goes in D, N, or M bit, low bits go in Vd, Vn, Vm
#;[ %d17 #t 33 fp] #;[ %d17 #t 33 fp]
; etc. ; etc.
) ))
(reify-support %ts %lr %r3 %r2))
;;; SECTION 2: instructions ;;; SECTION 2: instructions
(module (md-handle-jump) ; also sets primitive handlers (module (md-handle-jump) ; also sets primitive handlers
@ -230,20 +229,18 @@
(cond (cond
[(and (eq? x1 %zero) (or (unsigned12? imm) (unsigned12? (- imm)))) [(and (eq? x1 %zero) (or (unsigned12? imm) (unsigned12? (- imm))))
(return x0 %zero imm type)] (return x0 %zero imm type)]
[(funky12 imm) => [(funky12 imm)
; NB: dubious value? check to see if it's exercised ; NB: dubious value? check to see if it's exercised
(lambda (imm) (let ([u (make-tmp 'u)])
(let ([u (make-tmp 'u)]) (seq
(seq (build-set! ,u (asm ,null-info ,(asm-add #f) ,x0 (immediate ,imm)))
(build-set! ,u (asm ,null-info ,(asm-add #f) ,x0 (immediate ,imm))) (return u x1 0 type)))]
(return u x1 0 type))))] [(funky12 (- imm))
[(funky12 (- imm)) =>
; NB: dubious value? check to see if it's exercised ; NB: dubious value? check to see if it's exercised
(lambda (imm) (let ([u (make-tmp 'u)])
(let ([u (make-tmp 'u)]) (seq
(seq (build-set! ,u (asm ,null-info ,(asm-sub #f) ,x0 (immediate ,(- imm))))
(build-set! ,u (asm ,null-info ,(asm-sub #f) ,x0 (immediate ,imm))) (return u x1 0 type)))]
(return u x1 0 type))))]
[else [else
(let ([u (make-tmp 'u)]) (let ([u (make-tmp 'u)])
(seq (seq
@ -1485,7 +1482,7 @@
(define vmov.gpr-op (define vmov.gpr-op
(lambda (op dir flreg flreg-delta gpreg code*) (lambda (op dir flreg flreg-delta gpreg code*)
(let-values ([(n vn) (ax-flreg->bits flreg flreg-delta)]) (let-values ([(n vn) (ax-flreg->bits flreg flreg-delta)])
(emit-code (op flreg gpreg code*) (emit-code (op flreg gpreg flreg-delta code*)
[28 (ax-cond 'al)] [28 (ax-cond 'al)]
[21 #b1110000] [21 #b1110000]
[20 dir] [20 dir]
@ -2071,7 +2068,7 @@
(lambda (code* dest src) (lambda (code* dest src)
(Trivit (src) (Trivit (src)
(emit vmov.gpr->s32 %fptmp1 0 src (emit vmov.gpr->s32 %fptmp1 0 src
(emit vcvt.s32->dbl %fptmp1 dest code*))))) (emit vcvt.s32->dbl dest %fptmp1 code*)))))
(define-who asm-fpmove (define-who asm-fpmove
;; fpmove pseudo instruction is used by set! case in ;; fpmove pseudo instruction is used by set! case in
@ -2099,8 +2096,8 @@
(lambda (code* dest src) (lambda (code* dest src)
(Trivit (dest) (Trivit (dest)
(if (eq? part 'lo) (if (eq? part 'lo)
(emit vmov.gpr->s32 src 0 dest code*) (emit vmov.s32->gpr src 0 dest code*)
(emit vmov.gpr->s32 src 1 dest code*)))))) (emit vmov.s32->gpr src 1 dest code*))))))
(define asm-fpcastfrom (define asm-fpcastfrom
(lambda (code* dest lo-src hi-src) (lambda (code* dest lo-src hi-src)
@ -2271,7 +2268,8 @@
(define asm-direct-jump (define asm-direct-jump
(lambda (l offset) (lambda (l offset)
(asm-helper-jump '() (make-funcrel 'arm32-jump l offset)))) (let ([offset (adjust-return-point-offset offset l)])
(asm-helper-jump '() (make-funcrel 'arm32-jump l offset)))))
(define asm-literal-jump (define asm-literal-jump
(lambda (info) (lambda (info)
@ -2313,17 +2311,18 @@
(or (cond (or (cond
[(local-label-offset l) => [(local-label-offset l) =>
(lambda (offset) (lambda (offset)
(let ([disp (fx- next-addr (fx- offset incr-offset) 4)]) (let ([incr-offset (adjust-return-point-offset incr-offset l)])
(cond (let ([disp (fx- next-addr (fx- offset incr-offset) 4)])
[(funky12 disp) (cond
(Trivit (dest) [(funky12 disp)
; aka adr, encoding A1 (Trivit (dest)
(emit addi #f dest `(reg . ,%pc) disp '()))] ; aka adr, encoding A1
[(funky12 (- disp)) (emit addi #f dest `(reg . ,%pc) disp '()))]
(Trivit (dest) [(funky12 (- disp))
; aka adr, encoding A2 (Trivit (dest)
(emit subi #f dest `(reg . ,%pc) (- disp) '()))] ; aka adr, encoding A2
[else #f])))] (emit subi #f dest `(reg . ,%pc) (- disp) '()))]
[else #f]))))]
[else #f]) [else #f])
(asm-move '() dest (with-output-language (L16 Triv) `(label-ref ,l ,incr-offset))))))) (asm-move '() dest (with-output-language (L16 Triv) `(label-ref ,l ,incr-offset)))))))
@ -3179,8 +3178,11 @@
8)] 8)]
[else [else
(values (lambda () (values (lambda ()
`(set! ,%Cretval ,(%mref ,%sp ,return-stack-offset))) (case ($ftd-size ftd)
(list %Cretval %r1) [(1) `(set! ,%Cretval (inline ,(make-info-load 'integer-8 #f) ,%load ,%sp ,%zero (immediate ,return-stack-offset)))]
[(2) `(set! ,%Cretval (inline ,(make-info-load 'integer-16 #f) ,%load ,%sp ,%zero (immediate ,return-stack-offset)))]
[else `(set! ,%Cretval ,(%mref ,%sp ,return-stack-offset))]))
(list %Cretval)
4)])]))] 4)])]))]
[(fp-double-float) [(fp-double-float)
(values (lambda (rhs) (values (lambda (rhs)
@ -3213,7 +3215,7 @@
[else [else
(values (lambda (x) (values (lambda (x)
`(set! ,%Cretval ,x)) `(set! ,%Cretval ,x))
(list %Cretval %r1) (list %Cretval)
0)])]))) 0)])])))
(lambda (info) (lambda (info)
(define callee-save-regs+lr (list %r4 %r5 %r6 %r7 %r8 %r9 %r10 %r11 %lr)) (define callee-save-regs+lr (list %r4 %r5 %r6 %r7 %r8 %r9 %r10 %r11 %lr))

43
s/cpnanopass.ss
View File

@ -599,18 +599,13 @@
(syntax-case x (reserved allocable machine-dependent) (syntax-case x (reserved allocable machine-dependent)
[(k (reserved [rreg rreg-alias ... rreg-callee-save? rreg-mdinfo rreg-type] ...) [(k (reserved [rreg rreg-alias ... rreg-callee-save? rreg-mdinfo rreg-type] ...)
(allocable [areg areg-alias ... areg-callee-save? areg-mdinfo areg-type] ...) (allocable [areg areg-alias ... areg-callee-save? areg-mdinfo areg-type] ...)
(machine-depdendent [mdreg mdreg-alias ... mdreg-callee-save? mdreg-mdinfo mdreg-type] ...) (machine-depdendent [mdreg mdreg-alias ... mdreg-callee-save? mdreg-mdinfo mdreg-type] ...))
(reify-support reify-reg ...)) (with-implicit (k regvec arg-registers extra-registers extra-fpregisters real-register? with-initialized-registers)
(with-implicit (k regvec arg-registers extra-registers extra-fpregisters real-register?
cons-reify-registers with-initialized-registers)
#`(begin #`(begin
(define-reserved-registers [rreg rreg-alias ... rreg-callee-save? rreg-mdinfo rreg-type] ...) (define-reserved-registers [rreg rreg-alias ... rreg-callee-save? rreg-mdinfo rreg-type] ...)
(define-allocable-registers regvec arg-registers extra-registers extra-fpregisters with-initialized-registers (define-allocable-registers regvec arg-registers extra-registers extra-fpregisters with-initialized-registers
[areg areg-alias ... areg-callee-save? areg-mdinfo areg-type] ...) [areg areg-alias ... areg-callee-save? areg-mdinfo areg-type] ...)
(define-machine-dependent-registers [mdreg mdreg-alias ... mdreg-callee-save? mdreg-mdinfo mdreg-type] ...) (define-machine-dependent-registers [mdreg mdreg-alias ... mdreg-callee-save? mdreg-mdinfo mdreg-type] ...)
(define-syntax cons-reify-registers
(syntax-rules ()
[(_ reg*) (cons* reify-reg ... reg*)]))
(define-syntax real-register? (define-syntax real-register?
(with-syntax ([real-reg* #''(rreg ... rreg-alias ... ... areg ... areg-alias ... ... mdreg ... mdreg-alias ... ...)]) (with-syntax ([real-reg* #''(rreg ... rreg-alias ... ... areg ... areg-alias ... ... mdreg ... mdreg-alias ... ...)])
(syntax-rules () (syntax-rules ()
@ -709,8 +704,6 @@
(fold-right (fold-right
(lambda (reg reg*) (lambda (reg reg*)
(cond (cond
[(eq? (syntax->datum reg) 'reify-support)
#`(cons-reify-registers #,reg*)]
[(real-register? (syntax->datum reg)) [(real-register? (syntax->datum reg))
#`(cons #,reg #,reg*)] #`(cons #,reg #,reg*)]
[else reg*])) [else reg*]))
@ -976,8 +969,8 @@
(declare-intrinsic dofretu32* dofretu32* (%ac0 %ts %td %cp %ac1) (%ac0) (%xp)) (declare-intrinsic dofretu32* dofretu32* (%ac0 %ts %td %cp %ac1) (%ac0) (%xp))
(declare-intrinsic get-room get-room () (%xp) (%xp)) (declare-intrinsic get-room get-room () (%xp) (%xp))
(declare-intrinsic scan-remembered-set scan-remembered-set () () ()) (declare-intrinsic scan-remembered-set scan-remembered-set () () ())
(declare-intrinsic reify-1cc reify-1cc (%xp %ac0 reify-support) () (%td)) (declare-intrinsic reify-1cc reify-1cc (%xp %ac0 %ts %reify1 %reify2) () (%td)) ; %reify1 & %reify2 are defined as needed per machine...
(declare-intrinsic maybe-reify-cc maybe-reify-cc (%xp %ac0 reify-support) () (%td)) (declare-intrinsic maybe-reify-cc maybe-reify-cc (%xp %ac0 %ts %reify1 %reify2) () (%td)) ; ... to have enough registers to allocate
(declare-intrinsic dooverflow dooverflow () () ()) (declare-intrinsic dooverflow dooverflow () () ())
(declare-intrinsic dooverflood dooverflood () (%xp) ()) (declare-intrinsic dooverflood dooverflood () (%xp) ())
; a dorest routine takes all of the register and frame arguments from the rest ; a dorest routine takes all of the register and frame arguments from the rest
@ -12546,7 +12539,7 @@
(set! ,fv0 ,%xp) (set! ,fv0 ,%xp)
,(%mv-jump ,%xp (,%ac0 ,arg-registers ... ,fv0))))])))))))))))) ,(%mv-jump ,%xp (,%ac0 ,arg-registers ... ,fv0))))]))))))))))))
(define reify-cc-help (define reify-cc-help
(lambda (1-shot? always? finish) (lambda (1-shot? always? save-ra? finish)
(with-output-language (L13 Tail) (with-output-language (L13 Tail)
(%seq (%seq
(set! ,%td ,(%tc-ref stack-link)) (set! ,%td ,(%tc-ref stack-link))
@ -12555,7 +12548,7 @@
(%seq (%seq
,(let ([alloc ,(let ([alloc
(%seq (%seq
(set! ,%xp ,(%constant-alloc type-closure (constant size-continuation))) (set! ,%xp ,(%constant-alloc type-closure (constant size-continuation) #f save-ra?))
(set! ,(%mref ,%xp ,(constant continuation-code-disp)) (set! ,(%mref ,%xp ,(constant continuation-code-disp))
(literal ,(make-info-literal #f 'library (lookup-libspec nuate) (constant code-data-disp)))))]) (literal ,(make-info-literal #f 'library (lookup-libspec nuate) (constant code-data-disp)))))])
(if 1-shot? (if 1-shot?
@ -12697,28 +12690,25 @@
[(dorest4) (make-do-rest 4 frame-args-offset)] [(dorest4) (make-do-rest 4 frame-args-offset)]
[(dorest5) (make-do-rest 5 frame-args-offset)] [(dorest5) (make-do-rest 5 frame-args-offset)]
[(reify-1cc maybe-reify-cc) [(reify-1cc maybe-reify-cc)
(let ([other-reg* (fold-left (lambda (live* kill) (remq kill live*)) (let ([1cc? (eq? sym 'reify-1cc)])
(vector->list regvec)
;; Registers used by `reify-cc-help` output,
;; including some as needed per machine
(reg-list %xp %td %ac0 reify-support))]
[1cc? (eq? sym 'reify-1cc)])
`(lambda ,(make-named-info-lambda (if 1cc? "reify-1cc" "maybe-reify-cc") '(0)) 0 () `(lambda ,(make-named-info-lambda (if 1cc? "reify-1cc" "maybe-reify-cc") '(0)) 0 ()
,(asm-enter ,(asm-enter
(%seq (%seq
(check-live ,other-reg* ...) ;; make sure the reify-1cc intrinsic declares kill for registers used by `reify-cc-help`,
,(reify-cc-help 1cc? 1cc? ;; plus (say) %ts to have one to allocate, plus more as needed to allocate per machine
(check-live ,(intrinsic-entry-live* reify-1cc) ...)
,(reify-cc-help 1cc? 1cc? #t
(lambda (reg) (lambda (reg)
(if (eq? reg %td) (if (eq? reg %td)
`(asm-return ,%td ,other-reg* ...) `(asm-return ,%td ,(intrinsic-return-live* reify-1cc) ...)
`(seq `(seq
(set! ,%td ,reg) (set! ,%td ,reg)
(asm-return ,%td ,other-reg* ...)))))))))] (asm-return ,%td ,(intrinsic-return-live* reify-1cc) ...)))))))))]
[(callcc) [(callcc)
`(lambda ,(make-named-info-lambda 'callcc '(1)) 0 () `(lambda ,(make-named-info-lambda 'callcc '(1)) 0 ()
,(%seq ,(%seq
(set! ,(ref-reg %cp) ,(make-arg-opnd 1)) (set! ,(ref-reg %cp) ,(make-arg-opnd 1))
,(reify-cc-help #f #f ,(reify-cc-help #f #f #f
(lambda (reg) (lambda (reg)
(%seq (%seq
(set! ,(make-arg-opnd 1) ,reg) (set! ,(make-arg-opnd 1) ,reg)
@ -15716,7 +15706,7 @@
[(asm-return) (values (asm-return) chunk* offset)] [(asm-return) (values (asm-return) chunk* offset)]
[(asm-c-return ,info) (values (asm-c-return info) chunk* offset)] [(asm-c-return ,info) (values (asm-c-return info) chunk* offset)]
[(jump (label-ref ,l ,offset0)) [(jump (label-ref ,l ,offset0))
(values (asm-direct-jump l (adjust-return-point-offset offset0 l)) chunk* offset)] (values (asm-direct-jump l offset0) chunk* offset)]
[(jump (literal ,info)) [(jump (literal ,info))
(values (asm-literal-jump info) chunk* offset)] (values (asm-literal-jump info) chunk* offset)]
[(jump ,t) [(jump ,t)
@ -15799,8 +15789,7 @@
[(rp-compact-header ,error-on-values ,fs ,lpm) (values (asm-rp-compact-header code* error-on-values fs lpm current-func #f) chunk* offset)] [(rp-compact-header ,error-on-values ,fs ,lpm) (values (asm-rp-compact-header code* error-on-values fs lpm current-func #f) chunk* offset)]
[(set! ,x (label-ref ,l ,offset1)) [(set! ,x (label-ref ,l ,offset1))
(guard (eq? (local-label-func l) current-func)) (guard (eq? (local-label-func l) current-func))
(let ([chunk (make-chunk code*)] (let ([chunk (make-chunk code*)])
[offset1 (adjust-return-point-offset offset1 l)])
(let ([offset (fx+ (chunk-size chunk) offset)] [chunk* (cons chunk chunk*)]) (let ([offset (fx+ (chunk-size chunk) offset)] [chunk* (cons chunk chunk*)])
(let ([chunk (asm-return-address x l offset1 offset)]) (let ([chunk (asm-return-address x l offset1 offset)])
(values '() (cons chunk chunk*) (fx+ (chunk-size chunk) offset)))))] (values '() (cons chunk chunk*) (fx+ (chunk-size chunk) offset)))))]

18
s/mkheader.ss
View File

@ -656,8 +656,8 @@
(pr " \"cmp r12, #0\\n\\t\"\\~%") (pr " \"cmp r12, #0\\n\\t\"\\~%")
(pr " \"bne 1f\\n\\t\"\\~%") (pr " \"bne 1f\\n\\t\"\\~%")
(pr " \"mov r12, #1\\n\\t\"\\~%") (pr " \"mov r12, #1\\n\\t\"\\~%")
(pr " \"strex r11, r12, [%0]\\n\\t\"\\~%") (pr " \"strex r7, r12, [%0]\\n\\t\"\\~%")
(pr " \"cmp r11, #0\\n\\t\"\\~%") (pr " \"cmp r7, #0\\n\\t\"\\~%")
(pr " \"beq 2f\\n\\t\"\\~%") (pr " \"beq 2f\\n\\t\"\\~%")
(pr " \"1:\\n\\t\"\\~%") (pr " \"1:\\n\\t\"\\~%")
(pr " \"ldr r12, [%0, #0]\\n\\t\"\\~%") (pr " \"ldr r12, [%0, #0]\\n\\t\"\\~%")
@ -667,7 +667,7 @@
(pr " \"2:\\n\\t\"\\~%") (pr " \"2:\\n\\t\"\\~%")
(pr " : \\~%") (pr " : \\~%")
(pr " : \"r\" (addr)\\~%") (pr " : \"r\" (addr)\\~%")
(pr " : \"cc\", \"memory\", \"r12\", \"r11\")~%") (pr " : \"cc\", \"memory\", \"r12\", \"r7\")~%")
(nl) (nl)
(pr "#define UNLOCK(addr) \\~%") (pr "#define UNLOCK(addr) \\~%")
@ -683,14 +683,14 @@
(pr " \"0:\\n\\t\"\\~%") (pr " \"0:\\n\\t\"\\~%")
(pr " \"ldrex r12, [%1, #0]\\n\\t\"\\~%") (pr " \"ldrex r12, [%1, #0]\\n\\t\"\\~%")
(pr " \"add r12, r12, #1\\n\\t\"\\~%") (pr " \"add r12, r12, #1\\n\\t\"\\~%")
(pr " \"strex r11, r12, [%1]\\n\\t\"\\~%") (pr " \"strex r7, r12, [%1]\\n\\t\"\\~%")
(pr " \"cmp r11, #0\\n\\t\"\\~%") (pr " \"cmp r7, #0\\n\\t\"\\~%")
(pr " \"bne 0b\\n\\t\"\\~%") (pr " \"bne 0b\\n\\t\"\\~%")
(pr " \"cmp r12, #0\\n\\t\"\\~%") (pr " \"cmp r12, #0\\n\\t\"\\~%")
(pr " \"moveq %0, #1\\n\\t\"\\~%") (pr " \"moveq %0, #1\\n\\t\"\\~%")
(pr " : \"=&r\" (ret)\\~%") (pr " : \"=&r\" (ret)\\~%")
(pr " : \"r\" (addr)\\~%") (pr " : \"r\" (addr)\\~%")
(pr " : \"cc\", \"memory\", \"r12\", \"r11\")~%") (pr " : \"cc\", \"memory\", \"r12\", \"r7\")~%")
(nl) (nl)
(pr "#define LOCKED_DECR(addr, ret) \\~%") (pr "#define LOCKED_DECR(addr, ret) \\~%")
@ -698,14 +698,14 @@
(pr " \"0:\\n\\t\"\\~%") (pr " \"0:\\n\\t\"\\~%")
(pr " \"ldrex r12, [%1, #0]\\n\\t\"\\~%") (pr " \"ldrex r12, [%1, #0]\\n\\t\"\\~%")
(pr " \"sub r12, r12, #1\\n\\t\"\\~%") (pr " \"sub r12, r12, #1\\n\\t\"\\~%")
(pr " \"strex r11, r12, [%1]\\n\\t\"\\~%") (pr " \"strex r7, r12, [%1]\\n\\t\"\\~%")
(pr " \"cmp r11, #0\\n\\t\"\\~%") (pr " \"cmp r7, #0\\n\\t\"\\~%")
(pr " \"bne 0b\\n\\t\"\\~%") (pr " \"bne 0b\\n\\t\"\\~%")
(pr " \"cmp r12, #0\\n\\t\"\\~%") (pr " \"cmp r12, #0\\n\\t\"\\~%")
(pr " \"moveq %0, #1\\n\\t\"\\~%") (pr " \"moveq %0, #1\\n\\t\"\\~%")
(pr " : \"=&r\" (ret)\\~%") (pr " : \"=&r\" (ret)\\~%")
(pr " : \"r\" (addr)\\~%") (pr " : \"r\" (addr)\\~%")
(pr " : \"cc\", \"memory\", \"r12\", \"r11\")~%")] (pr " : \"cc\", \"memory\", \"r12\", \"r7\")~%")]
[else [else
($oops who "asm locking code is not yet defined for ~s" (constant architecture))])))) ($oops who "asm locking code is not yet defined for ~s" (constant architecture))]))))

8
s/x86.ss
View File

@ -38,8 +38,7 @@
[%fptmp1 #f 0 fp] [%fptmp1 #f 0 fp]
[%fptmp2 #f 1 fp] [%fptmp2 #f 1 fp]
[%sp #t 4 uptr] [%sp #t 4 uptr]
#;[%esi #f 6]) #;[%esi #f 6]))
(reify-support %ts))
;;; SECTION 2: instructions ;;; SECTION 2: instructions
(module (md-handle-jump) ; also sets primitive handlers (module (md-handle-jump) ; also sets primitive handlers
@ -812,7 +811,7 @@
[(op (z mem)) `(asm ,info ,asm-flds ,z)]) [(op (z mem)) `(asm ,info ,asm-flds ,z)])
(define-instruction effect (load-single->double load-double->single) (define-instruction effect (load-single->double load-double->single)
[(op (x ur) (y ur) (z imm32)) [(op (x ur) (y ur) (z imm32))<
`(asm ,info ,(asm-fl-cvt op (info-loadfl-flreg info)) ,x ,y ,z)]) `(asm ,info ,(asm-fl-cvt op (info-loadfl-flreg info)) ,x ,y ,z)])
(define-instruction effect (store-single store-double) (define-instruction effect (store-single store-double)
@ -2323,7 +2322,8 @@
(define asm-direct-jump (define asm-direct-jump
(lambda (l offset) (lambda (l offset)
(emit bra (make-funcrel 'literal l offset) '()))) (let ([offset (adjust-return-point-offset offset l)])
(emit bra (make-funcrel 'literal l offset) '()))))
(define asm-literal-jump (define asm-literal-jump
(lambda (info) (lambda (info)

18
s/x86_64.ss
View File

@ -43,8 +43,7 @@
[%Cfparg2 #f 1 fp] [%Cfparg2 #f 1 fp]
[%fptmp1 #f 4 fp] ; xmm 0-5 are caller-save [%fptmp1 #f 4 fp] ; xmm 0-5 are caller-save
[%fptmp2 #f 5 fp] ; xmm 6-15 are callee-save [%fptmp2 #f 5 fp] ; xmm 6-15 are callee-save
[%sp #t 4 uptr]) [%sp #t 4 uptr]))
(reify-support %ts))
(define-registers (define-registers
(reserved (reserved
[%tc %r14 #t 14 uptr] [%tc %r14 #t 14 uptr]
@ -77,8 +76,7 @@
[%Cfparg8 #f 7 fp] [%Cfparg8 #f 7 fp]
[%fptmp1 #f 8 fp] [%fptmp1 #f 8 fp]
[%fptmp2 #f 9 fp] [%fptmp2 #f 9 fp]
[%sp #t 4 uptr]) [%sp #t 4 uptr])))
(reify-support %ts)))
;;; SECTION 2: instructions ;;; SECTION 2: instructions
(module (md-handle-jump) ; also sets primitive handlers (module (md-handle-jump) ; also sets primitive handlers
@ -2523,7 +2521,8 @@
(define asm-direct-jump (define asm-direct-jump
(lambda (l offset) (lambda (l offset)
(asm-helper-jump '() (make-funcrel 'x86_64-jump l offset)))) (let ([offset (adjust-return-point-offset offset l)])
(asm-helper-jump '() (make-funcrel 'x86_64-jump l offset)))))
(define asm-literal-jump (define asm-literal-jump
(lambda (info) (lambda (info)
@ -2543,10 +2542,11 @@
(or (cond (or (cond
[(local-label-offset l) => [(local-label-offset l) =>
(lambda (offset) (lambda (offset)
(let ([disp (fx- next-addr (fx- offset incr-offset))]) (let ([incr-offset (adjust-return-point-offset incr-offset l)])
(and (signed-32? disp) (let ([disp (fx- next-addr (fx- offset incr-offset))])
(Trivit (dest) (and (signed-32? disp)
(emit lea `(riprel ,disp) dest '())))))] (Trivit (dest)
(emit lea `(riprel ,disp) dest '()))))))]
[else #f]) [else #f])
(asm-move '() dest (with-output-language (L16 Triv) `(label-ref ,l ,incr-offset))))))) (asm-move '() dest (with-output-language (L16 Triv) `(label-ref ,l ,incr-offset)))))))