[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 08/24: Add string-set! intrinsic
From: |
Andy Wingo |
Subject: |
[Guile-commits] 08/24: Add string-set! intrinsic |
Date: |
Tue, 10 Apr 2018 13:24:13 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 0ae1e943d8fb9dd4417994f8bc5d128062cac0d5
Author: Andy Wingo <address@hidden>
Date: Tue Apr 10 11:51:31 2018 +0200
Add string-set! intrinsic
* libguile/intrinsics.c (string_set_x): New intrinsic.
(scm_bootstrap_intrinsics): Initialize intrinsic.
* libguile/intrinsics.h: Add string-set! intrinsic.
* libguile/vm-engine.c (call-scm-u64-u64): New intrinsic trampoline.
* module/system/vm/assembler.scm (encode-X8_S8_S8_S8-C32!/shuffle): New
shuffling encoder.
(define-scm-u64-u64-intrinsic): New helper.
---
libguile/intrinsics.c | 9 +++++++++
libguile/intrinsics.h | 2 ++
libguile/vm-engine.c | 15 ++++++++++++---
module/system/vm/assembler.scm | 14 ++++++++++++++
4 files changed, 37 insertions(+), 3 deletions(-)
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index 1778ea9..808708b 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -57,6 +57,14 @@ sub_immediate (SCM a, scm_t_uint8 b)
return scm_difference (a, scm_from_uint8 (b));
}
+static void
+string_set_x (SCM str, scm_t_uint64 idx, scm_t_uint64 ch)
+{
+ str = scm_i_string_start_writing (str);
+ scm_i_string_set_x (str, idx, ch);
+ scm_i_string_stop_writing ();
+}
+
void
scm_bootstrap_intrinsics (void)
{
@@ -72,6 +80,7 @@ scm_bootstrap_intrinsics (void)
scm_vm_intrinsics.logand = scm_logand;
scm_vm_intrinsics.logior = scm_logior;
scm_vm_intrinsics.logxor = scm_logxor;
+ scm_vm_intrinsics.string_set_x = string_set_x;
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_intrinsics",
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index 4ed6c54..5c0d790 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -25,6 +25,7 @@
typedef SCM (*scm_t_scm_from_scm_scm_intrinsic) (SCM, SCM);
typedef SCM (*scm_t_scm_from_scm_uimm_intrinsic) (SCM, scm_t_uint8);
+typedef void (*scm_t_scm_u64_u64_intrinsic) (SCM, scm_t_uint64, scm_t_uint64);
#define SCM_FOR_ALL_VM_INTRINSICS(M) \
M(scm_from_scm_scm, add, "add", ADD) \
@@ -39,6 +40,7 @@ typedef SCM (*scm_t_scm_from_scm_uimm_intrinsic) (SCM,
scm_t_uint8);
M(scm_from_scm_scm, logand, "logand", LOGAND) \
M(scm_from_scm_scm, logior, "logior", LOGIOR) \
M(scm_from_scm_scm, logxor, "logxor", LOGXOR) \
+ M(scm_u64_u64, string_set_x, "string-set!", STRING_SET_X) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index db4eb83..188d529 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -1538,10 +1538,19 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (2);
}
- VM_DEFINE_OP (53, unused_53, NULL, NOP)
+ VM_DEFINE_OP (53, call_scm_u64_u64, "call-scm-u64-u64", OP2 (X8_S8_S8_S8,
C32))
{
- vm_error_bad_instruction (op);
- abort (); /* never reached */
+ scm_t_uint8 a, b, c;
+ scm_t_scm_u64_u64_intrinsic intrinsic;
+
+ UNPACK_8_8_8 (op, a, b, c);
+ intrinsic = intrinsics[ip[1]];
+
+ SYNC_IP ();
+ intrinsic (SP_REF (a), SP_REF_U64 (b), SP_REF_U64 (c));
+ CACHE_SP ();
+
+ NEXT (2);
}
/* make-closure dst:24 offset:32 _:8 nfree:24
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index e1dd9e3..bb1b5a3 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -892,6 +892,16 @@ later by the linker."
(emit-push asm a)
(encode-X8_S8_S8_C8-C32 asm 0 0 const c32 opcode)
(emit-pop asm dst))))
+(define (encode-X8_S8_S8_S8-C32!/shuffle asm a b c c32 opcode)
+ (cond
+ ((< (logior a b c) (ash 1 8))
+ (encode-X8_S8_S8_S8-C32 asm a b c c32 opcode))
+ (else
+ (emit-push asm a)
+ (emit-push asm (+ b 1))
+ (emit-push asm (+ c 2))
+ (encode-X8_S8_S8_S8-C32 asm 2 1 0 c32 opcode)
+ (emit-drop asm 3))))
(eval-when (expand)
(define (id-append ctx a b)
@@ -912,6 +922,7 @@ later by the linker."
(('<- 'X8_S8_S8_C8) #'encode-X8_S8_S8_C8<-/shuffle)
(('<- 'X8_S8_S8_S8 'C32) #'encode-X8_S8_S8_S8-C32<-/shuffle)
(('<- 'X8_S8_S8_C8 'C32) #'encode-X8_S8_S8_C8-C32<-/shuffle)
+ (('! 'X8_S8_S8_C8 'C32) #'encode-X8_S8_S8_C8-C32!/shuffle)
(('! 'X8_S8_C8_S8) #'encode-X8_S8_C8_S8!/shuffle)
(('<- 'X8_S8_C8_S8) #'encode-X8_S8_C8_S8<-/shuffle)
(else (encoder-name operands))))
@@ -1270,6 +1281,9 @@ returned instead."
(define-syntax-rule (define-scm<-scm-uimm-intrinsic name)
(define-macro-assembler (name asm dst a b)
(emit-call-scm<-scm-uimm asm dst a b (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm-u64-u64-intrinsic name)
+ (define-macro-assembler (name asm a b c)
+ (emit-call-scm-u64-u64 asm a b c (intrinsic-name->index 'name))))
(define-scm<-scm-scm-intrinsic add)
(define-scm<-scm-uimm-intrinsic add/immediate)
- [Guile-commits] 23/24: Remove class-of opcode, (continued)
- [Guile-commits] 23/24: Remove class-of opcode, Andy Wingo, 2018/04/10
- [Guile-commits] 19/24: string->number, etc intrinsics, Andy Wingo, 2018/04/10
- [Guile-commits] 24/24: Remove load-typed-array, make-array opcodes, Andy Wingo, 2018/04/10
- [Guile-commits] 20/24: Remove string->number, etc opcodes, Andy Wingo, 2018/04/10
- [Guile-commits] 09/24: Explode "string-set!", Andy Wingo, 2018/04/10
- [Guile-commits] 14/24: Remove char->integer from VM, Andy Wingo, 2018/04/10
- [Guile-commits] 17/24: Add $code CPS expression type, Andy Wingo, 2018/04/10
- [Guile-commits] 15/24: Remove dead code in CPS converter, Andy Wingo, 2018/04/10
- [Guile-commits] 22/24: Class-of is intrinsic, Andy Wingo, 2018/04/10
- [Guile-commits] 18/24: Remove unused make-closure opcode., Andy Wingo, 2018/04/10
- [Guile-commits] 08/24: Add string-set! intrinsic,
Andy Wingo <=