Merge pull request #217 from gus-massa/17-10-Carry

Fix cp0 reduction of fx[+-*]/carry and their signatures
original commit: 5fdf60277c33915852a6bfa5cabe164c98e844d5
This commit is contained in:
Andy Keep 2017-10-09 22:53:19 -04:00 committed by GitHub
commit baa7ebe0c5
4 changed files with 27 additions and 5 deletions

4
LOG
View File

@ -584,3 +584,7 @@
3.ms
- removed a useless check in foreign-alloc
record.ss
- fix cp0 reduction of fx[+-*]/carry and their signatures
cp0.ss
primdata.ss
fx.ms

View File

@ -2600,6 +2600,12 @@
(errorf #f "failed for ~s, ~s, ~s" x y z)))
(f (fx- n 1)))))
#t)
(let-values ([(r c) (fx+/carry 100 20 3)])
(and (= r 123) (= c 0)))
(equal?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize '(fx+/carry 100 20 3)))
'(#3%values 123 0))
)
(mat fx-/carry
@ -2642,6 +2648,12 @@
(errorf #f "failed for ~s, ~s, ~s" x y z)))
(f (fx- n 1)))))
#t)
(let-values ([(r c) (fx-/carry 100 20 3)])
(and (= r 77) (= c 0)))
(equal?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize '(fx-/carry 100 20 3)))
'(#3%values 77 0))
)
(mat fx*/carry
@ -2684,6 +2696,12 @@
(errorf #f "failed for ~s, ~s, ~s" x y z)))
(f (fx- n 1)))))
#t)
(let-values ([(r c) (fx*/carry 100 20 3)])
(and (= r 2003) (= c 0)))
(equal?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize '(fx*/carry 100 20 3)))
'(#3%values 2003 0))
)
(mat fxrotate-bit-field

View File

@ -2583,8 +2583,8 @@
(build-primcall 3 'values
(let ([s (base-op dx dy dz)])
(list
(mod0 s (expt 2 (constant fixnum-bits)))
(div0 s (expt 2 (constant fixnum-bits))))))))))
`(quote ,(mod0 s (expt 2 (constant fixnum-bits))))
`(quote ,(div0 s (expt 2 (constant fixnum-bits)))))))))))
(define-syntax define-inline-carry-op
(syntax-rules ()
[(_ op base-op)

View File

@ -61,9 +61,9 @@
(fxdiv0-and-mod0 [sig [(fixnum fixnum) -> (fixnum fixnum)]] [flags discard])
(fxdiv0 [sig [(fixnum fixnum) -> (fixnum)]] [flags arith-op cp02])
(fxmod0 [sig [(fixnum fixnum) -> (fixnum)]] [flags arith-op cp02])
(fx+/carry [sig [(fixnum fixnum fixnum) -> (fixnum)]] [flags arith-op cp02])
(fx-/carry [sig [(fixnum fixnum fixnum) -> (fixnum)]] [flags arith-op cp02])
(fx*/carry [sig [(fixnum fixnum fixnum) -> (fixnum)]] [flags arith-op cp02])
(fx+/carry [sig [(fixnum fixnum fixnum) -> (fixnum fixnum)]] [flags arith-op cp02])
(fx-/carry [sig [(fixnum fixnum fixnum) -> (fixnum fixnum)]] [flags arith-op cp02])
(fx*/carry [sig [(fixnum fixnum fixnum) -> (fixnum fixnum)]] [flags arith-op cp02])
(fxnot [sig [(fixnum) -> (fixnum)]] [flags arith-op cp02])
(fxand [sig [(fixnum ...) -> (fixnum)]] [flags arith-op partial-folder])
(fxior [sig [(fixnum ...) -> (fixnum)]] [flags arith-op partial-folder])