mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

More precise value representations for bv-contents, $code

Browse source 
* module/language/cps/utils.scm (compute-var-representations): $code
makes a 'code.  bv-contents makes a 'bv-contents.
* module/language/cps/slot-allocation.scm:
* module/language/cps/hoot/tailify.scm:
* module/system/vm/assembler.scm: Adapt.
This commit is contained in:
Andy Wingo 2023-07-04 15:21:33 +02:00
parent dc4fe9741f
commit 27669781b7
3 changed files with 11 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -54,7 +54,7 @@
(slots allocation-slots) (slots allocation-slots)
;; A map of VAR to representation. A representation is 'scm, 'f64, ;; A map of VAR to representation. A representation is 'scm, 'f64,
;; 'u64, or 's64. ;; 'u64, 's64, 'ptr, 'bv-contents, or 'code.
;; ;;
(representations allocation-representations) (representations allocation-representations)
@ -706,8 +706,10 @@ are comparable with eqv?. A tmp slot may be used."
(#f slot-map) (#f slot-map)
(slot (slot
(let ((desc (match (intmap-ref representations var) (let ((desc (match (intmap-ref representations var)
((or 'u64 'f64 's64 'ptr) slot-desc-live-raw) ((or 'u64 'f64 's64 'ptr 'bv-contents 'code)
('scm slot-desc-live-scm)))) slot-desc-live-raw)
('scm
slot-desc-live-scm))))
(logior slot-map (ash desc (* 2 slot))))))) (logior slot-map (ash desc (* 2 slot)))))))
live-vars 0)) live-vars 0))

8
module/language/cps/utils.scm
View file

@ -26,6 +26,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (system base target)
#:use-module (language cps) #:use-module (language cps)
#:use-module (language cps intset) #:use-module (language cps intset)
#:use-module (language cps intmap) #:use-module (language cps intmap)
@ -418,12 +419,13 @@ by a label, respectively."
'srsh 'srsh/immediate 'srsh 'srsh/immediate
's8-ref 's16-ref 's32-ref 's64-ref)) 's8-ref 's16-ref 's32-ref 's64-ref))
(intmap-add representations var 's64)) (intmap-add representations var 's64))
(($ $primcall (or 'bv-contents (($ $primcall (or 'pointer-ref/immediate
'pointer-ref/immediate
'tail-pointer-ref/immediate)) 'tail-pointer-ref/immediate))
(intmap-add representations var 'ptr)) (intmap-add representations var 'ptr))
(($ $primcall 'bv-contents)
(intmap-add representations var 'bv-contents))
(($ $code) (($ $code)
(intmap-add representations var 'ptr)) (intmap-add representations var 'code))
(_ (_
(intmap-add representations var 'scm)))) (intmap-add representations var 'scm))))
(vars (vars

2
module/system/vm/assembler.scm
View file

@ -2587,7 +2587,7 @@ procedure with label @var{rw-init}. @var{rw-init} may be false. If
((f64) 1) ((f64) 1)
((u64) 2) ((u64) 2)
((s64) 3) ((s64) 3)
((ptr) 4) ((ptr code) 4)
(else (error "what!" representation))))) (else (error "what!" representation)))))
(put-uleb128 names-port (logior (ash slot 3) tag))) (put-uleb128 names-port (logior (ash slot 3) tag)))
(lp definitions)))))) (lp definitions))))))