wingo pushed a commit to branch master in repository guile. commit 0ae1e943d8fb9dd4417994f8bc5d128062cac0d5 Author: Andy Wingo <wi...@pobox.com> 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)