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

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
LOG
View File

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

18
mats/fx.ms
View File

@ -2600,6 +2600,12 @@
(errorf #f "failed for ~s, ~s, ~s" x y z))) (errorf #f "failed for ~s, ~s, ~s" x y z)))
(f (fx- n 1))))) (f (fx- n 1)))))
#t) #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 (mat fx-/carry
@ -2642,6 +2648,12 @@
(errorf #f "failed for ~s, ~s, ~s" x y z))) (errorf #f "failed for ~s, ~s, ~s" x y z)))
(f (fx- n 1))))) (f (fx- n 1)))))
#t) #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 (mat fx*/carry
@ -2684,6 +2696,12 @@
(errorf #f "failed for ~s, ~s, ~s" x y z))) (errorf #f "failed for ~s, ~s, ~s" x y z)))
(f (fx- n 1))))) (f (fx- n 1)))))
#t) #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 (mat fxrotate-bit-field

4
s/cp0.ss
View File

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

6
s/primdata.ss
View File

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