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

Remove stack programs, objcode, and the old VM.

Browse source 
* libguile/Makefile.am:
* libguile/vm-i-loader.c:
* libguile/vm-i-scheme.c:
* libguile/vm-i-system.c: Remove the old VM files, and the rules to
  build the .i files.

* libguile/vm-engine.c:
* libguile/vm.c: Remove the old VM.  Woot!

* libguile/_scm.h (SCM_OBJCODE_COOKIE, SCM_OBJCODE_ENDIANNESS_OFFSET)
  (SCM_OBJCODE_WORD_SIZE_OFFSET): Remove.

* libguile/evalext.c (scm_self_evaluating_p): Remove objcode and program
  cases.

* libguile/frames.c (scm_frame_num_locals, scm_frame_previous): Remove
  program cases.

* libguile/gc.c (scm_i_tag_name): Remove objcode case.
* libguile/goops.c (scm_class_of, create_standard_classes): Remove
  objcode and program cases.

* libguile/instructions.h:
* libguile/instructions.c (scm_instruction_list, scm_instruction_p)
  (scm_instruction_length, scm_instruction_pops, scm_instruction_pushes)
  (scm_instruction_to_opcode, scm_opcode_to_instruction): Remove old VM
  code.

* libguile/objcodes.h:
* libguile/objcodes.c: Remove the objcode data type, and handling for
  objcode files.

* libguile/print.c: Remove objcode and program printers.

* libguile/procprop.c: Remove program cases.
* libguile/procs.c:

* libguile/programs.h:
* libguile/programs.c: Remove old program code.

* libguile/smob.c: Remove objcodes include.

* libguile/snarf.h: Remove static program defines.

* libguile/stacks.c: Remove program case.

* libguile/tags.h: Remove program and objcode tc7s.

* module/ice-9/session.scm (procedure-arguments)
* module/language/tree-il/analyze.scm (validate-arity)
* module/statprof.scm (get-call-data, procedure=?)
* module/system/vm/frame.scm (frame-bindings)
  (frame-call-representation): Remove old program cases.

* module/system/repl/debug.scm (frame->module): Add a FIXME.

* module/system/vm/instruction.scm: Remove old exports.

* module/system/vm/program.scm: Remove old program code.
This commit is contained in:
Andy Wingo 2013-11-08 18:28:24 +01:00
parent 84680d2382
commit 1c33be992e
31 changed files with 51 additions and 4308 deletions
Download patch file Download diff file Expand all files Collapse all files

430
libguile/vm-engine.c
View file

@ -19,32 +19,6 @@
/* This file is included in vm.c multiple times. */
/* Virtual Machine
This file contains two virtual machines. First, the old one -- the
one that is currently used, and corresponds to Guile 2.0. It's a
stack machine, meaning that most instructions pop their operands from
the top of the stack, and push results there too.
Following it is the new virtual machine. It's a register machine,
meaning that intructions address their operands by index, and store
results in indexed slots as well. Those slots are on the stack.
It's somewhat confusing to call it a register machine, given that the
values are on the stack. Perhaps it needs a new name.
Anyway, things are in a transitional state. We're going to try to
avoid munging the old VM very much while we flesh out the new one.
We're also going to try to make them interoperable, as much as
possible -- to have the old VM be able to call procedures for the new
VM, and vice versa. This should ease the bootstrapping process. */
/* The old VM. */
static SCM VM_NAME (SCM, SCM, SCM*, int);
/* The new VM. */
static SCM RTL_VM_NAME (SCM, SCM, SCM*, size_t);
#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
# define VM_USE_HOOKS 0 /* Various hooks */
#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
@ -70,9 +44,6 @@ static SCM RTL_VM_NAME (SCM, SCM, SCM*, size_t);
#ifndef IP_REG
# define IP_REG
#endif
#ifndef SP_REG
# define SP_REG
#endif
#ifndef FP_REG
# define FP_REG
#endif
@ -126,393 +97,6 @@ static SCM RTL_VM_NAME (SCM, SCM, SCM*, size_t);
SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
/* Cache the VM's instruction, stack, and frame pointer in local variables. */
#define CACHE_REGISTER() \
{ \
ip = vp->ip; \
sp = vp->sp; \
fp = vp->fp; \
}
/* Update the registers in VP, a pointer to the current VM. This must be done
at least before any GC invocation so that `vp->sp' is up-to-date and the
whole stack gets marked. */
#define SYNC_REGISTER() \
{ \
vp->ip = ip; \
vp->sp = sp; \
vp->fp = fp; \
}
/* FIXME */
#define ASSERT_VARIABLE(x) \
VM_ASSERT (SCM_VARIABLEP (x), abort())
#define ASSERT_BOUND_VARIABLE(x) \
VM_ASSERT (SCM_VARIABLEP (x) \
&& !scm_is_eq (SCM_VARIABLE_REF (x), SCM_UNDEFINED), \
abort())
#ifdef VM_ENABLE_PARANOID_ASSERTIONS
#define CHECK_IP() \
do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
#define ASSERT_ALIGNED_PROCEDURE() \
do { if ((scm_t_bits)bp % 8) abort (); } while (0)
#define ASSERT_BOUND(x) \
VM_ASSERT (!scm_is_eq ((x), SCM_UNDEFINED), abort())
#else
#define CHECK_IP()
#define ASSERT_ALIGNED_PROCEDURE()
#define ASSERT_BOUND(x)
#endif
/* Cache the object table and free variables. */
#define CACHE_PROGRAM() \
{ \
if (bp != SCM_PROGRAM_DATA (program)) { \
bp = SCM_PROGRAM_DATA (program); \
ASSERT_ALIGNED_PROCEDURE (); \
if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) { \
objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program)); \
} else { \
objects = NULL; \
} \
} \
}
#define SYNC_BEFORE_GC() \
{ \
SYNC_REGISTER (); \
}
#define SYNC_ALL() \
{ \
SYNC_REGISTER (); \
}
/*
* Error check
*/
/* Accesses to a program's object table. */
#define CHECK_OBJECT(_num)
#define CHECK_FREE_VARIABLE(_num)
/*
* Stack operation
*/
#ifdef VM_ENABLE_STACK_NULLING
# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
/* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
that continuation doesn't have a chance to run. It's not important on a
semantic level, but it does mess up our stack nulling -- so this macro is to
fix that. */
# define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
#else
# define CHECK_STACK_LEAKN(_n)
# define CHECK_STACK_LEAK()
# define NULLSTACK(_n)
# define NULLSTACK_FOR_NONLOCAL_EXIT()
#endif
/* For this check, we don't use VM_ASSERT, because that leads to a
per-site SYNC_ALL, which is too much code growth. The real problem
of course is having to check for overflow all the time... */
#define CHECK_OVERFLOW() \
do { if (SCM_UNLIKELY (sp >= stack_limit)) goto handle_overflow; } while (0)
#ifdef VM_CHECK_UNDERFLOW
#define PRE_CHECK_UNDERFLOW(N) \
VM_ASSERT (sp - (N) > SCM_FRAME_UPPER_ADDRESS (fp), vm_error_stack_underflow ())
#define CHECK_UNDERFLOW() PRE_CHECK_UNDERFLOW (0)
#else
#define PRE_CHECK_UNDERFLOW(N) /* nop */
#define CHECK_UNDERFLOW() /* nop */
#endif
#define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
#define DROP() do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
#define POP(x) do { PRE_CHECK_UNDERFLOW (1); x = *sp--; NULLSTACK (1); } while (0)
#define POP2(x,y) do { PRE_CHECK_UNDERFLOW (2); x = *sp--; y = *sp--; NULLSTACK (2); } while (0)
#define POP3(x,y,z) do { PRE_CHECK_UNDERFLOW (3); x = *sp--; y = *sp--; z = *sp--; NULLSTACK (3); } while (0)
/* Pop the N objects on top of the stack and push a list that contains
them. */
#define POP_LIST(n) \
do \
{ \
int i; \
SCM l = SCM_EOL, x; \
SYNC_BEFORE_GC (); \
for (i = n; i; i--) \
{ \
POP (x); \
l = scm_cons (x, l); \
} \
PUSH (l); \
} while (0)
/* The opposite: push all of the elements in L onto the list. */
#define PUSH_LIST(l, NILP) \
do \
{ \
for (; scm_is_pair (l); l = SCM_CDR (l)) \
PUSH (SCM_CAR (l)); \
VM_ASSERT (NILP (l), vm_error_improper_list (l)); \
} while (0)
/*
* Instruction operation
*/
#define FETCH() (*ip++)
#define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)
#undef NEXT_JUMP
#ifdef HAVE_LABELS_AS_VALUES
# define NEXT_JUMP() goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
#else
# define NEXT_JUMP() goto vm_start
#endif
#define NEXT \
{ \
NEXT_HOOK (); \
CHECK_STACK_LEAK (); \
NEXT_JUMP (); \
}
/* See frames.h for the layout of stack frames */
/* When this is called, bp points to the new program data,
and the arguments are already on the stack */
#define DROP_FRAME() \
{ \
sp -= 3; \
NULLSTACK (3); \
CHECK_UNDERFLOW (); \
}
static SCM
VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
{
/* VM registers */
register scm_t_uint8 *ip IP_REG; /* instruction pointer */
register SCM *sp SP_REG; /* stack pointer */
register SCM *fp FP_REG; /* frame pointer */
struct scm_vm *vp = SCM_VM_DATA (vm);
/* Cache variables */
struct scm_objcode *bp = NULL; /* program base pointer */
SCM *objects = NULL; /* constant objects */
SCM *stack_limit = vp->stack_limit; /* stack limit address */
scm_i_thread *current_thread = SCM_I_CURRENT_THREAD;
/* Internal variables */
int nvalues = 0;
scm_i_jmp_buf registers; /* used for prompts */
#ifdef HAVE_LABELS_AS_VALUES
static const void **jump_table_pointer = NULL;
#endif
#ifdef HAVE_LABELS_AS_VALUES
register const void **jump_table JT_REG;
if (SCM_UNLIKELY (!jump_table_pointer))
{
int i;
jump_table_pointer = malloc (SCM_VM_NUM_INSTRUCTIONS * sizeof (void*));
for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
jump_table_pointer[i] = &&vm_error_bad_instruction;
#define VM_INSTRUCTION_TO_LABEL 1
#define jump_table jump_table_pointer
#include <libguile/vm-expand.h>
#include <libguile/vm-i-system.i>
#include <libguile/vm-i-scheme.i>
#include <libguile/vm-i-loader.i>
#undef jump_table
#undef VM_INSTRUCTION_TO_LABEL
}
/* Attempt to keep JUMP_TABLE_POINTER in a register. This saves one
load instruction at each instruction dispatch. */
jump_table = jump_table_pointer;
#endif
if (SCM_I_SETJMP (registers))
{
/* Non-local return. Cache the VM registers back from the vp, and
go to the handler.
Note, at this point, we must assume that any variable local to
vm_engine that can be assigned *has* been assigned. So we need to pull
all our state back from the ip/fp/sp.
*/
CACHE_REGISTER ();
program = SCM_FRAME_PROGRAM (fp);
CACHE_PROGRAM ();
/* The stack contains the values returned to this continuation,
along with a number-of-values marker -- like an MV return. */
ABORT_CONTINUATION_HOOK (sp - SCM_I_INUM (*sp), SCM_I_INUM (*sp));
NEXT;
}
CACHE_REGISTER ();
/* Since it's possible to receive the arguments on the stack itself,
and indeed the RTL VM invokes us that way, shuffle up the
arguments first. */
VM_ASSERT (sp + 8 + nargs < stack_limit, vm_error_too_many_args (nargs));
{
int i;
for (i = nargs - 1; i >= 0; i--)
sp[9 + i] = argv[i];
}
/* Initial frame */
PUSH (SCM_PACK (fp)); /* dynamic link */
PUSH (SCM_PACK (0)); /* mvra */
PUSH (SCM_PACK (ip)); /* ra */
PUSH (boot_continuation);
fp = sp + 1;
ip = SCM_C_OBJCODE_BASE (SCM_PROGRAM_DATA (boot_continuation));
/* MV-call frame, function & arguments */
PUSH (SCM_PACK (fp)); /* dynamic link */
PUSH (SCM_PACK (ip + 1)); /* mvra */
PUSH (SCM_PACK (ip)); /* ra */
PUSH (program);
fp = sp + 1;
sp += nargs;
PUSH_CONTINUATION_HOOK ();
apply:
program = fp[-1];
if (!SCM_PROGRAM_P (program))
{
if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program))
fp[-1] = SCM_STRUCT_PROCEDURE (program);
else if (SCM_HAS_TYP7 (program, scm_tc7_rtl_program))
{
SCM ret;
SYNC_ALL ();
ret = RTL_VM_NAME (vm, program, fp, sp - fp + 1);
NULLSTACK_FOR_NONLOCAL_EXIT ();
if (SCM_UNLIKELY (SCM_VALUESP (ret)))
{
/* multiple values returned to continuation */
ret = scm_struct_ref (ret, SCM_INUM0);
nvalues = scm_ilength (ret);
PUSH_LIST (ret, scm_is_null);
goto vm_return_values;
}
else
{
PUSH (ret);
goto vm_return;
}
}
else if (SCM_HAS_TYP7 (program, scm_tc7_smob)
&& SCM_SMOB_APPLICABLE_P (program))
{
/* (smob arg0 ... argN) => (apply-smob smob arg0 ... argN) */
int i;
PUSH (SCM_BOOL_F);
for (i = sp - fp; i >= 0; i--)
fp[i] = fp[i - 1];
fp[-1] = SCM_SMOB_DESCRIPTOR (program).apply_trampoline;
}
else
{
SYNC_ALL();
vm_error_wrong_type_apply (program);
}
goto apply;
}
CACHE_PROGRAM ();
ip = SCM_C_OBJCODE_BASE (bp);
APPLY_HOOK ();
/* Let's go! */
NEXT;
#ifndef HAVE_LABELS_AS_VALUES
vm_start:
switch ((*ip++) & SCM_VM_INSTRUCTION_MASK) {
#endif
#include "vm-expand.h"
#include "vm-i-system.c"
#include "vm-i-scheme.c"
#include "vm-i-loader.c"
#ifndef HAVE_LABELS_AS_VALUES
default:
goto vm_error_bad_instruction;
}
#endif
abort (); /* never reached */
vm_error_bad_instruction:
vm_error_bad_instruction (ip[-1]);
abort (); /* never reached */
handle_overflow:
SYNC_ALL ();
vm_error_stack_overflow (vp);
abort (); /* never reached */
}
#undef ALIGNED_P
#undef CACHE_REGISTER
#undef CHECK_OVERFLOW
#undef FUNC2
#undef INIT
#undef INUM_MAX
#undef INUM_MIN
#undef INUM_STEP
#undef jump_table
#undef LOCAL_REF
#undef LOCAL_SET
#undef NEXT
#undef NEXT_JUMP
#undef REL
#undef RETURN
#undef RETURN_ONE_VALUE
#undef RETURN_VALUE_LIST
#undef SYNC_ALL
#undef SYNC_BEFORE_GC
#undef SYNC_IP
#undef SYNC_REGISTER
#undef VARIABLE_BOUNDP
#undef VARIABLE_REF
#undef VARIABLE_SET
#undef VM_DEFINE_OP
#undef VM_INSTRUCTION_TO_LABEL
/* Virtual Machine
This is Guile's new virtual machine. When I say "new", I mean
@ -918,22 +502,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
continue;
}
#if 0
SYNC_IP();
vm_error_wrong_type_apply (proc);
#else
{
SCM ret;
SYNC_ALL ();
ret = VM_NAME (vm, fp[-1], fp, FRAME_LOCALS_COUNT () - 1);
if (SCM_UNLIKELY (SCM_VALUESP (ret)))
RETURN_VALUE_LIST (scm_struct_ref (ret, SCM_INUM0));
else
RETURN_ONE_VALUE (ret);
}
#endif
}
/* Let's go! */