mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

Add opcodes for struct?', struct-vtable', and `make-struct'.

Browse source 
* libguile/vm-engine.c (VM_NAME)[vm_error_not_a_struct]: New label.

* libguile/vm-i-scheme.c (VM_VALIDATE_STRUCT): New macro.
  (struct_p, struct_vtable, make_struct): New instructions.

* module/language/tree-il/compile-glil.scm (*primcall-ops*): Add
  `struct?', `struct-vtable', and `make-struct'.

* module/language/tree-il/primitives.scm (*interesting-primitive-names*,
  *effect-free-primitives*): Likewise.
This commit is contained in:
Ludovic Courtès 2009-12-11 12:44:29 +01:00
parent 6c20a0b34b
commit bd91ecce14
4 changed files with 46 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/vm-engine.c
View file

@ -206,6 +206,12 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
/* shouldn't get here */
goto vm_error;
vm_error_not_a_struct:
SYNC_ALL ();
scm_wrong_type_arg_msg (FUNC_NAME, 1, finish_args, "struct");
/* shouldn't get here */
goto vm_error;
vm_error_no_values:
err_msg = scm_from_locale_string ("Zero values returned to single-valued continuation");
finish_args = SCM_EOL;

34
libguile/vm-i-scheme.c
View file

@ -621,6 +621,40 @@ BV_FLOAT_SET (f64, ieee_double, double, 8)
#undef BV_INT_SET
#undef BV_FLOAT_SET
#define VM_VALIDATE_STRUCT(obj) \
if (SCM_UNLIKELY (!SCM_STRUCTP (obj))) \
{ \
finish_args = (obj); \
goto vm_error_not_a_struct; \
}
VM_DEFINE_FUNCTION (174, struct_p, "struct?", 1)
{
ARGS1 (obj);
RETURN (scm_from_bool (SCM_STRUCTP (obj)));
}
VM_DEFINE_FUNCTION (175, struct_vtable, "struct-vtable", 1)
{
ARGS1 (obj);
VM_VALIDATE_STRUCT (obj);
RETURN (SCM_STRUCT_VTABLE (obj));
}
VM_DEFINE_INSTRUCTION (176, make_struct, "make-struct", 2, -1, 1)
{
unsigned h = FETCH ();
unsigned l = FETCH ();
int n_args = ((h << 8U) + l);
SCM vtable = sp[1 - n_args], n_tail = sp[2 - n_args];
const SCM *inits = sp - n_args + 3;
sp -= n_args - 1;
RETURN (scm_c_make_structv (vtable, scm_to_size_t (n_tail),
n_args - 2, (scm_t_bits *) inits));
}
/*
(defun renumber-ops ()
"start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"

3
module/language/tree-il/compile-glil.scm
View file

@ -115,6 +115,9 @@
((variable-ref . 1) . variable-ref)
;; nb, *not* variable-set! -- the args are switched
((variable-set . 2) . variable-set)
((struct? . 1) . struct?)
((struct-vtable . 1) . struct-vtable)
(make-struct . make-struct)
;; hack for javascript
((return . 1) return)

3
module/language/tree-il/primitives.scm
View file

@ -57,6 +57,8 @@
variable-ref variable-set!
;; args of variable-set are switched; it needs special help
struct? struct-vtable make-struct
bytevector-u8-ref bytevector-u8-set!
bytevector-s8-ref bytevector-s8-set!
@ -104,6 +106,7 @@
caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
vector-ref
struct? struct-vtable make-struct
bytevector-u8-ref bytevector-s8-ref
bytevector-u16-ref bytevector-u16-native-ref
bytevector-s16-ref bytevector-s16-native-ref