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

Tree-IL-to-CPS lowers to high-level object reprs: bytevectors

Browse source 
* module/language/tree-il/compile-cps.scm: Lower to bv-length,
bv-contents.
This commit is contained in:
Andy Wingo 2023-06-22 11:24:26 +02:00
parent e6bd13ea1e
commit d0677a362d
1 changed files with 8 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

23
module/language/tree-il/compile-cps.scm
View file

@ -737,7 +737,7 @@
(define (prepare-bytevector-access cps src op pred bv idx width
have-ptr-and-uidx)
(with-cps cps
(letv ulen rlen)
(letv rlen)
(let$ access
(untag-bytevector-index
src op idx rlen width
@ -748,17 +748,12 @@
(letk k ($kargs ('ptr) (ptr) ,body))
(build-term
($continue k src
($primcall 'pointer-ref/immediate '(bytevector . 2)
(bv))))))))
($primcall 'bv-contents #f (bv))))))))
(letk k ($kargs ('rlen) (rlen) ,access))
(letk kassume
($kargs ('ulen) (ulen)
($continue k src
($primcall 'assume-u64 `(0 . ,(target-max-size-t)) (ulen)))))
(letk klen
($kargs () ()
($continue kassume src
($primcall 'word-ref/immediate '(bytevector . 1) (bv)))))
($continue k src
($primcall 'bv-length #f (bv)))))
($ (ensure-bytevector klen src op pred bv))))
(define (bytevector-ref-converter scheme-name ptr-op width kind)
@ -912,17 +907,13 @@
(define-primcall-converter bv-length
(lambda (cps k src op param bv)
(with-cps cps
(letv ulen rlen)
(letv rlen)
(letk ktag ($kargs ('rlen) (rlen)
($continue k src ($primcall 'u64->scm #f (rlen)))))
(letk kassume
($kargs ('ulen) (ulen)
($continue ktag src
($primcall 'assume-u64 `(0 . ,(target-max-size-t)) (ulen)))))
(letk klen
($kargs () ()
($continue kassume src
($primcall 'word-ref/immediate '(bytevector . 1) (bv)))))
($continue ktag src
($primcall 'bv-length #f (bv)))))
($ (ensure-bytevector klen src op 'bytevector? bv)))))
(define-bytevector-ref-converters