mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 02:00:26 +02:00
Code Activity

Simplify module variable lookup slow-path

Browse source 
* libguile/intrinsics.h:
* libguile/intrinsics.c (lookup_bound_public, lookup_bound_private): Two
new intrinsics.
(scm_bootstrap_intrinsics): Wire them up.
* libguile/jit.c (compile_call_scm_from_scmn_scmn):
(compile_call_scm_from_scmn_scmn_slow):
(COMPILE_X8_S24__N32__N32__C32): Add JIT support for new instruction
kind.
* libguile/vm-engine.c (call-scm<-scmn-scmn): New instruction, takes
arguments as non-immediate offsets, to avoid needless loads and register
pressure.
* module/language/cps/effects-analysis.scm: Add cases for new
primcalls.
* module/language/cps/compile-bytecode.scm (compile-function): Add new
primcalls.
* module/language/cps/reify-primitives.scm (cached-module-box): If the
variable is bound, call lookup-bound-public / lookup-bound-private as
appropriate instead of separately resolving the module, name, and doing
the bound check.
* module/language/tree-il/compile-bytecode.scm (emit-cached-module-box):
Use new instructions.
* module/system/vm/assembler.scm (define-scm<-scmn-scmn-intrinsic):
(lookup-bound-public, lookup-bound-private): Add assembler support.
This commit is contained in:
Andy Wingo 2021-04-26 09:36:56 +02:00
parent 976433d667
commit 83023160b1
9 changed files with 152 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/language/cps/compile-bytecode.scm
View file

@ -195,6 +195,12 @@
(($ $primcall 'lookup-bound #f (mod name))
(emit-lookup-bound asm (from-sp dst) (from-sp (slot mod))
(from-sp (slot name))))
(($ $primcall 'lookup-bound-public (mod name) ())
(let ((name (symbol->string name)))
(emit-lookup-bound-public asm (from-sp dst) mod name)))
(($ $primcall 'lookup-bound-private (mod name) ())
(let ((name (symbol->string name)))
(emit-lookup-bound-private asm (from-sp dst) mod name)))
(($ $primcall 'add/immediate y (x))
(emit-add/immediate asm (from-sp dst) (from-sp (slot x)) y))
(($ $primcall 'sub/immediate y (x))

4
module/language/cps/effects-analysis.scm
View file

@ -1,6 +1,6 @@
;;; Effects analysis on CPS
;; Copyright (C) 2011-2015,2017-2020 Free Software Foundation, Inc.
;; Copyright (C) 2011-2015,2017-2021 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -485,6 +485,8 @@ the LABELS that are clobbered by the effects of LABEL."
((module-variable mod name) (&read-object &module) &type-check)
((lookup mod name) (&read-object &module) &type-check)
((lookup-bound mod name) (&read-object &module) &type-check)
((lookup-bound-public) &type-check)
((lookup-bound-private) &type-check)
((cached-toplevel-box) &type-check)
((cached-module-box) &type-check)
((define! mod name) (&read-object &module)))

25
module/language/cps/reify-primitives.scm
View file

@ -223,6 +223,28 @@
(define-ephemeral (cached-module-box cps k src param)
(match param
((module name public? #t)
(let ((cache-key param))
(with-cps cps
(letv cached var)
(letk k* ($kargs () () ($continue k src ($values (var)))))
(letk kcache ($kargs ('var) (var)
($continue k* src
($primcall 'cache-set! cache-key (var)))))
(letk kinit ($kargs () ()
($continue kcache src
($primcall (if public?
'lookup-bound-public
'lookup-bound-private)
(list module name) ()))))
(letk kok ($kargs () ()
($continue k src ($values (cached)))))
(letk ktest
($kargs ('cached) (cached)
($branch kinit kok src 'heap-object? #f (cached))))
(build-term
($continue ktest src
($primcall 'cache-ref cache-key ()))))))
((module name public? bound?)
(let ((cache-key param))
(with-cps cps
@ -335,7 +357,8 @@
lsh rsh lsh/immediate rsh/immediate
cache-ref cache-set!
current-module resolve-module
module-variable lookup lookup-bound define!))
module-variable define!
lookup lookup-bound lookup-bound-public lookup-bound-private))
(let ((table (make-hash-table)))
(for-each
(match-lambda ((inst . _) (hashq-set! table inst #t)))

19
module/language/tree-il/compile-bytecode.scm
View file

@ -1,6 +1,6 @@
;;; Lightweight compiler directly from Tree-IL to bytecode
;; Copyright (C) 2020 Free Software Foundation, Inc.
;; Copyright (C) 2020, 2021 Free Software Foundation, Inc.
;;; This library is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU Lesser General Public License as published by
@ -75,12 +75,17 @@
(emit-cache-ref asm dst key)
(emit-heap-object? asm dst)
(emit-je asm cached)
(emit-load-constant asm dst mod)
(emit-resolve-module asm dst dst public?)
(emit-load-constant asm tmp name)
(if bound?
(emit-lookup-bound asm dst dst tmp)
(emit-lookup asm dst dst tmp))
(cond
(bound?
(let ((name (symbol->string name)))
(if public?
(emit-lookup-bound-public asm dst mod name)
(emit-lookup-bound-private asm dst mod name))))
(else
(emit-load-constant asm dst mod)
(emit-resolve-module asm dst dst public?)
(emit-load-constant asm tmp name)
(emit-lookup asm dst dst tmp)))
(emit-cache-set! asm key dst)
(emit-label asm cached))
(define (emit-cached-toplevel-box asm dst scope name bound? tmp)

11
module/system/vm/assembler.scm
View file

@ -254,6 +254,8 @@
emit-module-variable
emit-lookup
emit-lookup-bound
emit-lookup-bound-public
emit-lookup-bound-private
emit-define!
emit-current-module
@ -1495,6 +1497,13 @@ returned instead."
(define-syntax-rule (define-scm-scm-scm-intrinsic name)
(define-macro-assembler (name asm a b c)
(emit-call-scm-scm-scm asm a b c (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm<-scmn-scmn-intrinsic name)
(define-macro-assembler (name asm dst a b)
(unless (statically-allocatable? a) (error "not statically allocatable" a))
(unless (statically-allocatable? b) (error "not statically allocatable" b))
(let ((a (intern-constant asm a))
(b (intern-constant asm b)))
(emit-call-scm<-scmn-scmn asm dst a b (intrinsic-name->index 'name)))))
(define-scm<-scm-scm-intrinsic add)
(define-scm<-scm-uimm-intrinsic add/immediate)
@ -1559,6 +1568,8 @@ returned instead."
(define-scm<-scm-scm-intrinsic module-variable)
(define-scm<-scm-scm-intrinsic lookup)
(define-scm<-scm-scm-intrinsic lookup-bound)
(define-scm<-scmn-scmn-intrinsic lookup-bound-public)
(define-scm<-scmn-scmn-intrinsic lookup-bound-private)
(define-scm<-scm-scm-intrinsic define!)
(define-scm<-thread-intrinsic current-module)