[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 06/24: Lower string-ref in CPS conversion
From: |
Andy Wingo |
Subject: |
[Guile-commits] 06/24: Lower string-ref in CPS conversion |
Date: |
Tue, 10 Apr 2018 13:24:13 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 7a109dddd7529d3f6532d32c20f97778caff0223
Author: Andy Wingo <address@hidden>
Date: Mon Apr 9 10:13:09 2018 +0200
Lower string-ref in CPS conversion
* module/language/cps/effects-analysis.scm (annotation->memory-kind):
* module/language/cps/types.scm (annotation->type): Hackily consider
stringbuf memory to be string memory.
* module/language/tree-il/compile-cps.scm (string-ref): Add horrible
lowering conversion for string-ref.
---
module/language/cps/effects-analysis.scm | 1 +
module/language/cps/types.scm | 1 +
module/language/tree-il/compile-cps.scm | 72 +++++++++++++++++++++++++++++++-
3 files changed, 73 insertions(+), 1 deletion(-)
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index 72589fe..9133b95 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -347,6 +347,7 @@ the LABELS that are clobbered by the effects of LABEL."
('pair &pair)
('vector &vector)
('string &string)
+ ('stringbuf &string)
('bytevector &bytevector)
('bitmask &bitmask)
('box &box)
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 72e5f94..e552a1a 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -728,6 +728,7 @@ minimum, and maximum."
('pair &pair)
('vector &vector)
('string &string)
+ ('stringbuf &string)
('bytevector &bytevector)
('box &box)
('closure &procedure)
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index c3d9c07..39d6a53 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -1188,11 +1188,81 @@
(build-term
($continue k src ($primcall 'u64->scm #f (ulen)))))))))
+(define-primcall-converter string-ref
+ (lambda (cps k src op param s idx)
+ (define out-of-range
+ #(out-of-range string-ref "Argument 2 out of range: ~S"))
+ (define stringbuf-f-wide #x400)
+ (ensure-string
+ cps src op s
+ (lambda (cps ulen)
+ (with-cps cps
+ (letv uidx start upos buf ptr tag mask bits uwpos u32 uchar)
+ (letk kout-of-range
+ ($kargs () ()
+ ($throw src 'throw/value+data out-of-range (idx))))
+ (letk kchar
+ ($kargs ('uchar) (uchar)
+ ($continue k src
+ ($primcall 'tag-char #f (uchar)))))
+ (letk kassume
+ ($kargs ('u32) (u32)
+ ($continue kchar src
+ ($primcall 'assume-u64 '(0 . #xffffff) (u32)))))
+ (letk kwideref
+ ($kargs ('uwpos) (uwpos)
+ ($continue kassume src
+ ($primcall 'u32-ref 'stringbuf (buf ptr uwpos)))))
+ (letk kwide
+ ($kargs () ()
+ ($continue kwideref src
+ ($primcall 'ulsh/immediate 2 (upos)))))
+ (letk knarrow
+ ($kargs () ()
+ ($continue kchar src
+ ($primcall 'u8-ref 'stringbuf (buf ptr upos)))))
+ (letk kcmp
+ ($kargs ('bits) (bits)
+ ($branch kwide knarrow src 'u64-imm-= 0 (bits))))
+ (letk kmask
+ ($kargs ('mask) (mask)
+ ($continue kcmp src
+ ($primcall 'ulogand #f (tag mask)))))
+ (letk ktag
+ ($kargs ('tag) (tag)
+ ($continue kmask src
+ ($primcall 'load-u64 stringbuf-f-wide ()))))
+ (letk kptr
+ ($kargs ('ptr) (ptr)
+ ($continue ktag src
+ ($primcall 'word-ref/immediate '(stringbuf . 0) (buf)))))
+ (letk kwidth
+ ($kargs ('buf) (buf)
+ ($continue kptr src
+ ($primcall 'tail-pointer-ref/immediate '(stringbuf . 2)
(buf)))))
+ (letk kbuf
+ ($kargs ('upos) (upos)
+ ($continue kwidth src
+ ($primcall 'scm-ref/immediate '(string . 1) (s)))))
+ (letk kadd
+ ($kargs ('start) (start)
+ ($continue kbuf src
+ ($primcall 'uadd #f (start uidx)))))
+ (letk kstart
+ ($kargs () ()
+ ($continue kadd src
+ ($primcall 'word-ref/immediate '(string . 2) (s)))))
+ (letk krange
+ ($kargs ('uidx) (uidx)
+ ($branch kout-of-range kstart src 'u64-< #f (uidx ulen))))
+ (build-term
+ ($continue krange src ($primcall 'scm->u64 #f (idx)))))))))
+
(define-primcall-converters
(char->integer scm >u64)
(integer->char u64 >scm)
- (string-ref scm u64 >scm) (string-set! scm u64 scm)
+ (string-set! scm u64 scm)
(rsh scm u64 >scm)
(lsh scm u64 >scm))
- [Guile-commits] branch master updated (98fc9c0 -> 59f1f5a), Andy Wingo, 2018/04/10
- [Guile-commits] 04/24: CPS conversion lowers string-length, Andy Wingo, 2018/04/10
- [Guile-commits] 10/24: Remove string-set! VM op, Andy Wingo, 2018/04/10
- [Guile-commits] 07/24: Remove now-unused string-length, string-ref, Andy Wingo, 2018/04/10
- [Guile-commits] 03/24: Remove specific instructions for add, etc from VM, Andy Wingo, 2018/04/10
- [Guile-commits] 06/24: Lower string-ref in CPS conversion,
Andy Wingo <=
- [Guile-commits] 11/24: Instruction explosion for integer->char, Andy Wingo, 2018/04/10
- [Guile-commits] 16/24: Add load-label instruction, Andy Wingo, 2018/04/10
- [Guile-commits] 21/24: Add string->number etc as macro instructions to reify-primitives, Andy Wingo, 2018/04/10
- [Guile-commits] 12/24: Remove integer->char op, Andy Wingo, 2018/04/10
- [Guile-commits] 13/24: Instruction explosion for char->integer, Andy Wingo, 2018/04/10
- [Guile-commits] 05/24: Add VM ops needed for string-ref, Andy Wingo, 2018/04/10
- [Guile-commits] 01/24: Add instrinsics to runtime, Andy Wingo, 2018/04/10
- [Guile-commits] 02/24: Compile some generic arithmetic to intrinsic calls, Andy Wingo, 2018/04/10
- [Guile-commits] 23/24: Remove class-of opcode, Andy Wingo, 2018/04/10
- [Guile-commits] 19/24: string->number, etc intrinsics, Andy Wingo, 2018/04/10