diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index 331e12a12..b0f6d655a 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -32,6 +32,9 @@ typedef scm_t_uint64 (*scm_t_u64_from_scm_intrinsic) (SCM); typedef scm_t_int64 (*scm_t_s64_from_scm_intrinsic) (SCM); typedef SCM (*scm_t_scm_from_u64_intrinsic) (scm_t_uint64); typedef SCM (*scm_t_scm_from_s64_intrinsic) (scm_t_int64); +typedef void (*scm_t_thread_scm_scm_intrinsic) (scm_i_thread*, SCM, SCM); +typedef void (*scm_t_thread_intrinsic) (scm_i_thread*); +typedef SCM (*scm_t_scm_from_thread_scm_intrinsic) (scm_i_thread*, SCM); #define SCM_FOR_ALL_VM_INTRINSICS(M) \ M(scm_from_scm_scm, add, "add", ADD) \ diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 256a2790c..19c263f2f 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -2255,9 +2255,52 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, NEXT (4); } - VM_DEFINE_OP (87, unused_87, NULL, NOP) - VM_DEFINE_OP (88, unused_88, NULL, NOP) - VM_DEFINE_OP (89, unused_89, NULL, NOP) + VM_DEFINE_OP (87, call_thread_scm_scm, "call-thread-scm-scm", OP2 (X8_S12_S12, C32)) + { + scm_t_uint16 a, b; + scm_t_thread_scm_scm_intrinsic intrinsic; + + UNPACK_12_12 (op, a, b); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + intrinsic (thread, SP_REF (a), SP_REF (b)); + CACHE_SP (); + + NEXT (2); + } + + VM_DEFINE_OP (88, call_thread, "call-thread", OP2 (X32, C32)) + { + scm_t_thread_intrinsic intrinsic; + + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + intrinsic (thread); + CACHE_SP (); + + NEXT (2); + } + + VM_DEFINE_OP (89, call_scm_from_thread_scm, "call-scm<-thread-scm", OP2 (X8_S12_S12, C32) | OP_DST) + { + scm_t_uint16 dst, src; + scm_t_scm_from_thread_scm_intrinsic intrinsic; + SCM res; + + UNPACK_12_12 (op, dst, src); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + res = intrinsic (thread, SP_REF (src)); + CACHE_SP (); + + SP_SET (dst, res); + + NEXT (2); + } + VM_DEFINE_OP (90, unused_90, NULL, NOP) VM_DEFINE_OP (91, unused_91, NULL, NOP) VM_DEFINE_OP (92, unused_92, NULL, NOP) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 6b249d4cf..973179ad4 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -909,6 +909,15 @@ later by the linker." (emit-push asm src) (encode-X8_S12_S12-C32 asm 0 0 c32 opcode) (emit-pop asm dst)))) +(define (encode-X8_S12_S12-C32!/shuffle asm a b c32 opcode) + (cond + ((< (logior a b) (ash 1 12)) + (encode-X8_S12_S12-C32 asm a b c32 opcode)) + (else + (emit-push asm a) + (emit-push asm b) + (encode-X8_S12_S12-C32 asm 1 0 c32 opcode) + (emit-drop asm 2)))) (eval-when (expand) (define (id-append ctx a b) @@ -931,6 +940,7 @@ later by the linker." (('<- '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_S12_S12 'C32) #'encode-X8_S12_S12-C32<-/shuffle) + (('! 'X8_S12_S12 'C32) #'encode-X8_S12_S12-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)))) @@ -1311,6 +1321,15 @@ returned instead." (define-syntax-rule (define-scm<-s64-intrinsic name) (define-macro-assembler (name asm dst src) (emit-call-scm<-s64 asm dst src (intrinsic-name->index 'name)))) +(define-syntax-rule (define-thread-scm-scm-intrinsic name) + (define-macro-assembler (name asm a b) + (emit-call-thread-scm-scm asm a b (intrinsic-name->index 'name)))) +(define-syntax-rule (define-thread-intrinsic name) + (define-macro-assembler (name asm) + (emit-call-thread asm (intrinsic-name->index 'name)))) +(define-syntax-rule (define-scm<-thread-scm-intrinsic name) + (define-macro-assembler (name asm dst src) + (emit-call-scm<-thread-scm asm dst src (intrinsic-name->index 'name)))) (define-scm<-scm-scm-intrinsic add) (define-scm<-scm-uimm-intrinsic add/immediate)