mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +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

1
.gitignore vendored
View file

@ -156,3 +156,4 @@ INSTALL
/test-suite/standalone/test-smob-mark
/test-suite/standalone/test-scm-values
/test-suite/standalone/test-scm-to-latin1-string
/libguile/vm-operations.h

11
libguile/Makefile.am
View file

@ -433,9 +433,18 @@ DOT_I_FILES = vm-i-system.i vm-i-scheme.i vm-i-loader.i
.c.i:
$(AM_V_GEN)$(GREP) '^VM_DEFINE' $< > $@
vm-operations.h: vm-engine.c
@echo '/* This file was generated automatically from $<; do not' > $@
@echo ' edit. See the source file for copyright information. */' >> $@
@echo '' >> $@
@echo "#define FOR_EACH_VM_OPERATION(M) \\" >> $@
$(AM_V_GEN)$(GREP) '^ *VM_DEFINE_OP' $< \
| sed -e 's,VM_DEFINE_OP (\(.*\)).*, M (\1) \\,' >> $@
@echo '' >> $@
BUILT_SOURCES = cpp-E.c cpp-SIG.c libpath.h \
scmconfig.h \
$(DOT_I_FILES) $(DOT_X_FILES) $(EXTRA_DOT_X_FILES)
$(DOT_I_FILES) vm-operations.h $(DOT_X_FILES) $(EXTRA_DOT_X_FILES)
# Force the generation of `guile-procedures.texi' because the top-level
# Makefile expects it to be built.

3
libguile/evalext.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011, 2012 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
@ -87,6 +87,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
case scm_tc7_number:
case scm_tc7_string:
case scm_tc7_smob:
case scm_tc7_rtl_program:
case scm_tc7_program:
case scm_tc7_bytevector:
case scm_tc7_array:

12
libguile/frames.c
View file

@ -129,11 +129,21 @@ SCM_DEFINE (scm_frame_num_locals, "frame-num-locals", 1, 0, 0,
"")
#define FUNC_NAME s_scm_frame_num_locals
{
SCM *sp, *p;
SCM *fp, *sp, *p;
unsigned int n = 0;
SCM_VALIDATE_VM_FRAME (1, frame);
fp = SCM_VM_FRAME_FP (frame);
sp = SCM_VM_FRAME_SP (frame);
p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
if (SCM_RTL_PROGRAM_P (fp[-1]))
/* The frame size of an RTL program is fixed, except in the case of
passing a wrong number of arguments to the program. So we do
need to use an SP for determining the number of locals. */
return scm_from_uint32 (sp + 1 - p);
sp = SCM_VM_FRAME_SP (frame);
p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
while (p <= sp)

33
libguile/frames.h
View file

@ -1,4 +1,4 @@
/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
/* Copyright (C) 2001, 2009, 2010, 2011, 2012 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
@ -98,6 +98,37 @@ struct scm_vm_frame
#define SCM_FRAME_PROGRAM(fp) \
(SCM_FRAME_STRUCT (fp)->program)
/*
* RTL frames
*/
/* The frame format for the new RTL programs is almost like that for the
stack-vm programs. They differ in their handling of MV returns,
however. For RTL, every call is an MV call: every call has an MVRA.
Unlike the stack-vm programs, the MVRA for RTL programs is computable
from the RA -- it's always one word (4 bytes) before the RA.
Until we completely migrate to the RTL VM, we will also write the
MVRA to the stack.
When an RTL program returns multiple values, it will shuffle them
down to start contiguously from slot 0, as for a tail call. This
means that when the caller goes to access them, there are 2 or 3
empty words between the top of the caller stack and the bottom of the
values, corresponding to the frame that was just popped.
*/
#define SCM_FRAME_RTL_RETURN_ADDRESS(fp) \
((scm_t_uint32 *) SCM_FRAME_RETURN_ADDRESS (fp))
#define SCM_FRAME_SET_RTL_RETURN_ADDRESS(fp, ip) \
SCM_FRAME_SET_RETURN_ADDRESS (fp, (scm_t_uint8 *) (ip))
#define SCM_FRAME_RTL_MV_RETURN_ADDRESS(fp) \
((scm_t_uint32 *) SCM_FRAME_MV_RETURN_ADDRESS (fp))
#define SCM_FRAME_SET_RTL_MV_RETURN_ADDRESS(fp, ip) \
SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, (scm_t_uint8 *) (ip))
/*
* Heap frames

3
libguile/goops.c
View file

@ -301,6 +301,9 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
else
return scm_class_procedure;
case scm_tc7_rtl_program:
return scm_class_procedure;
case scm_tc7_smob:
{
scm_t_bits type = SCM_TYP16 (x);

166
libguile/instructions.c
View file

@ -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
@ -40,6 +40,83 @@ struct scm_instruction {
SCM symname; /* filled in later */
};
#define OP_HAS_ARITY (1U << 0)
#define FOR_EACH_INSTRUCTION_WORD_TYPE(M) \
M(X32) \
M(U8_X24) \
M(U8_U24) \
M(U8_L24) \
M(U8_R24) \
M(U8_U8_I16) \
M(U8_U8_U8_U8) \
M(U8_U12_U12) \
M(U32) /* Unsigned. */ \
M(I32) /* Immediate. */ \
M(A32) /* Immediate, high bits. */ \
M(B32) /* Immediate, low bits. */ \
M(N32) /* Non-immediate. */ \
M(S32) /* Scheme value (indirected). */ \
M(L32) /* Label. */ \
M(LO32) /* Label with offset. */ \
M(X8_U24) \
M(X8_U12_U12) \
M(X8_R24) \
M(X8_L24) \
M(B1_X7_L24) \
M(B1_U7_L24)
#define TYPE_WIDTH 5
enum word_type
{
#define ENUM(type) type,
FOR_EACH_INSTRUCTION_WORD_TYPE (ENUM)
#undef ENUM
};
static SCM word_type_symbols[] =
{
#define FALSE(type) SCM_BOOL_F,
FOR_EACH_INSTRUCTION_WORD_TYPE (FALSE)
#undef FALSE
};
#define OP(n,type) ((type) << (n*TYPE_WIDTH))
/* The VM_DEFINE_OP macro uses a CPP-based DSL to describe what kinds of
arguments each RTL instruction takes. This piece of code is the only
bit that actually interprets that language. These macro definitions
encode the operand types into bits in a 32-bit integer.
(rtl-instruction-list) parses those encoded values into lists of
symbols, one for each 32-bit word that the operator takes. (system
vm rtl) uses those word types to generate assemblers and
disassemblers for the instructions. */
#define OP1(type0) \
(OP (0, type0))
#define OP2(type0, type1) \
(OP (0, type0) | OP (1, type1))
#define OP3(type0, type1, type2) \
(OP (0, type0) | OP (1, type1) | OP (2, type2))
#define OP4(type0, type1, type2, type3) \
(OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3))
#define OP_DST (1 << (TYPE_WIDTH * 5))
#define WORD_TYPE(n, word) \
(((word) >> ((n) * TYPE_WIDTH)) & ((1 << TYPE_WIDTH) - 1))
struct scm_rtl_instruction {
enum scm_rtl_opcode opcode; /* opcode */
const char *name; /* instruction name */
scm_t_uint32 meta;
SCM symname; /* filled in later */
};
#define SCM_VALIDATE_LOOKUP_INSTRUCTION(pos, var, cvar) \
do { \
cvar = scm_lookup_instruction_by_name (var); \
@ -82,6 +159,37 @@ fetch_instruction_table ()
return table;
}
static struct scm_rtl_instruction*
fetch_rtl_instruction_table ()
{
static struct scm_rtl_instruction *table = NULL;
scm_i_pthread_mutex_lock (&itable_lock);
if (SCM_UNLIKELY (!table))
{
size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_rtl_instruction);
int i;
table = malloc (bytes);
memset (table, 0, bytes);
#define INIT(opcode, tag, name_, meta_) table[opcode].name = name_; table[opcode].meta = meta_;
FOR_EACH_VM_OPERATION (INIT);
#undef INIT
for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
{
table[i].opcode = i;
if (table[i].name)
table[i].symname = scm_from_utf8_symbol (table[i].name);
else
table[i].symname = SCM_BOOL_F;
}
}
scm_i_pthread_mutex_unlock (&itable_lock);
return table;
}
static struct scm_instruction *
scm_lookup_instruction_by_name (SCM name)
{
@ -127,6 +235,57 @@ SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_rtl_instruction_list, "rtl-instruction-list", 0, 0, 0,
(void),
"")
#define FUNC_NAME s_scm_rtl_instruction_list
{
SCM list = SCM_EOL;
int i;
struct scm_rtl_instruction *ip = fetch_rtl_instruction_table ();
for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
if (ip[i].name)
{
scm_t_uint32 meta = ip[i].meta;
SCM tail = SCM_EOL;
int len;
/* Format: (name opcode len rest? out br in) */
if (WORD_TYPE (3, meta))
len = 4;
else if (WORD_TYPE (2, meta))
len = 3;
else if (WORD_TYPE (1, meta))
len = 2;
else if (WORD_TYPE (0, meta))
len = 1;
else
abort ();
switch (len)
{
case 4:
tail = scm_cons (word_type_symbols[WORD_TYPE (3, meta)], tail);
case 3:
tail = scm_cons (word_type_symbols[WORD_TYPE (2, meta)], tail);
case 2:
tail = scm_cons (word_type_symbols[WORD_TYPE (1, meta)], tail);
case 1:
tail = scm_cons (word_type_symbols[WORD_TYPE (0, meta)], tail);
default:
tail = scm_cons (scm_from_int (ip[i].opcode), tail);
tail = scm_cons (ip[i].symname, tail);
break;
}
list = scm_cons (tail, list);
}
return scm_reverse_x (list, SCM_EOL);
}
#undef FUNC_NAME
SCM_DEFINE (scm_instruction_p, "instruction?", 1, 0, 0,
(SCM obj),
"")
@ -208,6 +367,11 @@ scm_bootstrap_instructions (void)
"scm_init_instructions",
(scm_t_extension_init_func)scm_init_instructions,
NULL);
#define INIT(type) \
word_type_symbols[type] = scm_from_utf8_symbol (#type);
FOR_EACH_INSTRUCTION_WORD_TYPE (INIT)
#undef INIT
}
void

57
libguile/instructions.h
View file

@ -1,4 +1,4 @@
/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
/* Copyright (C) 2001, 2009, 2012 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
@ -20,6 +20,59 @@
#define _SCM_INSTRUCTIONS_H_
#include <libguile.h>
#include <libguile/vm-operations.h>
enum scm_rtl_opcode
{
#define ENUM(opcode, tag, name, meta) scm_rtl_op_##tag = opcode,
FOR_EACH_VM_OPERATION(ENUM)
#undef ENUM
};
#define SCM_PACK_RTL_8_8_8(op,a,b,c) ((op) | ((a) << 8) | ((b) << 16) | ((d) << 24))
#define SCM_PACK_RTL_8_16(op,a,b) ((op) | ((a) << 8) | ((b) << 16))
#define SCM_PACK_RTL_16_8(op,a,b) ((op) | ((a) << 16) | ((b) << 24))
#define SCM_PACK_RTL_24(op,a) ((op) | ((a) << 8))
#define SCM_UNPACK_RTL_8_8_8(op,a,b,c) \
do \
{ \
a = (op >> 8) & 0xff; \
b = (op >> 16) & 0xff; \
c = op >> 24; \
} \
while (0)
#define SCM_UNPACK_RTL_8_16(op,a,b) \
do \
{ \
a = (op >> 8) & 0xff; \
b = op >> 16; \
} \
while (0)
#define SCM_UNPACK_RTL_16_8(op,a,b) \
do \
{ \
a = (op >> 8) & 0xffff; \
b = op >> 24; \
} \
while (0)
#define SCM_UNPACK_RTL_12_12(op,a,b) \
do \
{ \
a = (op >> 8) & 0xfff; \
b = op >> 20; \
} \
while (0)
#define SCM_UNPACK_RTL_24(op,a) \
do \
{ \
a = op >> 8; \
} \
while (0)
#define SCM_VM_NUM_INSTRUCTIONS (1<<8)
#define SCM_VM_INSTRUCTION_MASK (SCM_VM_NUM_INSTRUCTIONS-1)
@ -33,6 +86,8 @@ enum scm_opcode {
#undef VM_INSTRUCTION_TO_OPCODE
};
SCM_INTERNAL SCM scm_rtl_instruction_list (void);
SCM_API SCM scm_instruction_list (void);
SCM_API SCM scm_instruction_p (SCM obj);
SCM_API SCM scm_instruction_length (SCM inst);

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

3
libguile/print.c
View file

@ -656,6 +656,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
case scm_tc7_variable:
scm_i_variable_print (exp, port, pstate);
break;
case scm_tc7_rtl_program:
scm_i_rtl_program_print (exp, port, pstate);
break;
case scm_tc7_program:
scm_i_program_print (exp, port, pstate);
break;

8
libguile/procprop.c
View file

@ -80,6 +80,14 @@ scm_i_procedure_arity (SCM proc, int *req, int *opt, int *rest)
see. */
*req -= 1;
return 1;
}
else if (SCM_RTL_PROGRAM_P (proc))
{
*req = 0;
*opt = 0;
*rest = 1;
return 1;
}
else

3
libguile/procs.c
View file

@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2006, 2008, 2009,
* 2010, 2011, 2012 Free Software Foundation, Inc.
* 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
@ -48,6 +48,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
#define FUNC_NAME s_scm_procedure_p
{
return scm_from_bool (SCM_PROGRAM_P (obj)
|| SCM_RTL_PROGRAM_P (obj)
|| (SCM_STRUCTP (obj) && SCM_STRUCT_APPLICABLE_P (obj))
|| (SCM_HAS_TYP7 (obj, scm_tc7_smob)
&& SCM_SMOB_APPLICABLE_P (obj)));

63
libguile/programs.c
View file

@ -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),
"")

27
libguile/programs.h
View file

@ -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
@ -22,6 +22,31 @@
#include <libguile.h>
#include <libguile/objcodes.h>
/*
* The new RTL programs.
*/
#define SCM_RTL_PROGRAM_P(x) (SCM_HAS_TYP7 (x, scm_tc7_rtl_program))
#define SCM_RTL_PROGRAM_CODE(x) ((scm_t_uint32 *) SCM_CELL_WORD_1 (x))
#define SCM_RTL_PROGRAM_FREE_VARIABLES(x) (SCM_CELL_OBJECT_LOC (x, 2))
#define SCM_RTL_PROGRAM_FREE_VARIABLE_REF(x,i) (SCM_RTL_PROGRAM_FREE_VARIABLES (x)[i])
#define SCM_RTL_PROGRAM_FREE_VARIABLE_SET(x,i,v) (SCM_RTL_PROGRAM_FREE_VARIABLES (x)[i]=(v))
#define SCM_RTL_PROGRAM_NUM_FREE_VARIABLES(x) (SCM_CELL_WORD_0 (x) >> 16)
#define SCM_VALIDATE_RTL_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, RTL_PROGRAM_P)
static inline SCM
scm_i_make_rtl_program (const scm_t_uint32 *code)
{
return scm_cell (scm_tc7_rtl_program, (scm_t_bits)code);
}
SCM_INTERNAL SCM scm_make_rtl_program (SCM bytevector, SCM byte_offset, SCM free_variables);
SCM_INTERNAL SCM scm_rtl_program_p (SCM obj);
SCM_INTERNAL SCM scm_rtl_program_code (SCM program);
SCM_INTERNAL void scm_i_rtl_program_print (SCM program, SCM port,
scm_print_state *pstate);
/*
* Programs
*/

2
libguile/tags.h
View file

@ -425,7 +425,7 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
#define scm_tc7_unused_17 61
#define scm_tc7_unused_21 63
#define scm_tc7_unused_19 69
#define scm_tc7_rtl_program 69
#define scm_tc7_program 79
#define scm_tc7_weak_set 85
#define scm_tc7_weak_table 87

3170
libguile/vm-engine.c
View file

File diff suppressed because it is too large Load diff

32
libguile/vm.c
View file

@ -594,6 +594,30 @@ vm_error_bad_wide_string_length (size_t len)
static SCM boot_continuation;
static SCM rtl_boot_continuation;
static SCM rtl_apply;
static SCM rtl_values;
static const scm_t_uint32 rtl_boot_continuation_code[] = {
SCM_PACK_RTL_24 (scm_rtl_op_halt_values, 0), /* empty stack frame in r0-r2, results from r3 */
SCM_PACK_RTL_24 (scm_rtl_op_halt, 0) /* result in r0 */
};
static scm_t_uint32* rtl_boot_multiple_value_continuation_code =
(scm_t_uint32 *) rtl_boot_continuation_code;
static scm_t_uint32* rtl_boot_single_value_continuation_code =
(scm_t_uint32 *) rtl_boot_continuation_code + 1;
static const scm_t_uint32 rtl_apply_code[] = {
SCM_PACK_RTL_24 (scm_rtl_op_apply, 0) /* proc in r0, args from r1, nargs set */
};
static const scm_t_uint32 rtl_values_code[] = {
SCM_PACK_RTL_24 (scm_rtl_op_values, 0) /* vals from r0 */
};
/*
* VM
@ -637,18 +661,22 @@ initialize_default_stack_size (void)
}
#define VM_NAME vm_regular_engine
#define RTL_VM_NAME rtl_vm_regular_engine
#define FUNC_NAME "vm-regular-engine"
#define VM_ENGINE SCM_VM_REGULAR_ENGINE
#include "vm-engine.c"
#undef VM_NAME
#undef RTL_VM_NAME
#undef FUNC_NAME
#undef VM_ENGINE
#define VM_NAME vm_debug_engine
#define RTL_VM_NAME rtl_vm_debug_engine
#define FUNC_NAME "vm-debug-engine"
#define VM_ENGINE SCM_VM_DEBUG_ENGINE
#include "vm-engine.c"
#undef VM_NAME
#undef RTL_VM_NAME
#undef FUNC_NAME
#undef VM_ENGINE
@ -1110,6 +1138,10 @@ scm_init_vm (void)
#ifndef SCM_MAGIC_SNARFER
#include "libguile/vm.x"
#endif
rtl_boot_continuation = scm_i_make_rtl_program (rtl_boot_continuation_code);
rtl_apply = scm_i_make_rtl_program (rtl_apply_code);
rtl_values = scm_i_make_rtl_program (rtl_values_code);
}
/*

5
module/system/vm/instruction.scm
View file

@ -1,6 +1,6 @@
;;; Guile VM instructions
;; Copyright (C) 2001, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2010, 2012 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
@ -19,7 +19,8 @@
;;; Code:
(define-module (system vm instruction)
#:export (instruction-list
#:export (rtl-instruction-list
instruction-list
instruction? instruction-length
instruction-pops instruction-pushes
instruction->opcode opcode->instruction))

2
module/system/vm/program.scm
View file

@ -26,6 +26,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (make-program
make-rtl-program
make-binding binding:name binding:boxed? binding:index
binding:start binding:end
@ -43,6 +44,7 @@
program-meta
program-objcode program? program-objects
rtl-program? rtl-program-code
program-module program-base
program-free-variables
program-num-free-variables