mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Add support for dynamic-state-related intrinsics
* libguile/vm-engine.c (call-thread, call-thread-scm-scm) (call-scm<-thread-scm): New intrinsics. * module/system/vm/assembler.scm (define-thread-scm-scm-intrinsic) (define-thread-intrinsic, define-scm<-thread-scm-intrinsic): New helpers. (encode-X8_S12_S12-C32!/shuffle): New shuffler. * libguile/intrinsics.h: Add new intrinsic types.
This commit is contained in:
parent
c927ca7111
commit
4779a10223
3 changed files with 68 additions and 3 deletions
|
@ -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) \
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue