mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 15:40:19 +02:00
Code Activity

add new rtl vm

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2013-05-23 14:52:29 +02:00
parent 1701a68920
commit 510ca12687
19 changed files with 3626 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

54
libguile/objcodes.c
View file

@ -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;
}