[Guile-commits] branch main updated (5b0c261b0 -> 5959531c5)
wingo pushed a change to branch main in repository guile. from 5b0c261b0 Mark symbol-hash primcall as having unboxed result new 4d834bdc1 Add logand/immediate, ulogand/immediate primcalls new 5959531c5 Allow target runtime to override symbol hash The 2 revisions listed above as "new" are entirely new to this repository and will be described in separate emails. The revisions listed as "add" were already present in the repository and have only been added to this reference. Summary of changes: libguile/hash.c | 4 +- libguile/jit.c| 19 ++ libguile/loader.h | 4 +- libguile/vm-engine.c | 17 +- module/language/cps/compile-bytecode.scm | 2 + module/language/cps/effects-analysis.scm | 2 + module/language/cps/guile-vm.scm | 71 ++- module/language/cps/guile-vm/lower-primcalls.scm | 30 +++--- module/language/cps/guile-vm/reify-primitives.scm | 25 +--- module/language/cps/specialize-numbers.scm| 14 - module/language/cps/switch.scm| 63 +--- module/language/cps/types.scm | 14 + module/language/cps/utils.scm | 1 + module/language/tree-il/compile-cps.scm | 4 ++ module/system/vm/assembler.scm| 3 +- 15 files changed, 203 insertions(+), 70 deletions(-)
[Guile-commits] 01/02: Add logand/immediate, ulogand/immediate primcalls
wingo pushed a commit to branch main
in repository guile.
commit 4d834bdc12acef0f7353da8a22ef0480f818bdb8
Author: Andy Wingo
AuthorDate: Mon Nov 20 13:17:42 2023 +0100
Add logand/immediate, ulogand/immediate primcalls
* libguile/jit.c (compile_ulogand_immediate, compile_ulogand_immediate_slow)
* libguile/vm-engine.c (ulogand_immediate): New JIT and interpreter
support for ulogand/immediate.
* module/language/cps/guile-vm/lower-primcalls.scm (string-ref):
(vtable-vtable?):
(vtable-field-boxed?): Emit ulogand/immediate.
* module/language/cps/guile-vm/reify-primitives.scm (reify-primitives):
Remove logand/immediate. Only emit ulogand/immediate if the immediate
is a u8. Refactor mul/immediate.
* module/language/cps/specialize-numbers.scm (specialize-operations):
Produce ulogand/immediate if the result is a u64.
* module/language/cps/effects-analysis.scm:
* module/language/cps/types.scm (logand/immediate): Add effect and type
inference for logand/immediate, ulogand/immediate,
* module/language/cps/utils.scm (primcall-raw-representations):
ulogand/immediate makes a u64.
* module/language/tree-il/compile-cps.scm (convert): Generate
logand/immediate if possible.
* module/language/cps/compile-bytecode.scm (compile-function):
* module/system/vm/assembler.scm (system): Add ulogand/immediate
emitter.
* libguile/loader.h (SCM_OBJCODE_MINOR_VERSION): Bump.
---
libguile/jit.c| 19 ++
libguile/loader.h | 4 +--
libguile/vm-engine.c | 17 -
module/language/cps/compile-bytecode.scm | 2 ++
module/language/cps/effects-analysis.scm | 2 ++
module/language/cps/guile-vm/lower-primcalls.scm | 30 +++
module/language/cps/guile-vm/reify-primitives.scm | 25 +--
module/language/cps/specialize-numbers.scm| 14 ++-
module/language/cps/types.scm | 14 +++
module/language/cps/utils.scm | 1 +
module/language/tree-il/compile-cps.scm | 4 +++
module/system/vm/assembler.scm| 3 ++-
12 files changed, 101 insertions(+), 34 deletions(-)
diff --git a/libguile/jit.c b/libguile/jit.c
index d582893d7..6f3a650b8 100644
--- a/libguile/jit.c
+++ b/libguile/jit.c
@@ -3529,6 +3529,25 @@ compile_ulogand_slow (scm_jit_state *j, uint32_t dst,
uint32_t a, uint32_t b)
{
}
+static void
+compile_ulogand_immediate (scm_jit_state *j, uint32_t dst, uint32_t a,
uint32_t b)
+{
+#if SIZEOF_UINTPTR_T >= 8
+ emit_sp_ref_u64 (j, T0, a);
+ emit_andi (j, T0, T0, b);
+ emit_sp_set_u64 (j, dst, T0);
+#else
+ emit_sp_ref_u64 (j, T0, T1, a);
+ emit_andi (j, T0, T0, b);
+ emit_andi (j, T1, T1, 0);
+ emit_sp_set_u64 (j, dst, T0, T1);
+#endif
+}
+static void
+compile_ulogand_immediate_slow (scm_jit_state *j, uint32_t dst, uint32_t a,
uint32_t b)
+{
+}
+
static void
compile_ulogior (scm_jit_state *j, uint32_t dst, uint32_t a, uint32_t b)
{
diff --git a/libguile/loader.h b/libguile/loader.h
index 28452a1c7..42c98fcca 100644
--- a/libguile/loader.h
+++ b/libguile/loader.h
@@ -1,4 +1,4 @@
-/* Copyright 2001,2009-2015,2018,2020,2021
+/* Copyright 2001,2009-2015,2018,2020,2021,2023
Free Software Foundation, Inc.
This file is part of Guile.
@@ -40,7 +40,7 @@
/* Major and minor versions must be single characters. */
#define SCM_OBJCODE_MAJOR_VERSION 4
#define SCM_OBJCODE_MINIMUM_MINOR_VERSION 2
-#define SCM_OBJCODE_MINOR_VERSION 6
+#define SCM_OBJCODE_MINOR_VERSION 7
#define SCM_OBJCODE_MAJOR_VERSION_STRING\
SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
#define SCM_OBJCODE_MINOR_VERSION_STRING\
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 7f41f3932..e2ea81190 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -3489,7 +3489,22 @@ VM_NAME (scm_thread *thread)
abort (); /* never reached */
}
- VM_DEFINE_OP (168, unused_168, NULL, NOP)
+ /* ulogand/immediate dst:8 src:8 imm:8
+ *
+ * Place the bitwise AND of the u64 value SRC with the immediate IMM
+ * into DST.
+ */
+ VM_DEFINE_OP (168, ulogand_immediate, "ulogand/immediate", DOP1
(X8_S8_S8_C8))
+{
+ uint8_t dst, src, imm;
+ uint64_t x;
+
+ UNPACK_8_8_8 (op, dst, src, imm);
+ x = SP_REF_U64 (src);
+ SP_SET_U64 (dst, x & (uint64_t) imm);
+ NEXT (1);
+}
+
VM_DEFINE_OP (169, unused_169, NULL, NOP)
VM_DEFINE_OP (170, unused_170, NULL, NOP)
VM_DEFINE_OP (171, unused_171, NULL, NOP)
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index ad5e0024d..1756274c6 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -252,6 +252,8 @@
(emit-srsh/immediate asm (from-sp dst) (from-sp
[Guile-commits] 02/02: Allow target runtime to override symbol hash
wingo pushed a commit to branch main
in repository guile.
commit 5959531c54d1a164e638731b8d79633f454a3dbd
Author: Andy Wingo
AuthorDate: Mon Nov 20 14:07:03 2023 +0100
Allow target runtime to override symbol hash
Also rework so that the symbol hash uses the low bits instead of high
bits. We can do this because, for the guile-vm target, now we compute
the full target hash.
* module/language/cps/guile-vm.scm (jenkins-lookup3-hashword2):
(target-symbol-hash, target-symbol-hash-bits): New exported functions..
* module/language/cps/switch.scm (optimize-branch-chain): Change to use
target-symbol-hash and target-symbol-hash-bits from the current
target-runtime.
---
libguile/hash.c | 4 ++-
module/language/cps/guile-vm.scm | 71 +++-
module/language/cps/switch.scm | 63 ---
3 files changed, 102 insertions(+), 36 deletions(-)
diff --git a/libguile/hash.c b/libguile/hash.c
index 5abdfe397..a038a11bf 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1997,2000-2001,2003-2004,2006,2008-2015,2017-2018,2020
+/* Copyright 1995-1997,2000-2001,2003-2004,2006,2008-2015,2017-2018,2020,2023
Free Software Foundation, Inc.
This file is part of Guile.
@@ -136,6 +136,8 @@ wide_string_hash (const scm_t_wchar *str, size_t len)
return ret;
}
+/* If you change this to a different hash, also update (language cps
+ guile-vm). */
unsigned long
scm_i_string_hash (SCM str)
{
diff --git a/module/language/cps/guile-vm.scm b/module/language/cps/guile-vm.scm
index f330128f2..772783349 100644
--- a/module/language/cps/guile-vm.scm
+++ b/module/language/cps/guile-vm.scm
@@ -27,8 +27,77 @@
#:use-module (language cps guile-vm loop-instrumentation)
#:use-module (language cps guile-vm lower-primcalls)
#:use-module (language cps guile-vm reify-primitives)
+ #:use-module (system base target)
#:export (make-lowerer
-available-optimizations))
+available-optimizations
+target-symbol-hash
+target-symbol-hash-bits))
+
+;; This hash function is originally from
+;; http://burtleburtle.net/bob/c/lookup3.c by Bob Jenkins, May 2006,
+;; Public Domain. No warranty.
+(define (jenkins-lookup3-hashword2 str)
+ (define (u32 x) (logand x #x))
+ (define (shl x n) (u32 (ash x n)))
+ (define (shr x n) (ash x (- n)))
+ (define (rot x n) (logior (shl x n) (shr x (- 32 n
+ (define (add x y) (u32 (+ x y)))
+ (define (sub x y) (u32 (- x y)))
+ (define (xor x y) (logxor x y))
+
+ (define (mix a b c)
+(let* ((a (sub a c)) (a (xor a (rot c 4))) (c (add c b))
+ (b (sub b a)) (b (xor b (rot a 6))) (a (add a c))
+ (c (sub c b)) (c (xor c (rot b 8))) (b (add b a))
+ (a (sub a c)) (a (xor a (rot c 16))) (c (add c b))
+ (b (sub b a)) (b (xor b (rot a 19))) (a (add a c))
+ (c (sub c b)) (c (xor c (rot b 4))) (b (add b a)))
+ (values a b c)))
+ (define (final a b c)
+(let* ((c (xor c b)) (c (sub c (rot b 14)))
+ (a (xor a c)) (a (sub a (rot c 11)))
+ (b (xor b a)) (b (sub b (rot a 25)))
+ (c (xor c b)) (c (sub c (rot b 16)))
+ (a (xor a c)) (a (sub a (rot c 4)))
+ (b (xor b a)) (b (sub b (rot a 14)))
+ (c (xor c b)) (c (sub c (rot b 24
+ (values a b c)))
+
+ (define len (string-length str))
+ (define (add-char x index)
+(add x (char->integer (string-ref str index
+
+ (let ((init (add #xdeadbeef (add (shl len 2) 47
+(let lp ((i 0) (a init) (b init) (c init))
+ (let ((remaining (- len i)))
+(cond
+ ((< 3 remaining)
+ (call-with-values (lambda ()
+ (mix (add-char a i)
+ (add-char b (+ i 1))
+ (add-char c (+ i 2
+(lambda (a b c)
+ (lp (+ i 3) a b c
+ (else
+ (let* ((a (if (<= 1 remaining) (add-char a i) a))
+ (b (if (<= 2 remaining) (add-char b (+ i 1)) b))
+ (c (if (<= 3 remaining) (add-char c (+ i 2)) c)))
+(final a b c
+
+(define (target-symbol-hash str)
+ (call-with-values (lambda () (jenkins-lookup3-hashword2 str))
+(lambda (a b c)
+ ;; The high 32 bits of the hash on a 64-bit platform are
+ ;; equivalent to the hash on a 32-bit platform. The top two bits
+ ;; are zero to allow the hash to fit in a fixnum.
+ (ash (case (target-word-size)
+ ((4) c)
+ ((8) (logior (ash c 32) b))
+ (else (error "unexpected target word size" (target-word-size
+ -2
+
+(define target-symbol-hash-bits
+ (- (* (target-word-size) 8) 2))
(define (make-lowerer optimization-level opts)
(lambda (exp env)
diff --git a/module/language/cps/switch.scm
[Guile-commits] 02/02: Fix bug lowering logand/immediate to ulogand/immediate
wingo pushed a commit to branch main
in repository guile.
commit d579848cb5d65440af5afd9c8968628665554c22
Author: Andy Wingo
AuthorDate: Mon Nov 20 16:45:35 2023 +0100
Fix bug lowering logand/immediate to ulogand/immediate
* module/language/cps/specialize-numbers.scm (logand/immediate): Define
a sigbits handler.
(specialize-operations): Require logand/immediate operand to be u64 to
lower to ulogand/immediate. Shouldn't be necessary but even if only u64
bits are used, negative fixnums will have the sign bit set, which trips
up further unboxed uses which error if the operand to `scm->u64` is
negative.
* module/language/cps/type-fold.scm (rem): Emit logand/immediate.
---
module/language/cps/specialize-numbers.scm | 13 +
module/language/cps/type-fold.scm | 16
2 files changed, 13 insertions(+), 16 deletions(-)
diff --git a/module/language/cps/specialize-numbers.scm
b/module/language/cps/specialize-numbers.scm
index 12c9deecc..4ec88871c 100644
--- a/module/language/cps/specialize-numbers.scm
+++ b/module/language/cps/specialize-numbers.scm
@@ -284,18 +284,23 @@
(define significant-bits-handlers (make-hash-table))
(define-syntax-rule (define-significant-bits-handler
- ((primop label types out def ...) arg ...)
+ ((primop label types out def ...) param arg ...)
body ...)
(hashq-set! significant-bits-handlers 'primop
(lambda (label types out param args defs)
(match args ((arg ...) (match defs ((def ...) body ...)))
-(define-significant-bits-handler ((logand label types out res) a b)
+(define-significant-bits-handler ((logand label types out res) param a b)
(let ((sigbits (sigbits-intersect3 (inferred-sigbits types label a)
(inferred-sigbits types label b)
(intmap-ref out res (lambda (_) 0)
(intmap-add (intmap-add out a sigbits sigbits-union)
b sigbits sigbits-union)))
+(define-significant-bits-handler ((logand/immediate label types out res) param
a)
+ (let ((sigbits (sigbits-intersect3 (inferred-sigbits types label a)
+ param
+ (intmap-ref out res (lambda (_) 0)
+(intmap-add out a sigbits sigbits-union)))
(define (significant-bits-handler primop)
(hashq-ref significant-bits-handlers primop))
@@ -556,11 +561,11 @@ BITS indicating the significant bits needed for a
variable. BITS may be
(specialize-unop cps k src op param a
(unbox-u64 a) (box-u64 result
- (('logand/immediate (? u64-result? ) param a)
+ (('logand/immediate (? u64-result? ) param (? u64-operand? a))
(specialize-unop cps k src 'ulogand/immediate
(logand param (1- (ash 1 64)))
a
- (unbox-u64/truncate a) (box-u64 result)))
+ (unbox-u64 a) (box-u64 result)))
(((or 'add/immediate 'sub/immediate 'mul/immediate)
(? s64-result?) (? s64-parameter?) (? s64-operand? a))
diff --git a/module/language/cps/type-fold.scm
b/module/language/cps/type-fold.scm
index a07950d81..63d47db8f 100644
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -692,13 +692,9 @@
((and (eqv? type1 ) (eqv? min1 max1) (power-of-two? min1)
(<= 0 min0))
(with-cps cps
- (letv mask)
- (letk kmask
-($kargs ('mask) (mask)
- ($continue k src
-($primcall 'logand #f (arg0 mask)
(build-term
-($continue kmask src ($const (1- min1))
+($continue k src
+ ($primcall 'logand/immediate (1- min1) (arg0))
(else
(with-cps cps #f
@@ -710,13 +706,9 @@
(with-cps cps #f))
((and (eqv? type1 ) (eqv? min1 max1) (power-of-two? min1))
(with-cps cps
- (letv mask)
- (letk kmask
-($kargs ('mask) (mask)
- ($continue k src
-($primcall 'logand #f (arg0 mask)
(build-term
-($continue kmask src ($const (1- min1))
+($continue k src
+ ($primcall 'logand/immediate (1- min1) (arg0))
(else
(with-cps cps #f
[Guile-commits] 01/02: Fix mistype in specialize-numbers
wingo pushed a commit to branch main in repository guile. commit 89501a83ceec5ac4d3449e92ba2109fb77448b31 Author: Andy Wingo AuthorDate: Mon Nov 20 15:11:08 2023 +0100 Fix mistype in specialize-numbers * module/language/cps/specialize-numbers.scm (compute-specializable-u64-vars): We were failing to match scm->u64/truncate. --- module/language/cps/specialize-numbers.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm index c7bb334bc..12c9deecc 100644 --- a/module/language/cps/specialize-numbers.scm +++ b/module/language/cps/specialize-numbers.scm @@ -846,7 +846,7 @@ BITS indicating the significant bits needed for a variable. BITS may be (_ #f))) (compute-specializable-vars cps body preds defs exp-result-u64? - '(scm->u64 'scm->u64/truncate))) + '(scm->u64 scm->u64/truncate))) ;; Compute vars whose definitions are all exact integers in the fixnum ;; range and whose uses include an untag operation.
[Guile-commits] branch main updated (5959531c5 -> d579848cb)
wingo pushed a change to branch main in repository guile. from 5959531c5 Allow target runtime to override symbol hash new 89501a83c Fix mistype in specialize-numbers new d579848cb Fix bug lowering logand/immediate to ulogand/immediate The 2 revisions listed above as "new" are entirely new to this repository and will be described in separate emails. The revisions listed as "add" were already present in the repository and have only been added to this reference. Summary of changes: module/language/cps/specialize-numbers.scm | 15 ++- module/language/cps/type-fold.scm | 16 2 files changed, 14 insertions(+), 17 deletions(-)
