diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index d92910a80..ec112b2f6 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -1,5 +1,5 @@ /* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, - * 2014 Free Software Foundation, Inc. + * 2014, 2015 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -3109,9 +3109,93 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, : scm_is_true (scm_logtest (x, y)))); } - VM_DEFINE_OP (129, unused_129, NULL, NOP) - VM_DEFINE_OP (130, unused_130, NULL, NOP) - VM_DEFINE_OP (131, unused_131, NULL, NOP) + /* FIXME: Move above */ + + /* allocate-struct dst:8 vtable:8 nfields:8 + * + * Allocate a new struct with VTABLE, and place it in DST. The struct + * will be constructed with space for NFIELDS fields, which should + * correspond to the field count of the VTABLE. + */ + VM_DEFINE_OP (129, allocate_struct, "allocate-struct", OP1 (U8_U8_U8_U8) | OP_DST) + { + scm_t_uint8 dst, vtable, nfields; + SCM ret; + + UNPACK_8_8_8 (op, dst, vtable, nfields); + + SYNC_IP (); + ret = scm_allocate_struct (LOCAL_REF (vtable), LOCAL_REF (nfields)); + LOCAL_SET (dst, ret); + + NEXT (1); + } + + /* struct-ref dst:8 src:8 idx:8 + * + * Fetch the item at slot IDX in the struct in SRC, and store it + * in DST. + */ + VM_DEFINE_OP (130, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST) + { + scm_t_uint8 dst, src, idx; + SCM obj; + SCM index; + + UNPACK_8_8_8 (op, dst, src, idx); + + obj = LOCAL_REF (src); + index = LOCAL_REF (idx); + + if (SCM_LIKELY (SCM_STRUCTP (obj) + && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, + SCM_VTABLE_FLAG_SIMPLE) + && SCM_I_INUMP (index) + && SCM_I_INUM (index) >= 0 + && SCM_I_INUM (index) < (SCM_STRUCT_DATA_REF + (SCM_STRUCT_VTABLE (obj), + scm_vtable_index_size)))) + RETURN (SCM_STRUCT_SLOT_REF (obj, SCM_I_INUM (index))); + + SYNC_IP (); + RETURN (scm_struct_ref (obj, index)); + } + + /* struct-set! dst:8 idx:8 src:8 + * + * Store SRC into the struct DST at slot IDX. + */ + VM_DEFINE_OP (131, struct_set, "struct-set!", OP1 (U8_U8_U8_U8)) + { + scm_t_uint8 dst, idx, src; + SCM obj, val, index; + + UNPACK_8_8_8 (op, dst, idx, src); + + obj = LOCAL_REF (dst); + val = LOCAL_REF (src); + index = LOCAL_REF (idx); + + if (SCM_LIKELY (SCM_STRUCTP (obj) + && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, + SCM_VTABLE_FLAG_SIMPLE) + && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, + SCM_VTABLE_FLAG_SIMPLE_RW) + && SCM_I_INUMP (index) + && SCM_I_INUM (index) >= 0 + && SCM_I_INUM (index) < (SCM_STRUCT_DATA_REF + (SCM_STRUCT_VTABLE (obj), + scm_vtable_index_size)))) + { + SCM_STRUCT_SLOT_SET (obj, SCM_I_INUM (index), val); + NEXT (1); + } + + SYNC_IP (); + scm_struct_set_x (obj, index, val); + NEXT (1); + } + VM_DEFINE_OP (132, unused_132, NULL, NOP) VM_DEFINE_OP (133, unused_133, NULL, NOP) VM_DEFINE_OP (134, unused_134, NULL, NOP) diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm index e04eb6cb8..e6dfaad6e 100644 --- a/module/language/cps/compile-bytecode.scm +++ b/module/language/cps/compile-bytecode.scm @@ -1,6 +1,6 @@ ;;; Continuation-passing style (CPS) intermediate language (IL) -;; Copyright (C) 2013, 2014 Free Software Foundation, Inc. +;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -278,8 +278,12 @@ (emit-make-vector/immediate asm dst (constant length) (slot init))) (($ $primcall 'vector-ref/immediate (vector index)) (emit-vector-ref/immediate asm dst (slot vector) (constant index))) + (($ $primcall 'allocate-struct (vtable nfields)) + (emit-allocate-struct asm dst (slot vtable) (slot nfields))) (($ $primcall 'allocate-struct/immediate (vtable nfields)) (emit-allocate-struct/immediate asm dst (slot vtable) (constant nfields))) + (($ $primcall 'struct-ref (struct n)) + (emit-struct-ref asm dst (slot struct) (slot n))) (($ $primcall 'struct-ref/immediate (struct n)) (emit-struct-ref/immediate asm dst (slot struct) (constant n))) (($ $primcall 'builtin-ref (name)) @@ -339,6 +343,8 @@ (emit-free-set! asm (slot closure) (slot value) (constant idx))) (($ $primcall 'box-set! (box value)) (emit-box-set! asm (slot box) (slot value))) + (($ $primcall 'struct-set! (struct index value)) + (emit-struct-set! asm (slot struct) (slot index) (slot value))) (($ $primcall 'struct-set!/immediate (struct index value)) (emit-struct-set!/immediate asm (slot struct) (constant index) (slot value))) (($ $primcall 'vector-set! (vector index value)) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 3d277adab..8b9a70ea4 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -1,6 +1,6 @@ ;;; Guile bytecode assembler -;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014 Free Software Foundation, Inc. +;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014, 2015 Free Software Foundation, Inc. ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -149,6 +149,9 @@ (emit-allocate-struct/immediate* . emit-allocate-struct/immediate) (emit-struct-ref/immediate* . emit-struct-ref/immediate) (emit-struct-set!/immediate* . emit-struct-set!/immediate) + (emit-allocate-struct* . emit-allocate-struct) + (emit-struct-ref* . emit-struct-ref) + (emit-struct-set!* . emit-struct-set!) (emit-class-of* . emit-class-of) (emit-make-array* . emit-make-array) (emit-bv-u8-ref* . emit-bv-u8-ref)