mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Revert "Slot allocation allows s64/u64 representations of same var"

Browse source 
This reverts commit a88614fb17.
This commit is contained in:
Andy Wingo 2017-11-20 18:00:15 +01:00
parent c22e61a7ff
commit 5c38643fc6
1 changed files with 4 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

17
module/language/cps/slot-allocation.scm
View file

@ -744,13 +744,6 @@ are comparable with eqv?. A tmp slot may be used."
(match (intmap-ref cps k)
(($ $kargs names vars) vars)
(_ '())))
(define (meet-s64-u64 old new)
(cond
((and (eq? old 's64) (eq? new 'u64))
'u64)
((and (eq? old 'u64) (eq? new 's64))
'u64)
(error "incompatible representations" old new)))
(intmap-fold
(lambda (label cont representations)
(match cont
@ -761,8 +754,7 @@ are comparable with eqv?. A tmp slot may be used."
(match exp
(($ $values (arg))
(intmap-add representations var
(intmap-ref representations arg)
meet-s64-u64))
(intmap-ref representations arg)))
(($ $primcall (or 'scm->f64 'load-f64
'bv-f32-ref 'bv-f64-ref
'fadd 'fsub 'fmul 'fdiv))
@ -775,12 +767,12 @@ are comparable with eqv?. A tmp slot may be used."
'uadd/immediate 'usub/immediate 'umul/immediate
'ursh/immediate 'ulsh/immediate
'bv-u8-ref 'bv-u16-ref 'bv-u32-ref 'bv-u64-ref))
(intmap-add representations var 'u64 meet-s64-u64))
(intmap-add representations var 'u64))
(($ $primcall (or 'untag-fixnum
'scm->s64 'load-s64 'u64->s64
'srsh 'srsh/immediate
'bv-s8-ref 'bv-s16-ref 'bv-s32-ref 'bv-s64-ref))
(intmap-add representations var 's64 meet-s64-u64))
(intmap-add representations var 's64))
(_
(intmap-add representations var 'scm))))
(vars
@ -788,8 +780,7 @@ are comparable with eqv?. A tmp slot may be used."
(($ $values args)
(fold (lambda (arg var representations)
(intmap-add representations var
(intmap-ref representations arg)
meet-s64-u64))
(intmap-ref representations arg)))
representations args vars))))))
(($ $kfun src meta self)
(intmap-add representations self 'scm))