diff options
author | Andy Wingo <wingo@pobox.com> | 2019-08-26 10:19:24 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2019-08-26 10:19:24 +0200 |
commit | b02d1b08d7d7f0eaafdd9dcfc3de3a139b25492e (patch) | |
tree | aa592b5ff98f92d9159a52cc662a4ed25c7f9f93 /module | |
parent | b959708114ad88c90cd77a08a9b9dcf6e0d4f446 (diff) | |
download | guile-b02d1b08d7d7f0eaafdd9dcfc3de3a139b25492e.tar.gz |
Compiler allocates boxed flonums in unmarked space
This fixes a bug whereby the compiler would sometimes allocate floats in
marked space.
* libguile/gc-inline.h (scm_inline_gc_malloc_pointerless_words): New
internal helper.
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS):
* libguile/intrinsics.c (allocate_pointerless_words):
(allocate_pointerless_words_with_freelist): New intrinsics.
* libguile/jit.c (compile_allocate_pointerless_words):
(compile_allocate_pointerless_words_immediate): New compilers.
* libguile/vm-engine.c (allocate_pointerless_words)
(allocate_pointerless_words_immediate): New opcodes.
* module/language/cps/compile-bytecode.scm (compile-function):
* module/language/cps/effects-analysis.scm (param):
* module/language/cps/reify-primitives.scm (reify-primitives):
* module/language/cps/specialize-primcalls.scm (specialize-primcalls):
* module/language/cps/types.scm (allocate-words):
(allocate-words/immediate):
* module/system/vm/assembler.scm (system): Add support for the new
opcodes.
Diffstat (limited to 'module')
-rw-r--r-- | module/language/cps/compile-bytecode.scm | 6 | ||||
-rw-r--r-- | module/language/cps/effects-analysis.scm | 7 | ||||
-rw-r--r-- | module/language/cps/reify-primitives.scm | 13 | ||||
-rw-r--r-- | module/language/cps/specialize-primcalls.scm | 2 | ||||
-rw-r--r-- | module/language/cps/types.scm | 4 | ||||
-rw-r--r-- | module/system/vm/assembler.scm | 2 |
6 files changed, 31 insertions, 3 deletions
diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm index ff593171b..6e7dab8ef 100644 --- a/module/language/cps/compile-bytecode.scm +++ b/module/language/cps/compile-bytecode.scm @@ -162,6 +162,12 @@ (emit-allocate-words asm (from-sp dst) (from-sp (slot nfields)))) (($ $primcall 'allocate-words/immediate (annotation . nfields)) (emit-allocate-words/immediate asm (from-sp dst) nfields)) + (($ $primcall 'allocate-pointerless-words annotation (nfields)) + (emit-allocate-pointerless-words asm (from-sp dst) + (from-sp (slot nfields)))) + (($ $primcall 'allocate-pointerless-words/immediate + (annotation . nfields)) + (emit-allocate-pointerless-words/immediate asm (from-sp dst) nfields)) (($ $primcall 'scm-ref annotation (obj idx)) (emit-scm-ref asm (from-sp dst) (from-sp (slot obj)) (from-sp (slot idx)))) diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm index f5d6bb534..03a8feac6 100644 --- a/module/language/cps/effects-analysis.scm +++ b/module/language/cps/effects-analysis.scm @@ -363,6 +363,13 @@ the LABELS that are clobbered by the effects of LABEL." ((ann . size) (&allocate (annotation->memory-kind ann))))) + ((allocate-pointerless-words size) + (&allocate (annotation->memory-kind param))) + ((allocate-pointerless-words/immediate) + (match param + ((ann . size) + (&allocate + (annotation->memory-kind ann))))) ((scm-ref obj idx) (&read-object (annotation->memory-kind param))) ((scm-ref/tag obj) (&read-field diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm index 547ea59ee..8165fb2f0 100644 --- a/module/language/cps/reify-primitives.scm +++ b/module/language/cps/reify-primitives.scm @@ -416,7 +416,7 @@ ($primcall 'load-u64 %tc16-flonum ())))) (setk label ($kargs names vars ($continue ktag0 src - ($primcall 'allocate-words/immediate + ($primcall 'allocate-pointerless-words/immediate `(flonum . ,(match (target-word-size) (4 4) (8 2))) @@ -507,7 +507,14 @@ ;; ((ulsh/immediate (u6? y) x) (ulsh x y)) (_ (match (cons name args) - (('allocate-words/immediate) + (((or 'allocate-words/immediate + 'allocate-pointerless-words/immediate)) + (define op + (match name + ('allocate-words/immediate + 'allocate-words) + ('allocate-pointerless-words/immediate + 'allocate-pointerless-words))) (match param ((ann . n) (if (u8? n) @@ -516,7 +523,7 @@ (letv n*) (letk kop ($kargs ('n) (n*) ($continue k src - ($primcall 'allocate-words ann (n*))))) + ($primcall op ann (n*))))) (setk label ($kargs names vars ($continue kop src ($primcall 'load-u64 n ()))))))))) diff --git a/module/language/cps/specialize-primcalls.scm b/module/language/cps/specialize-primcalls.scm index 51c10a2ff..6410d80ec 100644 --- a/module/language/cps/specialize-primcalls.scm +++ b/module/language/cps/specialize-primcalls.scm @@ -122,6 +122,8 @@ (_ #f))) (specialize-case (('allocate-words (? uint? n)) (allocate-words/immediate n ())) + (('allocate-pointerless-words (? uint? n)) + (allocate-pointerless-words/immediate n ())) (('scm-ref o (? uint? i)) (scm-ref/immediate i (o))) (('scm-set! o (? uint? i) x) (scm-set!/immediate i (o x))) ;; Assume (tail-)pointer-ref/immediate can always be emitted directly. diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm index cf2fe912a..0a06eb0b9 100644 --- a/module/language/cps/types.scm +++ b/module/language/cps/types.scm @@ -742,6 +742,10 @@ minimum, and maximum." ((annotation . size) (define! result (annotation->type annotation) size size)))) +(define-type-inferrer-aliases allocate-words allocate-pointerless-words) +(define-type-inferrer-aliases allocate-words/immediate + allocate-pointerless-words/immediate) + (define-type-inferrer/param (scm-ref param obj idx result) (restrict! obj (annotation->type param) (1+ (&min/0 idx)) (target-max-size-t/scm)) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index cb4311093..a09e5f600 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -144,6 +144,8 @@ emit-allocate-words emit-allocate-words/immediate + emit-allocate-pointerless-words + emit-allocate-pointerless-words/immediate emit-scm-ref emit-scm-set! |