summaryrefslogtreecommitdiff
path: root/libguile/programs.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2013-05-23 14:52:29 +0200
committerAndy Wingo <wingo@pobox.com>2013-05-31 09:48:16 -0400
commit510ca12687b2137031d537be7b99bcf6d5306e41 (patch)
tree4cff09d9338a7f81dcf3733fad6f65b14669b919 /libguile/programs.c
parent1701a68920cf1b83d320711a4d47806ba089c148 (diff)
downloadguile-510ca12687b2137031d537be7b99bcf6d5306e41.tar.gz
add new rtl vm
* libguile/vm-engine.c (rtl_vm_engine): Add new VM. (vm_engine): Add support for calling RTL programs. * libguile/tags.h (scm_tc7_rtl_program): New type for procedures that run on the new VM. * libguile/evalext.c (scm_self_evaluating_p): * libguile/goops.c (scm_class_of): * libguile/print.c (iprin1): * libguile/procprop.c (scm_i_procedure_arity): * libguile/procs.c (scm_procedure_p): Add hooks for the new tc7. * libguile/programs.h: * libguile/programs.c (scm_make_rtl_program, scm_i_rtl_program_print) (scm_rtl_program_p, scm_rtl_program_code): * module/system/vm/program.scm: Add constructors and accessors for the new "RTL programs". * libguile/vm.c (rtl_boot_continuation): Define a boot program. (rtl_apply, rtl_values): New static RTL programs. * libguile/frames.c (scm_frame_num_locals): Adapt for frames of RTL programs. * libguile/frames.h: Add description of RTL frames. * libguile/Makefile.am: Add rules to generate vm-operations.h. * .gitignore: Ignore vm-operations.h. * module/system/vm/instruction.scm: * libguile/instructions.c: * libguile/instructions.h: Use vm-operations.h to define enumerated values for the new RTL opcodes. Define some helper macros to pack and unpack 32-bit instruction words. (rtl-instruction-list): New function, exported by (system vm instruction). * libguile/objcodes.c: Wire up the bits needed to detect the new RTL bytecode and load it, as appropriate.
Diffstat (limited to 'libguile/programs.c')
-rw-r--r--libguile/programs.c63
1 files changed, 62 insertions, 1 deletions
diff --git a/libguile/programs.c b/libguile/programs.c
index 128e0312a..eb5972ab3 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 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
@@ -69,6 +69,58 @@ SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_make_rtl_program, "make-rtl-program", 1, 2, 0,
+ (SCM bytevector, SCM byte_offset, SCM free_variables),
+ "")
+#define FUNC_NAME s_scm_make_rtl_program
+{
+ scm_t_uint8 *code;
+ scm_t_uint32 offset;
+
+ if (!scm_is_bytevector (bytevector))
+ scm_wrong_type_arg (FUNC_NAME, 1, bytevector);
+ if (SCM_UNBNDP (byte_offset))
+ offset = 0;
+ else
+ {
+ offset = scm_to_uint32 (byte_offset);
+ if (offset > SCM_BYTEVECTOR_LENGTH (bytevector))
+ SCM_OUT_OF_RANGE (2, byte_offset);
+ }
+
+ code = (scm_t_uint8*) SCM_BYTEVECTOR_CONTENTS (bytevector) + offset;
+ if (((scm_t_uintptr) code) % 4)
+ SCM_OUT_OF_RANGE (2, byte_offset);
+
+ if (SCM_UNBNDP (free_variables) || scm_is_false (free_variables))
+ return scm_cell (scm_tc7_rtl_program, (scm_t_bits) code);
+ else
+ abort ();
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_rtl_program_code, "rtl-program-code", 1, 0, 0,
+ (SCM program),
+ "")
+#define FUNC_NAME s_scm_rtl_program_code
+{
+ SCM_VALIDATE_RTL_PROGRAM (1, program);
+
+ /* FIXME: we need scm_from_uintptr (). */
+ return scm_from_size_t ((size_t) SCM_RTL_PROGRAM_CODE (program));
+}
+#undef FUNC_NAME
+
+void
+scm_i_rtl_program_print (SCM program, SCM port, scm_print_state *pstate)
+{
+ scm_puts_unlocked ("#<rtl-program ", port);
+ scm_uintprint (SCM_UNPACK (program), 16, port);
+ scm_putc_unlocked (' ', port);
+ scm_uintprint ((scm_t_uintptr) SCM_RTL_PROGRAM_CODE (program), 16, port);
+ scm_putc_unlocked ('>', port);
+}
+
void
scm_i_program_print (SCM program, SCM port, scm_print_state *pstate)
{
@@ -121,6 +173,15 @@ SCM_DEFINE (scm_program_p, "program?", 1, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_rtl_program_p, "rtl-program?", 1, 0, 0,
+ (SCM obj),
+ "")
+#define FUNC_NAME s_scm_rtl_program_p
+{
+ return scm_from_bool (SCM_RTL_PROGRAM_P (obj));
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_program_base, "program-base", 1, 0, 0,
(SCM program),
"")