mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-02 21:10:27 +02:00
scm->u64, scm->s64, scm->u64/truncate intrinsics
* libguile/intrinsics.c (scm_to_uint64_truncate): New intrinsic. (scm_bootstrap_intrinsics): Init new intrinsics. * libguile/intrinsics.h: Add scm->u64, scm->u64/truncate, and scm->s64 as intrinsics, with their corresponding types. * libguile/vm-engine.c (call-u64<-scm, call-s64<-scm): New intrinsic calling ops. (scm->u64, scm->s64, scm->u64/truncate): Disable opcodes. * module/language/cps/reify-primitives.scm (compute-known-primitives): Add intrinsics as new macroinstructions. * module/system/vm/assembler.scm: Declare new intrinsic assemblers.
This commit is contained in:
Andy Wingo
parent
2db7c2df64
commit
dd88fc569d
5 changed files with 66 additions and 24 deletions
|
|
@ -71,6 +71,15 @@ string_to_number (SCM str)
|
|||
return scm_string_to_number (str, SCM_UNDEFINED /* radix = 10 */);
|
||||
}
|
||||
|
||||
static scm_t_uint64
|
||||
scm_to_uint64_truncate (SCM x)
|
||||
{
|
||||
if (SCM_I_INUMP (x))
|
||||
return (scm_t_uint64) SCM_I_INUM (x);
|
||||
else
|
||||
return scm_to_uint64 (scm_logand (x, scm_from_uint64 ((scm_t_uint64) -1)));
|
||||
}
|
||||
|
||||
void
|
||||
scm_bootstrap_intrinsics (void)
|
||||
{
|
||||
|
|
@ -92,6 +101,9 @@ scm_bootstrap_intrinsics (void)
|
|||
scm_vm_intrinsics.symbol_to_keyword = scm_symbol_to_keyword;
|
||||
scm_vm_intrinsics.class_of = scm_class_of;
|
||||
scm_vm_intrinsics.scm_to_f64 = scm_to_double;
|
||||
scm_vm_intrinsics.scm_to_u64 = scm_to_uint64;
|
||||
scm_vm_intrinsics.scm_to_u64_truncate = scm_to_uint64_truncate;
|
||||
scm_vm_intrinsics.scm_to_s64 = scm_to_int64;
|
||||
|
||||
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
|
||||
"scm_init_intrinsics",
|
||||
|
|
|
|||
|
|
@ -28,6 +28,8 @@ 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);
|
||||
typedef SCM (*scm_t_scm_from_scm_intrinsic) (SCM);
|
||||
typedef double (*scm_t_f64_from_scm_intrinsic) (SCM);
|
||||
typedef scm_t_uint64 (*scm_t_u64_from_scm_intrinsic) (SCM);
|
||||
typedef scm_t_int64 (*scm_t_s64_from_scm_intrinsic) (SCM);
|
||||
|
||||
#define SCM_FOR_ALL_VM_INTRINSICS(M) \
|
||||
M(scm_from_scm_scm, add, "add", ADD) \
|
||||
|
|
@ -48,6 +50,9 @@ typedef double (*scm_t_f64_from_scm_intrinsic) (SCM);
|
|||
M(scm_from_scm, symbol_to_keyword, "symbol->keyword", SYMBOL_TO_KEYWORD) \
|
||||
M(scm_from_scm, class_of, "class-of", CLASS_OF) \
|
||||
M(f64_from_scm, scm_to_f64, "scm->f64", SCM_TO_F64) \
|
||||
M(u64_from_scm, scm_to_u64, "scm->u64", SCM_TO_U64) \
|
||||
M(u64_from_scm, scm_to_u64_truncate, "scm->u64/truncate", SCM_TO_U64_TRUNCATE) \
|
||||
M(s64_from_scm, scm_to_s64, "scm->s64", SCM_TO_S64) \
|
||||
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
|
||||
|
||||
enum scm_vm_intrinsic
|
||||
|
|
|
|||
|
|
@ -1580,10 +1580,21 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
|
|||
NEXT (2);
|
||||
}
|
||||
|
||||
VM_DEFINE_OP (56, unused_56, NULL, NOP)
|
||||
VM_DEFINE_OP (56, call_u64_from_scm, "call-u64<-scm", OP2 (X8_S12_S12, C32) | OP_DST)
|
||||
{
|
||||
vm_error_bad_instruction (op);
|
||||
abort (); /* never reached */
|
||||
scm_t_uint8 dst, src;
|
||||
scm_t_uint64 res;
|
||||
scm_t_u64_from_scm_intrinsic intrinsic;
|
||||
|
||||
UNPACK_12_12 (op, dst, src);
|
||||
intrinsic = intrinsics[ip[1]];
|
||||
|
||||
SYNC_IP ();
|
||||
res = intrinsic (SP_REF (src));
|
||||
CACHE_SP ();
|
||||
SP_SET_U64 (dst, res);
|
||||
|
||||
NEXT (2);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -2148,7 +2159,23 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
|
|||
NEXT (2);
|
||||
}
|
||||
|
||||
VM_DEFINE_OP (77, unused_77, NULL, NOP)
|
||||
VM_DEFINE_OP (77, call_s64_from_scm, "call-s64<-scm", OP2 (X8_S12_S12, C32) | OP_DST)
|
||||
{
|
||||
scm_t_uint8 dst, src;
|
||||
scm_t_int64 res;
|
||||
scm_t_s64_from_scm_intrinsic intrinsic;
|
||||
|
||||
UNPACK_12_12 (op, dst, src);
|
||||
intrinsic = intrinsics[ip[1]];
|
||||
|
||||
SYNC_IP ();
|
||||
res = intrinsic (SP_REF (src));
|
||||
CACHE_SP ();
|
||||
SP_SET_S64 (dst, res);
|
||||
|
||||
NEXT (2);
|
||||
}
|
||||
|
||||
VM_DEFINE_OP (78, unused_78, NULL, NOP)
|
||||
VM_DEFINE_OP (79, unused_79, NULL, NOP)
|
||||
VM_DEFINE_OP (80, unused_80, NULL, NOP)
|
||||
|
|
@ -2328,11 +2355,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
|
|||
NEXT (0);
|
||||
}
|
||||
|
||||
/* scm->u64 dst:12 src:12
|
||||
*
|
||||
* Unpack an unsigned 64-bit integer from SRC and place it in DST.
|
||||
*/
|
||||
VM_DEFINE_OP (143, scm_to_u64, "scm->u64", OP1 (X8_S12_S12) | OP_DST)
|
||||
VM_DEFINE_OP (143, unused_143, NULL, NOP)
|
||||
{
|
||||
scm_t_uint16 dst, src;
|
||||
UNPACK_12_12 (op, dst, src);
|
||||
|
|
@ -2491,11 +2514,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
|
|||
NEXT (3);
|
||||
}
|
||||
|
||||
/* scm->s64 dst:12 src:12
|
||||
*
|
||||
* Unpack a signed 64-bit integer from SRC and place it in DST.
|
||||
*/
|
||||
VM_DEFINE_OP (157, scm_to_s64, "scm->s64", OP1 (X8_S12_S12) | OP_DST)
|
||||
VM_DEFINE_OP (157, unused_157, NULL, NOP)
|
||||
{
|
||||
scm_t_uint16 dst, src;
|
||||
UNPACK_12_12 (op, dst, src);
|
||||
|
|
@ -2647,13 +2666,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
|
|||
NEXT (1);
|
||||
}
|
||||
|
||||
/* scm->u64/truncate dst:12 src:12
|
||||
*
|
||||
* Unpack an exact integer from SRC and place it in the unsigned
|
||||
* 64-bit register DST, truncating any high bits. If the number in
|
||||
* SRC is negative, all the high bits will be set.
|
||||
*/
|
||||
VM_DEFINE_OP (167, scm_to_u64_truncate, "scm->u64/truncate", OP1 (X8_S12_S12) | OP_DST)
|
||||
VM_DEFINE_OP (167, unused_167, NULL, NOP)
|
||||
{
|
||||
scm_t_uint16 dst, src;
|
||||
SCM x;
|
||||
|
|
|
|||
|
|
@ -230,6 +230,9 @@
|
|||
symbol->keyword
|
||||
class-of
|
||||
scm->f64
|
||||
scm->u64
|
||||
scm->u64/truncate
|
||||
scm->s64
|
||||
u64->s64
|
||||
s64->u64
|
||||
cache-current-module!
|
||||
|
|
|
|||
|
|
@ -201,6 +201,9 @@
|
|||
emit-symbol->keyword
|
||||
emit-class-of
|
||||
emit-scm->f64
|
||||
emit-scm->u64
|
||||
emit-scm->u64/truncate
|
||||
emit-scm->s64
|
||||
|
||||
emit-call
|
||||
emit-call-label
|
||||
|
|
@ -263,11 +266,8 @@
|
|||
emit-ulsh/immediate
|
||||
emit-make-array
|
||||
emit-load-f64
|
||||
emit-scm->u64
|
||||
emit-scm->u64/truncate
|
||||
emit-load-u64
|
||||
emit-u64->scm
|
||||
emit-scm->s64
|
||||
emit-load-s64
|
||||
emit-s64->scm
|
||||
emit-make-atomic-box
|
||||
|
|
@ -1296,6 +1296,12 @@ returned instead."
|
|||
(define-syntax-rule (define-f64<-scm-intrinsic name)
|
||||
(define-macro-assembler (name asm dst src)
|
||||
(emit-call-f64<-scm asm dst src (intrinsic-name->index 'name))))
|
||||
(define-syntax-rule (define-u64<-scm-intrinsic name)
|
||||
(define-macro-assembler (name asm dst src)
|
||||
(emit-call-u64<-scm asm dst src (intrinsic-name->index 'name))))
|
||||
(define-syntax-rule (define-s64<-scm-intrinsic name)
|
||||
(define-macro-assembler (name asm dst src)
|
||||
(emit-call-s64<-scm asm dst src (intrinsic-name->index 'name))))
|
||||
|
||||
(define-scm<-scm-scm-intrinsic add)
|
||||
(define-scm<-scm-uimm-intrinsic add/immediate)
|
||||
|
|
@ -1315,6 +1321,9 @@ returned instead."
|
|||
(define-scm<-scm-intrinsic symbol->keyword)
|
||||
(define-scm<-scm-intrinsic class-of)
|
||||
(define-f64<-scm-intrinsic scm->f64)
|
||||
(define-u64<-scm-intrinsic scm->u64)
|
||||
(define-u64<-scm-intrinsic scm->u64/truncate)
|
||||
(define-s64<-scm-intrinsic scm->s64)
|
||||
|
||||
(define-macro-assembler (begin-program asm label properties)
|
||||
(emit-label asm label)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue