diff options
author | Andy Wingo <wingo@pobox.com> | 2023-08-28 12:03:17 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2023-08-28 12:11:19 +0200 |
commit | c2cba86785a34351788f52ea4fccf9f10f3a1dee (patch) | |
tree | 863e975d9d2728e52d242de954b96a5d71c4a668 /module/language | |
parent | a52c9cf7c3eefe05da23cd3233e1f9119eb14862 (diff) | |
download | guile-c2cba86785a34351788f52ea4fccf9f10f3a1dee.tar.gz |
Better compilation of calls to `raise-exception`
Recognize `raise-exception` in the same way we recognize `throw`, though
it is a bit less optimized and the boot story is not as complicated.
* doc/ref/vm.texi (Non-Local Control Flow Instructions):
* libguile/jit.c (compile_unreachable):
(compile_unreachable_slow):
* libguile/vm-engine.c (VM_NAME):
* module/language/cps/compile-bytecode.scm (compile-function):
* module/system/vm/assembler.scm (emit-unreachable): Add new
"unreachable" instruction, inserted after a call to non-continuable
`raise-exception`.
* module/language/tree-il/compile-cps.scm (raise-exception):
* module/language/tree-il/primitives.scm
(*interesting-primitive-names*): Recognize raise-exception, and if it is
called with just one argument, prune that branch of the control-flow
graph.
Diffstat (limited to 'module/language')
-rw-r--r-- | module/language/cps/compile-bytecode.scm | 4 | ||||
-rw-r--r-- | module/language/tree-il/compile-cps.scm | 27 | ||||
-rw-r--r-- | module/language/tree-il/primitives.scm | 2 |
3 files changed, 31 insertions, 2 deletions
diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm index d6d1737b3..ad5e0024d 100644 --- a/module/language/cps/compile-bytecode.scm +++ b/module/language/cps/compile-bytecode.scm @@ -417,7 +417,9 @@ (#('throw/value param (val)) (emit-throw/value asm (from-sp (slot val)) param)) (#('throw/value+data param (val)) - (emit-throw/value+data asm (from-sp (slot val)) param)))) + (emit-throw/value+data asm (from-sp (slot val)) param)) + (#('unreachable #f ()) + (emit-unreachable asm)))) (define (compile-prompt label k kh escape? tag) (let ((receive-args (gensym "handler")) diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm index ff22fa5ca..9ebdb72a3 100644 --- a/module/language/tree-il/compile-cps.scm +++ b/module/language/tree-il/compile-cps.scm @@ -1478,6 +1478,33 @@ use as the proc slot." (_ (fallback))))) (_ (fallback)))) +(define-custom-primcall-converter (raise-exception cps src args convert-args k) + ;; When called with just one arg, we know that raise-exception is + ;; non-continuing, and so we can prune the graph at its continuation. + ;; This improves flow analysis, because the path that leads to the + ;; raise-exception doesn't rejoin the graph. + (convert-args cps args + (lambda (cps args) + (define (maybe-prune-graph cps k) + (match args + ((_) + (with-cps cps + (letv vals) + (letk kunreachable ($kargs (#f) (vals) + ($throw src 'unreachable #f ()))) + (letk kret ($kreceive '() 'rest kunreachable)) + kret)) + (_ + (with-cps cps + k)))) + (with-cps cps + (letv prim) + (let$ k (maybe-prune-graph k)) + (letk kcall ($kargs ('prim) (prim) + ($continue k src ($call prim args)))) + (build-term + ($continue kcall src ($prim 'raise-exception))))))) + (define-custom-primcall-converter (values cps src args convert-args k) (convert-args cps args (lambda (cps args) diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index ef883ec9c..bcd2a1c05 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -95,7 +95,7 @@ abort-to-prompt* abort-to-prompt make-prompt-tag - throw error scm-error + throw error scm-error raise-exception string-length string-ref string-set! |