[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/13: Instruction explosion for struct-vtable
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/13: Instruction explosion for struct-vtable |
Date: |
Tue, 16 Jan 2018 10:46:29 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit c7b3379a4c2111a872992202895a7fa700fb252d
Author: Andy Wingo <address@hidden>
Date: Wed Jan 10 19:47:58 2018 +0100
Instruction explosion for struct-vtable
* module/language/tree-il/compile-cps.scm (ensure-struct): New helper.xo
(struct-vtable): New lowering procedure.
* module/language/cps/types.scm (annotation->type): Add struct.
(scm-ref/tag, scm-set!/tag): Fix to get type from annotation.
* module/language/cps/effects-analysis.scm (annotation->memory-kind):
Add struct.
---
module/language/cps/effects-analysis.scm | 3 ++-
module/language/cps/types.scm | 10 +++++++---
module/language/tree-il/compile-cps.scm | 26 ++++++++++++++++++++++++++
3 files changed, 35 insertions(+), 4 deletions(-)
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index c638de6..829db47 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -344,7 +344,8 @@ the LABELS that are clobbered by the effects of LABEL."
('pair &pair)
('vector &vector)
('box &box)
- ('closure &closure)))
+ ('closure &closure)
+ ('struct &struct)))
(define-primitive-effects* param
((allocate-words size) (&allocate (annotation->memory-kind param)))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index fc649b0..810ad15 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -728,7 +728,8 @@ minimum, and maximum."
('pair &pair)
('vector &vector)
('box &box)
- ('closure &procedure)))
+ ('closure &procedure)
+ ('struct &struct)))
(define-type-inferrer/param (allocate-words param size result)
(define! result (annotation->type param) (&min/0 size) (&max/scm-size size)))
@@ -749,8 +750,11 @@ minimum, and maximum."
(restrict! obj (annotation->type annotation) (1+ idx) +inf.0)
(define! result &all-types -inf.0 +inf.0))))
-(define-simple-type-inferrer (scm-ref/tag &pair) &all-types)
-(define-simple-type-inferrer (scm-set!/tag &pair &all-types))
+(define-type-inferrer/param (scm-ref/tag param obj result)
+ (restrict! obj (annotation->type param) -inf.0 +inf.0)
+ (define! result &all-types -inf.0 +inf.0))
+(define-type-inferrer/param (scm-set!/tag param obj val)
+ (restrict! obj (annotation->type param) -inf.0 +inf.0))
(define-type-inferrer/param (scm-set! param obj idx val)
(restrict! obj (annotation->type param) (1+ (&min/0 idx)) +inf.0))
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index 60a4072..03861a9 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -616,6 +616,32 @@
($continue k src
($primcall 'scm-set!/immediate '(box . 1) (box val)))))))))
+(define (ensure-struct cps src op x have-vtable)
+ (define not-struct
+ (vector 'wrong-type-arg
+ (symbol->string op)
+ "Wrong type argument in position 1 (expecting struct): ~S"))
+ (with-cps cps
+ (letv vtable)
+ (letk knot-struct
+ ($kargs () () ($throw src 'throw/value+data not-struct (x))))
+ (let$ body (have-vtable vtable))
+ (letk k ($kargs ('vtable) (vtable) ,body))
+ (letk kvtable ($kargs () ()
+ ($continue k src ($primcall 'scm-ref/tag 'struct (x)))))
+ (letk kheap-object
+ ($kargs () () ($branch knot-struct kvtable src 'struct? #f (x))))
+ (build-term ($branch knot-struct kheap-object src 'heap-object? #f (x)))))
+
+(define-primcall-converter struct-vtable
+ (lambda (cps k src op param struct)
+ (ensure-struct
+ cps src 'struct-vtable struct
+ (lambda (cps vtable)
+ (with-cps cps
+ (build-term
+ ($continue k src ($values (vtable)))))))))
+
(define-primcall-converters
(char->integer scm >u64)
(integer->char u64 >scm)
- [Guile-commits] branch master updated (02e52a4 -> 310c34e), Andy Wingo, 2018/01/16
- [Guile-commits] 11/13: Instruction explosion for bv-length, Andy Wingo, 2018/01/16
- [Guile-commits] 01/13: Instruction explosion for struct-vtable,
Andy Wingo <=
- [Guile-commits] 12/13: Remove optimizer and backend support for bv-u8-ref et al, Andy Wingo, 2018/01/16
- [Guile-commits] 02/13: Add support for raw gc-managed pointer locals, Andy Wingo, 2018/01/16
- [Guile-commits] 10/13: Add assume-u64 and assume-s64 dataflow restrictions, Andy Wingo, 2018/01/16
- [Guile-commits] 06/13: Custom bv-u8-ref lowering procedure, Andy Wingo, 2018/01/16
- [Guile-commits] 09/13: Instruction explosion for bytevector setters, Andy Wingo, 2018/01/16
- [Guile-commits] 07/13: Instruction explosion for integer bytevector ref procedures, Andy Wingo, 2018/01/16
- [Guile-commits] 03/13: Add optimizer and backend support for gc-pointer-ref, Andy Wingo, 2018/01/16
- [Guile-commits] 13/13: Remove bytevector instructions from the VM., Andy Wingo, 2018/01/16
- [Guile-commits] 08/13: Add f32-ref, f64-ref lowering procs, Andy Wingo, 2018/01/16
- [Guile-commits] 04/13: Add raw u8-ref, etc instructions, Andy Wingo, 2018/01/16