mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-17 17:20:29 +02:00
Class-of is intrinsic
* libguile/vm-engine.c (class-of): Disable. * module/language/cps/reify-primitives.scm (compute-known-primitives): Add class-of as macro-instruction. * libguile/intrinsics.c (scm_bootstrap_intrinsics): Add class-of. * libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS): Add class-of. * module/system/vm/assembler.scm (class-of): Define as intrinsic.
This commit is contained in:
parent
d1ed64d900
commit
954bfad262
5 changed files with 6 additions and 10 deletions
|
@ -90,6 +90,7 @@ scm_bootstrap_intrinsics (void)
|
||||||
scm_vm_intrinsics.string_to_number = string_to_number;
|
scm_vm_intrinsics.string_to_number = string_to_number;
|
||||||
scm_vm_intrinsics.string_to_symbol = scm_string_to_symbol;
|
scm_vm_intrinsics.string_to_symbol = scm_string_to_symbol;
|
||||||
scm_vm_intrinsics.symbol_to_keyword = scm_symbol_to_keyword;
|
scm_vm_intrinsics.symbol_to_keyword = scm_symbol_to_keyword;
|
||||||
|
scm_vm_intrinsics.class_of = scm_class_of;
|
||||||
|
|
||||||
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
|
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
|
||||||
"scm_init_intrinsics",
|
"scm_init_intrinsics",
|
||||||
|
|
|
@ -45,6 +45,7 @@ typedef SCM (*scm_t_scm_from_scm_intrinsic) (SCM);
|
||||||
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) \
|
||||||
|
M(scm_from_scm, class_of, "class-of", CLASS_OF) \
|
||||||
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
|
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
|
||||||
|
|
||||||
enum scm_vm_intrinsic
|
enum scm_vm_intrinsic
|
||||||
|
|
|
@ -2196,15 +2196,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
|
||||||
abort (); /* never reached */
|
abort (); /* never reached */
|
||||||
}
|
}
|
||||||
|
|
||||||
|
VM_DEFINE_OP (113, unused_113, NULL, NOP)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
/* class-of dst:12 type:12
|
|
||||||
*
|
|
||||||
* Store the vtable of SRC into DST.
|
|
||||||
*/
|
|
||||||
VM_DEFINE_OP (113, class_of, "class-of", OP1 (X8_S12_S12) | OP_DST)
|
|
||||||
{
|
{
|
||||||
ARGS1 (obj);
|
ARGS1 (obj);
|
||||||
/* FIXME: restore fast path for direct instances. */
|
/* FIXME: restore fast path for direct instances. */
|
||||||
|
|
|
@ -216,6 +216,7 @@
|
||||||
string->number
|
string->number
|
||||||
string->symbol
|
string->symbol
|
||||||
symbol->keyword
|
symbol->keyword
|
||||||
|
class-of
|
||||||
u64->s64
|
u64->s64
|
||||||
s64->u64
|
s64->u64
|
||||||
cache-current-module!
|
cache-current-module!
|
||||||
|
|
|
@ -199,6 +199,7 @@
|
||||||
emit-string->number
|
emit-string->number
|
||||||
emit-string->symbol
|
emit-string->symbol
|
||||||
emit-symbol->keyword
|
emit-symbol->keyword
|
||||||
|
emit-class-of
|
||||||
|
|
||||||
emit-call
|
emit-call
|
||||||
emit-call-label
|
emit-call-label
|
||||||
|
@ -259,7 +260,6 @@
|
||||||
emit-ursh/immediate
|
emit-ursh/immediate
|
||||||
emit-srsh/immediate
|
emit-srsh/immediate
|
||||||
emit-ulsh/immediate
|
emit-ulsh/immediate
|
||||||
emit-class-of
|
|
||||||
emit-make-array
|
emit-make-array
|
||||||
emit-scm->f64
|
emit-scm->f64
|
||||||
emit-load-f64
|
emit-load-f64
|
||||||
|
@ -1311,6 +1311,7 @@ returned instead."
|
||||||
(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)
|
||||||
|
(define-scm<-scm-intrinsic class-of)
|
||||||
|
|
||||||
(define-macro-assembler (begin-program asm label properties)
|
(define-macro-assembler (begin-program asm label properties)
|
||||||
(emit-label asm label)
|
(emit-label asm label)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue