mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 20:30:28 +02:00
Code Activity

u64->scm, s64->scm intrinsics

Browse source 
* libguile/intrinsics.h (u64->scm, s64->scm): New intrinsics.
* libguile/intrinsics.c (scm_bootstrap_intrinsics): Initialize new
  intrinsics.
* libguile/vm-engine.c (call-scm<-u64, call-scm<-s64): New intrinsic
  callers.
  (u64->scm, s64->scm): Disable instructions.
* module/language/cps/reify-primitives.scm (compute-known-primitives):
  Add new intrinsics as macro-instructions.
* module/system/vm/assembler.scm (define-scm<-u64-intrinsic):
  (define-scm<-s64-intrinsic, u64->scm, s64->scm): Wire up new
  intrinsics.
This commit is contained in:
Andy Wingo 2018-04-12 16:43:57 +02:00
parent 1457f4efb3
commit 7e386bbc70
5 changed files with 54 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/intrinsics.c
View file

@ -104,6 +104,8 @@ scm_bootstrap_intrinsics (void)
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_vm_intrinsics.u64_to_scm = scm_from_uint64;
scm_vm_intrinsics.s64_to_scm = scm_from_int64;
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_intrinsics",

4
libguile/intrinsics.h
View file

@ -30,6 +30,8 @@ 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);
typedef SCM (*scm_t_scm_from_u64_intrinsic) (scm_t_uint64);
typedef SCM (*scm_t_scm_from_s64_intrinsic) (scm_t_int64);
#define SCM_FOR_ALL_VM_INTRINSICS(M) \
M(scm_from_scm_scm, add, "add", ADD) \
@ -53,6 +55,8 @@ typedef scm_t_int64 (*scm_t_s64_from_scm_intrinsic) (SCM);
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) \
M(scm_from_u64, u64_to_scm, "u64->scm", U64_TO_SCM) \
M(scm_from_s64, s64_to_scm, "s64->scm", S64_TO_SCM) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic

48
libguile/vm-engine.c
View file

@ -2176,8 +2176,40 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (2);
}
VM_DEFINE_OP (78, unused_78, NULL, NOP)
VM_DEFINE_OP (79, unused_79, NULL, NOP)
VM_DEFINE_OP (78, call_scm_from_u64, "call-scm<-u64", OP2 (X8_S12_S12, C32) | OP_DST)
{
scm_t_uint8 dst, src;
SCM res;
scm_t_scm_from_u64_intrinsic intrinsic;
UNPACK_12_12 (op, dst, src);
intrinsic = intrinsics[ip[1]];
SYNC_IP ();
res = intrinsic (SP_REF_U64 (src));
CACHE_SP ();
SP_SET (dst, res);
NEXT (2);
}
VM_DEFINE_OP (79, call_scm_from_s64, "call-scm<-s64", OP2 (X8_S12_S12, C32) | OP_DST)
{
scm_t_uint8 dst, src;
SCM res;
scm_t_scm_from_s64_intrinsic intrinsic;
UNPACK_12_12 (op, dst, src);
intrinsic = intrinsics[ip[1]];
SYNC_IP ();
res = intrinsic (SP_REF_S64 (src));
CACHE_SP ();
SP_SET (dst, res);
NEXT (2);
}
VM_DEFINE_OP (80, unused_80, NULL, NOP)
{
vm_error_bad_instruction (op);
@ -2361,11 +2393,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
abort (); /* never reached */
}
/* u64->scm dst:12 src:12
*
* Pack an unsigned 64-bit integer into a SCM value.
*/
VM_DEFINE_OP (144, u64_to_scm, "u64->scm", OP1 (X8_S12_S12) | OP_DST)
VM_DEFINE_OP (144, unused_144, NULL, NOP)
{
scm_t_uint16 dst, src;
UNPACK_12_12 (op, dst, src);
@ -2517,11 +2545,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
abort (); /* never reached */
}
/* s64->scm dst:12 src:12
*
* Pack an signed 64-bit integer into a SCM value.
*/
VM_DEFINE_OP (158, s64_to_scm, "s64->scm", OP1 (X8_S12_S12) | OP_DST)
VM_DEFINE_OP (158, unused_158, NULL, NOP)
{
scm_t_uint16 dst, src;
UNPACK_12_12 (op, dst, src);

7
module/language/cps/reify-primitives.scm
View file

@ -230,11 +230,8 @@
symbol->keyword
class-of
scm->f64
scm->u64
scm->u64/truncate
scm->s64
u64->s64
s64->u64
s64->u64 s64->scm scm->s64
u64->s64 u64->scm scm->u64 scm->u64/truncate
cache-current-module!
cached-toplevel-box
cached-module-box))

12
module/system/vm/assembler.scm
View file

@ -204,6 +204,8 @@
emit-scm->u64
emit-scm->u64/truncate
emit-scm->s64
emit-u64->scm
emit-s64->scm
emit-call
emit-call-label
@ -267,9 +269,7 @@
emit-make-array
emit-load-f64
emit-load-u64
emit-u64->scm
emit-load-s64
emit-s64->scm
emit-make-atomic-box
emit-atomic-box-ref
emit-atomic-box-set!
@ -1302,6 +1302,12 @@ returned instead."
(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-syntax-rule (define-scm<-u64-intrinsic name)
(define-macro-assembler (name asm dst src)
(emit-call-scm<-u64 asm dst src (intrinsic-name->index 'name))))
(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-scm<-scm-scm-intrinsic add)
(define-scm<-scm-uimm-intrinsic add/immediate)
@ -1324,6 +1330,8 @@ returned instead."
(define-u64<-scm-intrinsic scm->u64)
(define-u64<-scm-intrinsic scm->u64/truncate)
(define-s64<-scm-intrinsic scm->s64)
(define-scm<-u64-intrinsic u64->scm)
(define-scm<-s64-intrinsic s64->scm)
(define-macro-assembler (begin-program asm label properties)
(emit-label asm label)