summaryrefslogtreecommitdiff
path: root/libguile/objcodes.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/objcodes.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/objcodes.c')
-rw-r--r--libguile/objcodes.c54
1 files changed, 41 insertions, 13 deletions
diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index 4daba55ab..734bddeb3 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -94,7 +94,8 @@ static void register_elf (char *data, size_t len);
enum bytecode_kind
{
BYTECODE_KIND_NONE,
- BYTECODE_KIND_GUILE_2_0
+ BYTECODE_KIND_GUILE_2_0,
+ BYTECODE_KIND_GUILE_2_2
};
static SCM
@@ -110,6 +111,10 @@ pointer_to_procedure (enum bytecode_kind bytecode_kind, char *ptr)
objcode = scm_double_cell (tag, (scm_t_bits) ptr, SCM_BOOL_F_BITS, 0);
return scm_make_program (objcode, SCM_BOOL_F, SCM_UNDEFINED);
}
+ case BYTECODE_KIND_GUILE_2_2:
+ {
+ return scm_i_make_rtl_program ((scm_t_uint32 *) ptr);
+ }
case BYTECODE_KIND_NONE:
default:
abort ();
@@ -302,29 +307,52 @@ process_dynamic_segment (char *base, Elf_Phdr *dyn_phdr,
{
scm_t_uint16 major = dyn[i].d_un.d_val >> 16;
scm_t_uint16 minor = dyn[i].d_un.d_val & 0xffff;
- if (major != 0x0200)
- return "incompatible bytecode kind";
- if (minor > SCM_OBJCODE_MINOR_VERSION)
- return "incompatible bytecode version";
- bytecode_kind = BYTECODE_KIND_GUILE_2_0;
+ switch (major)
+ {
+ case 0x0200:
+ bytecode_kind = BYTECODE_KIND_GUILE_2_0;
+ if (minor > SCM_OBJCODE_MINOR_VERSION)
+ return "incompatible bytecode version";
+ break;
+ case 0x0202:
+ bytecode_kind = BYTECODE_KIND_GUILE_2_2;
+ if (minor)
+ return "incompatible bytecode version";
+ break;
+ default:
+ return "incompatible bytecode kind";
+ }
break;
}
}
}
- if (bytecode_kind != BYTECODE_KIND_GUILE_2_0)
- return "missing DT_GUILE_RTL_VERSION";
- if (init)
- return "unexpected DT_INIT";
- if ((scm_t_uintptr) entry % 8)
- return "unaligned DT_GUILE_ENTRY";
if (!entry)
return "missing DT_GUILE_ENTRY";
+ switch (bytecode_kind)
+ {
+ case BYTECODE_KIND_GUILE_2_0:
+ if (init)
+ return "unexpected DT_INIT";
+ if ((scm_t_uintptr) entry % 8)
+ return "unaligned DT_GUILE_ENTRY";
+ break;
+ case BYTECODE_KIND_GUILE_2_2:
+ if ((scm_t_uintptr) init % 4)
+ return "unaligned DT_INIT";
+ if ((scm_t_uintptr) entry % 4)
+ return "unaligned DT_GUILE_ENTRY";
+ break;
+ case BYTECODE_KIND_NONE:
+ default:
+ return "missing DT_GUILE_RTL_VERSION";
+ }
+
if (gc_root)
GC_add_roots (gc_root, gc_root + gc_root_size);
- *init_out = SCM_BOOL_F;
+ *init_out = init ? pointer_to_procedure (bytecode_kind, init) : SCM_BOOL_F;
*entry_out = pointer_to_procedure (bytecode_kind, entry);
return NULL;
}