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

Chez Scheme: save an instruction on record predicates

Browse Source 
Combine separate subtraction and comparison instructions into one in
the case of non-sealed record types.
This commit is contained in:
Matthew Flatt 2020-12-31 07:43:46 -07:00
parent 30eb35b99c
commit f299c4304d
12 changed files with 72 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.makefile
View File

@ -338,7 +338,7 @@ RACKET_FOR_BOOTFILES = $(RACKET)
RACKET_FOR_BUILD = $(RACKET) RACKET_FOR_BUILD = $(RACKET)
# This branch name changes each time the pb boot files are updated: # This branch name changes each time the pb boot files are updated:
PB_BRANCH == circa-7.9.0.22-1 PB_BRANCH == circa-7.9.0.22-2
PB_REPO = https://github.com/racket/pb PB_REPO = https://github.com/racket/pb
# Alternative source for Chez Scheme boot files, normally set by # Alternative source for Chez Scheme boot files, normally set by

12
Makefile
View File

@ -47,7 +47,7 @@ RACKETCS_SUFFIX =
RACKET = RACKET =
RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BOOTFILES = $(RACKET)
RACKET_FOR_BUILD = $(RACKET) RACKET_FOR_BUILD = $(RACKET)
PB_BRANCH = circa-7.9.0.22-1 PB_BRANCH = circa-7.9.0.22-2
PB_REPO = https://github.com/racket/pb PB_REPO = https://github.com/racket/pb
EXTRA_REPOS_BASE = EXTRA_REPOS_BASE =
CS_CROSS_SUFFIX = CS_CROSS_SUFFIX =
@ -307,18 +307,18 @@ maybe-fetch-pb-as-is:
echo done echo done
fetch-pb-from: fetch-pb-from:
mkdir -p racket/src/ChezScheme/boot mkdir -p racket/src/ChezScheme/boot
if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-7.9.0.22-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.22-1:remotes/origin/circa-7.9.0.22-1 ; fi if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-7.9.0.22-2 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.22-2:remotes/origin/circa-7.9.0.22-2 ; fi
cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.22-1 cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.22-2
pb-fetch: pb-fetch:
$(MAKE) fetch-pb EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" PB_REPO="$(PB_REPO)" $(MAKE) fetch-pb EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" PB_REPO="$(PB_REPO)"
pb-build: pb-build:
cd racket/src/ChezScheme && racket rktboot/main.rkt --machine pb cd racket/src/ChezScheme && racket rktboot/main.rkt --machine pb
pb-stage: pb-stage:
cd racket/src/ChezScheme/boot/pb && git branch circa-7.9.0.22-1 cd racket/src/ChezScheme/boot/pb && git branch circa-7.9.0.22-2
cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.22-1 cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.22-2
cd racket/src/ChezScheme/boot/pb && git add . && git commit --amend -m "new build" cd racket/src/ChezScheme/boot/pb && git add . && git commit --amend -m "new build"
pb-push: pb-push:
cd racket/src/ChezScheme/boot/pb && git push -u origin circa-7.9.0.22-1 cd racket/src/ChezScheme/boot/pb && git push -u origin circa-7.9.0.22-2
win-cs-base: win-cs-base:
IF "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-bc-then-cs-base SETUP_BOOT_MODE=--boot WIN32_BUILD_LEVEL=bc PLAIN_RACKET=racket\racketbc DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETBC_SUFFIX="$(RACKETBC_SUFFIX)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" IF "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-bc-then-cs-base SETUP_BOOT_MODE=--boot WIN32_BUILD_LEVEL=bc PLAIN_RACKET=racket\racketbc DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETBC_SUFFIX="$(RACKETBC_SUFFIX)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)"
IF not "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-just-cs-base SETUP_BOOT_MODE=--chain DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" RACKET_FOR_BUILD="$(RACKET_FOR_BUILD)" IF not "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-just-cs-base SETUP_BOOT_MODE=--chain DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" RACKET_FOR_BUILD="$(RACKET_FOR_BUILD)"

14
racket/src/ChezScheme/c/pb.c
View File

@ -401,6 +401,20 @@ void S_pb_interp(ptr tc, void *bytecode) {
flag = (r == 0); flag = (r == 0);
} }
break; break;
case pb_bin_op_pb_signal_pb_subp_pb_register:
{
iptr r = regs[INSTR_drr_reg1(instr)] - regs[INSTR_drr_reg2(instr)];
regs[INSTR_drr_dest(instr)] = r;
flag = (r > 0);
}
break;
case pb_bin_op_pb_signal_pb_subp_pb_immediate:
{
iptr r = regs[INSTR_dri_reg(instr)] - (uptr)INSTR_dri_imm(instr);
regs[INSTR_dri_dest(instr)] = r;
flag = (r > 0);
}
break;
case pb_cmp_op_pb_eq_pb_register: case pb_cmp_op_pb_eq_pb_register:
flag = regs[INSTR_dr_dest(instr)] == regs[INSTR_dr_reg(instr)]; flag = regs[INSTR_dr_dest(instr)] == regs[INSTR_dr_reg(instr)];
break; break;

21
racket/src/ChezScheme/s/arm32.ss
View File

@ -354,27 +354,27 @@
; WARNING: do not assume that if x isn't the same as z then x is independent ; WARNING: do not assume that if x isn't the same as z then x is independent
; of z, since x might be an mref with z as it's base or index ; of z, since x might be an mref with z as it's base or index
(define-instruction value (- -/ovfl -/eq) (define-instruction value (- -/ovfl -/eq -/pos)
[(op (z ur) (x ur) (y funky12)) [(op (z ur) (x ur) (y funky12))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (memq op '(-/ovfl -/eq))) ,x ,y))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (not (eq? op '-))) ,x ,y))]
[(op (z ur) (x funky12) (y ur)) [(op (z ur) (x funky12) (y ur))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-rsb (memq op '(-/ovfl -/eq))) ,y ,x))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-rsb (not (eq? op '-))) ,y ,x))]
[(op (z ur) (x ur) (y negate-funky12)) [(op (z ur) (x ur) (y negate-funky12))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-add (memq op '(-/ovfl -/eq))) ,x ,y))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-add (not (eq? op '-))) ,x ,y))]
[(op (z ur) (x ur) (y ur)) [(op (z ur) (x ur) (y ur))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (memq op '(-/ovfl -/eq))) ,x ,y))]) `(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (not (eq? op '-))) ,x ,y))])
(define-instruction value (+ +/ovfl +/carry) (define-instruction value (+ +/ovfl +/carry)
[(op (z ur) (x ur) (y funky12)) [(op (z ur) (x ur) (y funky12))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-add (memq op '(+/ovfl +/carry))) ,x ,y))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-add (not (eq? op '+))) ,x ,y))]
[(op (z ur) (x funky12) (y ur)) [(op (z ur) (x funky12) (y ur))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-add (memq op '(+/ovfl +/carry))) ,y ,x))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-add (not (eq? op '+))) ,y ,x))]
[(op (z ur) (x ur) (y negate-funky12)) [(op (z ur) (x ur) (y negate-funky12))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (memq op '(+/ovfl +/carry))) ,x ,y))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (not (eq? op '+))) ,x ,y))]
[(op (z ur) (x negate-funky12) (y ur)) [(op (z ur) (x negate-funky12) (y ur))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (memq op '(+/ovfl +/carry))) ,y ,x))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (not (eq? op '+))) ,y ,x))]
[(op (z ur) (x ur) (y ur)) [(op (z ur) (x ur) (y ur))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-add (memq op '(+/ovfl +/carry))) ,x ,y))]) `(set! ,(make-live-info) ,z (asm ,info ,(asm-add (not (eq? op '+))) ,x ,y))])
(define-instruction value (*) (define-instruction value (*)
; no imm form available ; no imm form available
@ -2295,6 +2295,7 @@
[(>=) (i? (r? bgt blt) (r? ble bge))] [(>=) (i? (r? bgt blt) (r? ble bge))]
[(overflow) (i? bvc bvs)] [(overflow) (i? bvc bvs)]
[(multiply-overflow) (i? beq bne)] ; result of comparing sign bit of low word with all bits in high word: eq if no overflow, ne if oveflow [(multiply-overflow) (i? beq bne)] ; result of comparing sign bit of low word with all bits in high word: eq if no overflow, ne if oveflow
[(positive) (i? ble bgt)]
[(carry) (i? bcc bcs)] [(carry) (i? bcc bcs)]
[(fp<) (i? (r? ble bcs) (r? bgt bcc))] [(fp<) (i? (r? ble bcs) (r? bgt bcc))]
[(fp<=) (i? (r? blt bhi) (r? bge bls))] [(fp<=) (i? (r? blt bhi) (r? bge bls))]

17
racket/src/ChezScheme/s/arm64.ss
View File

@ -236,23 +236,23 @@
; WARNING: do not assume that if x isn't the same as z then x is independent ; WARNING: do not assume that if x isn't the same as z then x is independent
; of z, since x might be an mref with z as it's base or index ; of z, since x might be an mref with z as it's base or index
(define-instruction value (- -/ovfl -/eq) (define-instruction value (- -/ovfl -/eq -/pos)
[(op (z ur) (x ur) (y unsigned12)) [(op (z ur) (x ur) (y unsigned12))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (memq op '(-/ovfl -/eq))) ,x ,y))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (not (eq? op '-))) ,x ,y))]
[(op (z ur) (x ur) (y neg-unsigned12)) [(op (z ur) (x ur) (y neg-unsigned12))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-add (memq op '(-/ovfl -/eq))) ,x ,y))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-add (not (eq? op '-))) ,x ,y))]
[(op (z ur) (x ur) (y ur)) [(op (z ur) (x ur) (y ur))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (memq op '(-/ovfl -/eq))) ,x ,y))]) `(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (not (eq? op '-))) ,x ,y))])
(define-instruction value (+ +/ovfl +/carry) (define-instruction value (+ +/ovfl +/carry)
[(op (z ur) (x ur) (y unsigned12)) [(op (z ur) (x ur) (y unsigned12))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-add (memq op '(+/ovfl +/carry))) ,x ,y))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-add (not (eq? op '+))) ,x ,y))]
[(op (z ur) (x ur) (y neg-unsigned12)) [(op (z ur) (x ur) (y neg-unsigned12))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (memq op '(+/ovfl +/carry))) ,x ,y))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-sub (not (eq? op '+))) ,x ,y))]
[(op (z ur) (x unsigned12) (y ur)) [(op (z ur) (x unsigned12) (y ur))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-add (memq op '(+/ovfl +/carry))) ,y ,x))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-add (not (eq? op '+))) ,y ,x))]
[(op (z ur) (x ur) (y ur)) [(op (z ur) (x ur) (y ur))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-add (memq op '(+/ovfl +/carry))) ,x ,y))]) `(set! ,(make-live-info) ,z (asm ,info ,(asm-add (not (eq? op '+))) ,x ,y))])
(define-instruction value (*) (define-instruction value (*)
; no imm form available ; no imm form available
@ -2280,6 +2280,7 @@
[(>) (i? (r? bge ble) (r? blt bgt))] [(>) (i? (r? bge ble) (r? blt bgt))]
[(>=) (i? (r? bgt blt) (r? ble bge))] [(>=) (i? (r? bgt blt) (r? ble bge))]
[(overflow) (i? bvc bvs)] [(overflow) (i? bvc bvs)]
[(positive) (i? ble bgt)]
[(multiply-overflow) (i? beq bne)] ; result of comparing sign bit of low word with all bits in high word: eq if no overflow, ne if oveflow [(multiply-overflow) (i? beq bne)] ; result of comparing sign bit of low word with all bits in high word: eq if no overflow, ne if oveflow
[(carry) (i? bcc bcs)] [(carry) (i? bcc bcs)]
[(fp<) (i? (r? ble bcs) (r? bgt bcc))] [(fp<) (i? (r? ble bcs) (r? bgt bcc))]

1
racket/src/ChezScheme/s/cmacros.ss
View File

@ -3215,6 +3215,7 @@
pb-mul pb-mul
pb-div pb-div
pb-subz pb-subz
pb-subp
pb-and pb-and
pb-ior pb-ior
pb-xor pb-xor

30
racket/src/ChezScheme/s/cpnanopass.ss
View File

@ -11101,7 +11101,7 @@
,e-rtd)))))) ,e-rtd))))))
(define build-unsealed-isa? (define build-unsealed-isa?
(lambda (e e-rtd) (lambda (e e-rtd)
(let ([t (make-tmp 't)] [a (make-tmp 'a)] [d (make-tmp 'd)]) (let ([t (make-tmp 't)] [a (make-tmp 'a)])
(let ([known-depth (nanopass-case (L7 Expr) e-rtd (let ([known-depth (nanopass-case (L7 Expr) e-rtd
[(quote ,d) (and (record-type-descriptor? d) [(quote ,d) (and (record-type-descriptor? d)
(vector-length (rtd-ancestors d)))] (vector-length (rtd-ancestors d)))]
@ -11119,24 +11119,16 @@
;; take advantage of being able to use the type field of a vector ;; take advantage of being able to use the type field of a vector
;; as a pointer offset with just shifting: ;; as a pointer offset with just shifting:
(safe-assert (zero? (constant type-vector))) (safe-assert (zero? (constant type-vector)))
(cond (bind #f ([d (%inline -/pos ,(%mref ,a ,(constant vector-type-disp))
[known-depth ,(if known-depth
`(let ([,d ,(%mref ,a ,(constant vector-type-disp))]) `(immediate ,(fxsll known-depth (constant vector-length-offset)))
,(build-and (%mref ,(%mref ,e-rtd ,(constant record-type-ancestry-disp))
(%inline < (immediate ,(fxsll known-depth (constant vector-length-offset))) ,d) ,(constant vector-type-disp))))])
(%inline eq? ,e-rtd ,(%mref ,a `(if (inline ,(make-info-condition-code 'positive #f #t) ,%condition-code)
,(translate d (constant vector-length-offset) (constant log2-ptr-bytes)) ,(%inline eq? ,e-rtd ,(%mref ,a
,(fx- (constant vector-data-disp) (fx* (fx+ known-depth 1) ,(translate d (constant vector-length-offset) (constant log2-ptr-bytes))
(constant ptr-bytes)))))))] ,(fx- (constant vector-data-disp) (constant ptr-bytes))))
[else ,(%constant sfalse))))))))))))))
`(let ([,d ,(%inline - ,(%mref ,a ,(constant vector-type-disp))
,(%mref ,(%mref ,e-rtd ,(constant record-type-ancestry-disp))
,(constant vector-type-disp)))])
,(build-and
(%inline > ,d (immediate 0))
(%inline eq? ,e-rtd ,(%mref ,a
,(translate d (constant vector-length-offset) (constant log2-ptr-bytes))
,(fx- (constant vector-data-disp) (constant ptr-bytes))))))]))))))))))))
(define-inline 3 record? (define-inline 3 record?
[(e) (build-record? e)] [(e) (build-record? e)]
[(e e-rtd) [(e e-rtd)

1
racket/src/ChezScheme/s/np-languages.ss
View File

@ -591,6 +591,7 @@
(declare-primitive +/carry value #f) (declare-primitive +/carry value #f)
(declare-primitive -/ovfl value #f) (declare-primitive -/ovfl value #f)
(declare-primitive -/eq value #f) (declare-primitive -/eq value #f)
(declare-primitive -/pos value #f)
(declare-primitive asmlibcall value #f) (declare-primitive asmlibcall value #f)
(declare-primitive cpuid value #t) ; x86_64 only, actually side-effects ebx/ecx/edx (declare-primitive cpuid value #t) ; x86_64 only, actually side-effects ebx/ecx/edx
(declare-primitive fstpl value #f) ; x86 only (declare-primitive fstpl value #f) ; x86 only

16
racket/src/ChezScheme/s/pb.ss
View File

@ -214,7 +214,7 @@
; WARNING: do not assume that if x isn't the same as z then x is independent ; WARNING: do not assume that if x isn't the same as z then x is independent
; of z, since x might be an mref with z as it's base or index ; of z, since x might be an mref with z as it's base or index
(define-instruction value (- -/ovfl -/eq) (define-instruction value (- -/ovfl -/eq -/pos)
[(op (z ur) (x ur) (y signed16)) [(op (z ur) (x ur) (y signed16))
`(set! ,(make-live-info) ,z (asm ,info ,(asm-sub op) ,x ,y))] `(set! ,(make-live-info) ,z (asm ,info ,(asm-sub op) ,x ,y))]
[(op (z ur) (x ur) (y ur)) [(op (z ur) (x ur) (y ur))
@ -623,6 +623,7 @@
(define-op div bin-op (constant pb-div)) (define-op div bin-op (constant pb-div))
(define-op subz signal-bin-op (constant pb-subz)) ; signals on 0 instead of overflow (define-op subz signal-bin-op (constant pb-subz)) ; signals on 0 instead of overflow
(define-op subp signal-bin-op (constant pb-subp)) ; signals on positive
(define-op land bin-op (constant pb-and)) (define-op land bin-op (constant pb-and))
(define-op lior bin-op (constant pb-ior)) (define-op lior bin-op (constant pb-ior))
@ -1110,9 +1111,13 @@
(lambda (op) (lambda (op)
(lambda (code* dest src0 src1) (lambda (code* dest src0 src1)
(Trivit (dest src0 src1) (Trivit (dest src0 src1)
(if (eq? op '-/eq) (cond
(emit subz #t dest src0 src1 code*) [(eq? op '-/eq)
(emit sub (eq? op '-/ovfl) dest src0 src1 code*)))))) (emit subz #t dest src0 src1 code*)]
[(eq? op '-/pos)
(emit subp #t dest src0 src1 code*)]
[else
(emit sub (eq? op '-/ovfl) dest src0 src1 code*)])))))
(define asm-mul (define asm-mul
(lambda (set-cc?) (lambda (set-cc?)
@ -1624,5 +1629,6 @@
(define-who asm-foreign-callable (define-who asm-foreign-callable
(lambda (info) (lambda (info)
(sorry! who "callables are not supported")))) (sorry! who "callables are not supported")
(values 'c-init 'c-args 'c-result 'c-return))))
) )

5
racket/src/ChezScheme/s/ppc32.ss
View File

@ -296,7 +296,7 @@
[(op (z ur) (x ur) (y ur)) [(op (z ur) (x ur) (y ur))
`(set! ,(make-live-info) ,z (asm ,info ,asm-sub-from/ovfl ,y ,x))]) `(set! ,(make-live-info) ,z (asm ,info ,asm-sub-from/ovfl ,y ,x))])
(define-instruction value (-/eq) (define-instruction value (-/eq -/pos)
[(op (z ur) (x ur) (y ur)) [(op (z ur) (x ur) (y ur))
`(set! ,(make-live-info) ,z (asm ,info ,asm-sub-from/eq ,y ,x))]) `(set! ,(make-live-info) ,z (asm ,info ,asm-sub-from/eq ,y ,x))])
@ -1994,7 +1994,8 @@
[(fp<= <=) (i? (r? blt bgt) (r? bge ble))] [(fp<= <=) (i? (r? blt bgt) (r? bge ble))]
[(>) (i? (r? bge ble) (r? blt bgt))] [(>) (i? (r? bge ble) (r? blt bgt))]
[(>=) (i? (r? bgt blt) (r? ble bge))] [(>=) (i? (r? bgt blt) (r? ble bge))]
[(carry multiply-overflow overflow) (i? bns bso)]) [(carry multiply-overflow overflow) (i? bns bso)]
[(positive) (i? ble bgt)])
(let ([type (info-condition-code-type info)] (let ([type (info-condition-code-type info)]
[reversed? (info-condition-code-reversed? info)]) [reversed? (info-condition-code-reversed? info)])
(make-cgchunk info l1 l2 next-addr (make-cgchunk info l1 l2 next-addr

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

@ -261,7 +261,7 @@
`(set! ,(make-live-info) ,t (asm ,info ,asm-sub ,t ,y)) `(set! ,(make-live-info) ,t (asm ,info ,asm-sub ,t ,y))
`(set! ,(make-live-info) ,z ,t)))]) `(set! ,(make-live-info) ,z ,t)))])
(define-instruction value (-/ovfl -/eq) ; must set condition codes, so can't use lea or sub-negate (define-instruction value (-/ovfl -/eq -/pos) ; must set condition codes, so can't use lea or sub-negate
[(op (z mem) (x z) (y ur imm32)) [(op (z mem) (x z) (y ur imm32))
`(set! ,(make-live-info) ,z (asm ,info ,asm-sub ,x ,y))] `(set! ,(make-live-info) ,z (asm ,info ,asm-sub ,x ,y))]
[(op (z mem) (x zero) (y z)) [(op (z mem) (x zero) (y z))
@ -2157,6 +2157,7 @@
[(>) (i? (r? bge ble) (r? blt bgt))] [(>) (i? (r? bge ble) (r? blt bgt))]
[(>=) (i? (r? bgt blt) (r? ble bge))] [(>=) (i? (r? bgt blt) (r? ble bge))]
[(overflow multiply-overflow) (i? bvc bvs)] [(overflow multiply-overflow) (i? bvc bvs)]
[(positive) (i? ble bgt)]
[(carry) (i? bcc bcs)] [(carry) (i? bcc bcs)]
; unordered: zf,pf,cf <- 111; gt: 000; lt: 001; eq: 100 ; unordered: zf,pf,cf <- 111; gt: 000; lt: 001; eq: 100
; reversed & inverted: !(fl< y x) = !(fl> x y) iff zf = 1 & cf = 1 ; reversed & inverted: !(fl< y x) = !(fl> x y) iff zf = 1 & cf = 1

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

@ -323,7 +323,7 @@
`(set! ,(make-live-info) ,t (asm ,info ,asm-sub ,t ,y)) `(set! ,(make-live-info) ,t (asm ,info ,asm-sub ,t ,y))
`(set! ,(make-live-info) ,z ,t)))]) `(set! ,(make-live-info) ,z ,t)))])
(define-instruction value (-/ovfl -/eq) ; must set condition codes, so can't use lea or sub-negate (define-instruction value (-/ovfl -/eq -/pos) ; must set condition codes, so can't use lea or sub-negate
[(op (z mem) (x z) (y ur imm32)) [(op (z mem) (x z) (y ur imm32))
`(set! ,(make-live-info) ,z (asm ,info ,asm-sub ,x ,y))] `(set! ,(make-live-info) ,z (asm ,info ,asm-sub ,x ,y))]
[(op (z mem) (x zero) (y z)) [(op (z mem) (x zero) (y z))
@ -2383,6 +2383,7 @@
[(>) (i? (r? bge ble) (r? blt bgt))] [(>) (i? (r? bge ble) (r? blt bgt))]
[(>=) (i? (r? bgt blt) (r? ble bge))] [(>=) (i? (r? bgt blt) (r? ble bge))]
[(overflow multiply-overflow) (i? bvc bvs)] [(overflow multiply-overflow) (i? bvc bvs)]
[(positive) (i? ble bgt)]
[(carry) (i? bcc bcs)] [(carry) (i? bcc bcs)]
; unordered: zf,pf,cf <- 111; gt: 000; lt: 001; eq: 100 ; unordered: zf,pf,cf <- 111; gt: 000; lt: 001; eq: 100
; reversed & inverted: !(fl< y x) = !(fl> x y) iff zf = 1 & cf = 1 ; reversed & inverted: !(fl< y x) = !(fl> x y) iff zf = 1 & cf = 1