mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 20:30:28 +02:00
53bdfcf034
* libguile/vm.c: (vm_error): (vm_error_bad_instruction): (vm_error_unbound): (vm_error_unbound_fluid): (vm_error_not_a_variable): (vm_error_not_a_thunk): (vm_error_apply_to_non_list): (vm_error_kwargs_length_not_even): (vm_error_kwargs_invalid_keyword): (vm_error_kwargs_unrecognized_keyword): (vm_error_too_many_args): (vm_error_wrong_num_args): (vm_error_wrong_type_apply): (vm_error_stack_overflow): (vm_error_stack_underflow): (vm_error_improper_list): (vm_error_not_a_pair): (vm_error_not_a_bytevector): (vm_error_not_a_struct): (vm_error_no_values): (vm_error_not_enough_values): (vm_error_continuation_not_rewindable): (vm_error_bad_wide_string_length): (vm_error_invalid_address): (vm_error_object): (vm_error_free_variable): New internal helpers, implementing VM error handling. * libguile/vm-engine.h (VM_ASSERT): New helper macro. (ASSERT, CHECK_OBJECT, CHECK_FREE_VARIABLE): (PRE_CHECK_UNDERFLOW, PUSH_LIST): Use the new helper. * libguile/vm-i-loader.c: * libguile/vm-i-scheme.c: * libguile/vm-i-system.c: Use VM_ASSERT and the out-of-line error handlers. * libguile/vm-engine.c (vm_engine): Remove inline error handlers, and remove a couple of local vars. Use VM_ASSERT. Have halt handle the return itself.
155 lines
4.3 KiB
C
155 lines
4.3 KiB
C
/* 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
|
|
* as published by the Free Software Foundation; either version 3 of
|
|
* the License, or (at your option) any later version.
|
|
*
|
|
* This library is distributed in the hope that it will be useful, but
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
* Lesser General Public License for more details.
|
|
*
|
|
* You should have received a copy of the GNU Lesser General Public
|
|
* License along with this library; if not, write to the Free Software
|
|
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
|
* 02110-1301 USA
|
|
*/
|
|
|
|
/* This file is included in vm.c multiple times */
|
|
|
|
#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
|
|
#define VM_USE_HOOKS 0 /* Various hooks */
|
|
#define VM_CHECK_OBJECT 0 /* Check object table */
|
|
#define VM_CHECK_FREE_VARIABLES 0 /* Check free variable access */
|
|
#define VM_CHECK_UNDERFLOW 0 /* Check underflow when popping values */
|
|
#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
|
|
#define VM_USE_HOOKS 1
|
|
#define VM_CHECK_OBJECT 0
|
|
#define VM_CHECK_FREE_VARIABLES 0
|
|
#define VM_CHECK_UNDERFLOW 0 /* Check underflow when popping values */
|
|
#else
|
|
#error unknown debug engine VM_ENGINE
|
|
#endif
|
|
|
|
#include "vm-engine.h"
|
|
|
|
|
|
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 */
|
|
#if VM_CHECK_OBJECT
|
|
size_t object_count = 0; /* length of OBJECTS */
|
|
#endif
|
|
SCM *stack_limit = vp->stack_limit; /* stack limit address */
|
|
|
|
scm_i_thread *current_thread = SCM_I_CURRENT_THREAD;
|
|
scm_t_int64 vm_cookie = vp->cookie++;
|
|
|
|
/* Internal variables */
|
|
int nvalues = 0;
|
|
|
|
#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
|
|
|
|
/* Initialization */
|
|
{
|
|
SCM prog = program;
|
|
|
|
/* Boot program */
|
|
program = vm_make_boot_program (nargs);
|
|
|
|
/* Initial frame */
|
|
CACHE_REGISTER ();
|
|
PUSH (SCM_PACK (fp)); /* dynamic link */
|
|
PUSH (SCM_PACK (0)); /* mvra */
|
|
PUSH (SCM_PACK (ip)); /* ra */
|
|
CACHE_PROGRAM ();
|
|
PUSH (program);
|
|
fp = sp + 1;
|
|
ip = SCM_C_OBJCODE_BASE (bp);
|
|
/* MV-call frame, function & arguments */
|
|
PUSH (SCM_PACK (0)); /* dynamic link */
|
|
PUSH (SCM_PACK (0)); /* mvra */
|
|
PUSH (SCM_PACK (0)); /* ra */
|
|
PUSH (prog);
|
|
VM_ASSERT (sp + nargs < stack_limit, vm_error_too_many_args (nargs));
|
|
while (nargs--)
|
|
PUSH (*argv++);
|
|
}
|
|
|
|
/* 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 VM_USE_HOOKS
|
|
#undef VM_CHECK_OBJECT
|
|
#undef VM_CHECK_FREE_VARIABLE
|
|
#undef VM_CHECK_UNDERFLOW
|
|
|
|
/*
|
|
Local Variables:
|
|
c-file-style: "gnu"
|
|
End:
|
|
*/
|