mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Avoid needless 64-bit args on 32-bit machines for some intrinsics
* libguile/intrinsics.h: * libguile/intrinsics.c (string_set_x): Change to take size_t and u32 as args. (allocate_words): Change to take size_t as arg. * libguile/vm.c (expand_apply_argument): Rename from rest_arg_length, and also handle the stack manipulation. * libguile/vm-engine.c (expand-apply-argument): Update for intrinsic change. (call-scm-sz-u32): Rename from call-scm-u64-u64, as it matches its uses and will compile better on 32-bit systems. * module/system/vm/assembler.scm (define-scm-sz-u32-intrinsic): (string-set!): Update for new instrinsic call inst. * libguile/jit.c (compile_call_scm_sz_u32): Adapt.
This commit is contained in:
parent
11940f4c72
commit
d4abe8bbed
6 changed files with 26 additions and 31 deletions
|
@ -73,7 +73,7 @@ sub_immediate (SCM a, uint8_t b)
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
string_set_x (SCM str, uint64_t idx, uint64_t ch)
|
string_set_x (SCM str, size_t idx, uint32_t ch)
|
||||||
{
|
{
|
||||||
str = scm_i_string_start_writing (str);
|
str = scm_i_string_start_writing (str);
|
||||||
scm_i_string_set_x (str, idx, ch);
|
scm_i_string_set_x (str, idx, ch);
|
||||||
|
@ -344,7 +344,7 @@ error_wrong_number_of_values (uint32_t expected)
|
||||||
}
|
}
|
||||||
|
|
||||||
static SCM
|
static SCM
|
||||||
allocate_words (scm_thread *thread, uint64_t n)
|
allocate_words (scm_thread *thread, size_t n)
|
||||||
{
|
{
|
||||||
return SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, n));
|
return SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, n));
|
||||||
}
|
}
|
||||||
|
|
|
@ -31,7 +31,7 @@
|
||||||
|
|
||||||
typedef SCM (*scm_t_scm_from_scm_scm_intrinsic) (SCM, SCM);
|
typedef SCM (*scm_t_scm_from_scm_scm_intrinsic) (SCM, SCM);
|
||||||
typedef SCM (*scm_t_scm_from_scm_uimm_intrinsic) (SCM, uint8_t);
|
typedef SCM (*scm_t_scm_from_scm_uimm_intrinsic) (SCM, uint8_t);
|
||||||
typedef void (*scm_t_scm_u64_u64_intrinsic) (SCM, uint64_t, uint64_t);
|
typedef void (*scm_t_scm_sz_u32_intrinsic) (SCM, size_t, uint32_t);
|
||||||
typedef SCM (*scm_t_scm_from_scm_intrinsic) (SCM);
|
typedef SCM (*scm_t_scm_from_scm_intrinsic) (SCM);
|
||||||
typedef double (*scm_t_f64_from_scm_intrinsic) (SCM);
|
typedef double (*scm_t_f64_from_scm_intrinsic) (SCM);
|
||||||
typedef uint64_t (*scm_t_u64_from_scm_intrinsic) (SCM);
|
typedef uint64_t (*scm_t_u64_from_scm_intrinsic) (SCM);
|
||||||
|
@ -60,7 +60,7 @@ typedef void (*scm_t_scm_scm_noreturn_intrinsic) (SCM, SCM) SCM_NORETURN;
|
||||||
typedef void (*scm_t_noreturn_intrinsic) (void) SCM_NORETURN;
|
typedef void (*scm_t_noreturn_intrinsic) (void) SCM_NORETURN;
|
||||||
typedef void (*scm_t_scm_noreturn_intrinsic) (SCM) SCM_NORETURN;
|
typedef void (*scm_t_scm_noreturn_intrinsic) (SCM) SCM_NORETURN;
|
||||||
typedef void (*scm_t_u32_noreturn_intrinsic) (uint32_t) SCM_NORETURN;
|
typedef void (*scm_t_u32_noreturn_intrinsic) (uint32_t) SCM_NORETURN;
|
||||||
typedef SCM (*scm_t_scm_from_thread_u64_intrinsic) (scm_thread*, uint64_t);
|
typedef SCM (*scm_t_scm_from_thread_sz_intrinsic) (scm_thread*, size_t);
|
||||||
typedef SCM (*scm_t_scm_from_thread_intrinsic) (scm_thread*);
|
typedef SCM (*scm_t_scm_from_thread_intrinsic) (scm_thread*);
|
||||||
typedef void (*scm_t_thread_u8_scm_sp_vra_mra_intrinsic) (scm_thread*,
|
typedef void (*scm_t_thread_u8_scm_sp_vra_mra_intrinsic) (scm_thread*,
|
||||||
uint8_t, SCM,
|
uint8_t, SCM,
|
||||||
|
@ -84,7 +84,7 @@ typedef uint8_t* (*scm_t_mra_from_thread_mra_intrinsic) (scm_thread*, uint8_t*);
|
||||||
M(scm_from_scm_scm, logand, "logand", LOGAND) \
|
M(scm_from_scm_scm, logand, "logand", LOGAND) \
|
||||||
M(scm_from_scm_scm, logior, "logior", LOGIOR) \
|
M(scm_from_scm_scm, logior, "logior", LOGIOR) \
|
||||||
M(scm_from_scm_scm, logxor, "logxor", LOGXOR) \
|
M(scm_from_scm_scm, logxor, "logxor", LOGXOR) \
|
||||||
M(scm_u64_u64, string_set_x, "string-set!", STRING_SET_X) \
|
M(scm_sz_u32, string_set_x, "string-set!", STRING_SET_X) \
|
||||||
M(scm_from_scm, string_to_number, "string->number", STRING_TO_NUMBER) \
|
M(scm_from_scm, string_to_number, "string->number", STRING_TO_NUMBER) \
|
||||||
M(scm_from_scm, string_to_symbol, "string->symbol", STRING_TO_SYMBOL) \
|
M(scm_from_scm, string_to_symbol, "string->symbol", STRING_TO_SYMBOL) \
|
||||||
M(scm_from_scm, symbol_to_keyword, "symbol->keyword", SYMBOL_TO_KEYWORD) \
|
M(scm_from_scm, symbol_to_keyword, "symbol->keyword", SYMBOL_TO_KEYWORD) \
|
||||||
|
@ -123,7 +123,7 @@ typedef uint8_t* (*scm_t_mra_from_thread_mra_intrinsic) (scm_thread*, uint8_t*);
|
||||||
M(thread_scm_noreturn, reinstate_continuation_x, "reinstate-continuation!", REINSTATE_CONTINUATION_X) \
|
M(thread_scm_noreturn, reinstate_continuation_x, "reinstate-continuation!", REINSTATE_CONTINUATION_X) \
|
||||||
M(scm_from_thread, capture_continuation, "capture-continuation", CAPTURE_CONTINUATION) \
|
M(scm_from_thread, capture_continuation, "capture-continuation", CAPTURE_CONTINUATION) \
|
||||||
M(mra_from_thread_scm, compose_continuation, "compose-continuation", COMPOSE_CONTINUATION) \
|
M(mra_from_thread_scm, compose_continuation, "compose-continuation", COMPOSE_CONTINUATION) \
|
||||||
M(int_from_scm, rest_arg_length, "rest-arg-length", REST_ARG_LENGTH) \
|
M(thread, expand_apply_argument, "expand-apply-argument", EXPAND_APPLY_ARGUMENT) \
|
||||||
M(mra_from_thread_mra, abort_to_prompt, "abort-to-prompt", ABORT_TO_PROMPT) \
|
M(mra_from_thread_mra, abort_to_prompt, "abort-to-prompt", ABORT_TO_PROMPT) \
|
||||||
M(scm_scm_noreturn, throw_, "throw", THROW) \
|
M(scm_scm_noreturn, throw_, "throw", THROW) \
|
||||||
M(scm_scm_noreturn, throw_with_value, "throw/value", THROW_WITH_VALUE) \
|
M(scm_scm_noreturn, throw_with_value, "throw/value", THROW_WITH_VALUE) \
|
||||||
|
@ -133,7 +133,7 @@ typedef uint8_t* (*scm_t_mra_from_thread_mra_intrinsic) (scm_thread*, uint8_t*);
|
||||||
M(noreturn, error_not_enough_values, "not-enough-values", ERROR_NOT_ENOUGH_VALUES) \
|
M(noreturn, error_not_enough_values, "not-enough-values", ERROR_NOT_ENOUGH_VALUES) \
|
||||||
M(u32_noreturn, error_wrong_number_of_values, "wrong-number-of-values", ERROR_WRONG_NUMBER_OF_VALUES) \
|
M(u32_noreturn, error_wrong_number_of_values, "wrong-number-of-values", ERROR_WRONG_NUMBER_OF_VALUES) \
|
||||||
M(vra_from_thread, get_callee_vcode, "get-callee-vcode", GET_CALLEE_VCODE) \
|
M(vra_from_thread, get_callee_vcode, "get-callee-vcode", GET_CALLEE_VCODE) \
|
||||||
M(scm_from_thread_u64, allocate_words, "allocate-words", ALLOCATE_WORDS) \
|
M(scm_from_thread_sz, allocate_words, "allocate-words", ALLOCATE_WORDS) \
|
||||||
M(scm_from_thread, current_module, "current-module", CURRENT_MODULE) \
|
M(scm_from_thread, current_module, "current-module", CURRENT_MODULE) \
|
||||||
M(thread_u8_scm_sp_vra_mra, push_prompt, "push-prompt", PUSH_PROMPT) \
|
M(thread_u8_scm_sp_vra_mra, push_prompt, "push-prompt", PUSH_PROMPT) \
|
||||||
M(thread_scm, unpack_values_object, "unpack-values-object", UNPACK_VALUES_OBJECT) \
|
M(thread_scm, unpack_values_object, "unpack-values-object", UNPACK_VALUES_OBJECT) \
|
||||||
|
|
|
@ -311,7 +311,7 @@ compile_call_scm_from_scm_uimm (scm_jit_state *j, uint8_t dst, uint8_t a, uint8_
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
compile_call_scm_u64_u64 (scm_jit_state *j, uint8_t a, uint8_t b, uint8_t c, uint32_t d)
|
compile_call_scm_sz_u32 (scm_jit_state *j, uint8_t a, uint8_t b, uint8_t c, uint32_t d)
|
||||||
{
|
{
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -1016,21 +1016,9 @@ VM_NAME (scm_thread *thread)
|
||||||
*/
|
*/
|
||||||
VM_DEFINE_OP (30, expand_apply_argument, "expand-apply-argument", OP1 (X32))
|
VM_DEFINE_OP (30, expand_apply_argument, "expand-apply-argument", OP1 (X32))
|
||||||
{
|
{
|
||||||
int list_len;
|
|
||||||
SCM list;
|
|
||||||
|
|
||||||
list = SP_REF (0);
|
|
||||||
|
|
||||||
SYNC_IP ();
|
SYNC_IP ();
|
||||||
list_len = CALL_INTRINSIC (rest_arg_length, (list));
|
CALL_INTRINSIC (expand_apply_argument, (thread));
|
||||||
|
CACHE_SP ();
|
||||||
ALLOC_FRAME (FRAME_LOCALS_COUNT () - 1 + list_len);
|
|
||||||
|
|
||||||
while (list_len--)
|
|
||||||
{
|
|
||||||
SP_SET (list_len, SCM_CAR (list));
|
|
||||||
list = SCM_CDR (list);
|
|
||||||
}
|
|
||||||
|
|
||||||
NEXT (1);
|
NEXT (1);
|
||||||
}
|
}
|
||||||
|
@ -1380,10 +1368,10 @@ VM_NAME (scm_thread *thread)
|
||||||
NEXT (2);
|
NEXT (2);
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_DEFINE_OP (53, call_scm_u64_u64, "call-scm-u64-u64", OP2 (X8_S8_S8_S8, C32))
|
VM_DEFINE_OP (53, call_scm_sz_u32, "call-scm-sz-u32", OP2 (X8_S8_S8_S8, C32))
|
||||||
{
|
{
|
||||||
uint8_t a, b, c;
|
uint8_t a, b, c;
|
||||||
scm_t_scm_u64_u64_intrinsic intrinsic;
|
scm_t_scm_sz_u32_intrinsic intrinsic;
|
||||||
|
|
||||||
UNPACK_8_8_8 (op, a, b, c);
|
UNPACK_8_8_8 (op, a, b, c);
|
||||||
intrinsic = intrinsics[ip[1]];
|
intrinsic = intrinsics[ip[1]];
|
||||||
|
|
|
@ -1177,16 +1177,23 @@ compose_continuation (scm_thread *thread, SCM cont)
|
||||||
return mra;
|
return mra;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int
|
static void
|
||||||
rest_arg_length (SCM x)
|
expand_apply_argument (scm_thread *thread)
|
||||||
{
|
{
|
||||||
|
SCM x = thread->vm.sp[0].as_scm;
|
||||||
int len = scm_ilength (x);
|
int len = scm_ilength (x);
|
||||||
|
|
||||||
if (SCM_UNLIKELY (len < 0))
|
if (SCM_UNLIKELY (len < 0))
|
||||||
scm_error (scm_arg_type_key, "apply", "Apply to non-list: ~S",
|
scm_error (scm_arg_type_key, "apply", "Apply to non-list: ~S",
|
||||||
scm_list_1 (x), scm_list_1 (x));
|
scm_list_1 (x), scm_list_1 (x));
|
||||||
|
|
||||||
return len;
|
alloc_frame (thread, frame_locals_count (thread) - 1 + len);
|
||||||
|
|
||||||
|
while (len--)
|
||||||
|
{
|
||||||
|
thread->vm.sp[len].as_scm = SCM_CAR (x);
|
||||||
|
x = SCM_CDR (x);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* This is here to avoid putting the code for "alloc-frame" in subr
|
/* This is here to avoid putting the code for "alloc-frame" in subr
|
||||||
|
@ -1722,7 +1729,7 @@ scm_bootstrap_vm (void)
|
||||||
scm_vm_intrinsics.reinstate_continuation_x = reinstate_continuation_x;
|
scm_vm_intrinsics.reinstate_continuation_x = reinstate_continuation_x;
|
||||||
scm_vm_intrinsics.capture_continuation = capture_continuation;
|
scm_vm_intrinsics.capture_continuation = capture_continuation;
|
||||||
scm_vm_intrinsics.compose_continuation = compose_continuation;
|
scm_vm_intrinsics.compose_continuation = compose_continuation;
|
||||||
scm_vm_intrinsics.rest_arg_length = rest_arg_length;
|
scm_vm_intrinsics.expand_apply_argument = expand_apply_argument;
|
||||||
scm_vm_intrinsics.abort_to_prompt = abort_to_prompt;
|
scm_vm_intrinsics.abort_to_prompt = abort_to_prompt;
|
||||||
scm_vm_intrinsics.get_callee_vcode = get_callee_vcode;
|
scm_vm_intrinsics.get_callee_vcode = get_callee_vcode;
|
||||||
scm_vm_intrinsics.unpack_values_object = unpack_values_object;
|
scm_vm_intrinsics.unpack_values_object = unpack_values_object;
|
||||||
|
|
|
@ -1313,9 +1313,9 @@ returned instead."
|
||||||
(define-syntax-rule (define-scm<-scm-uimm-intrinsic name)
|
(define-syntax-rule (define-scm<-scm-uimm-intrinsic name)
|
||||||
(define-macro-assembler (name asm dst a b)
|
(define-macro-assembler (name asm dst a b)
|
||||||
(emit-call-scm<-scm-uimm asm dst a b (intrinsic-name->index 'name))))
|
(emit-call-scm<-scm-uimm asm dst a b (intrinsic-name->index 'name))))
|
||||||
(define-syntax-rule (define-scm-u64-u64-intrinsic name)
|
(define-syntax-rule (define-scm-sz-u32-intrinsic name)
|
||||||
(define-macro-assembler (name asm a b c)
|
(define-macro-assembler (name asm a b c)
|
||||||
(emit-call-scm-u64-u64 asm a b c (intrinsic-name->index 'name))))
|
(emit-call-scm-sz-u32 asm a b c (intrinsic-name->index 'name))))
|
||||||
(define-syntax-rule (define-scm<-scm-intrinsic name)
|
(define-syntax-rule (define-scm<-scm-intrinsic name)
|
||||||
(define-macro-assembler (name asm dst src)
|
(define-macro-assembler (name asm dst src)
|
||||||
(emit-call-scm<-scm asm dst src (intrinsic-name->index 'name))))
|
(emit-call-scm<-scm asm dst src (intrinsic-name->index 'name))))
|
||||||
|
@ -1369,7 +1369,7 @@ returned instead."
|
||||||
(define-scm<-scm-scm-intrinsic logior)
|
(define-scm<-scm-scm-intrinsic logior)
|
||||||
(define-scm<-scm-scm-intrinsic logxor)
|
(define-scm<-scm-scm-intrinsic logxor)
|
||||||
(define-scm<-scm-scm-intrinsic logsub)
|
(define-scm<-scm-scm-intrinsic logsub)
|
||||||
(define-scm-u64-u64-intrinsic string-set!)
|
(define-scm-sz-u32-intrinsic string-set!)
|
||||||
(define-scm<-scm-intrinsic string->number)
|
(define-scm<-scm-intrinsic string->number)
|
||||||
(define-scm<-scm-intrinsic string->symbol)
|
(define-scm<-scm-intrinsic string->symbol)
|
||||||
(define-scm<-scm-intrinsic symbol->keyword)
|
(define-scm<-scm-intrinsic symbol->keyword)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue