mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-19 19:20:23 +02:00
Initial revision
This commit is contained in:
Keisuke Nishida
commit
a98cef7e6c
36 changed files with 5255 additions and 0 deletions
345
src/vm_engine.h
Normal file
345
src/vm_engine.h
Normal file
|
|
@ -0,0 +1,345 @@
|
|||
/* Copyright (C) 2000 Free Software Foundation, Inc.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program 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 General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
* As a special exception, the Free Software Foundation gives permission
|
||||
* for additional uses of the text contained in its release of GUILE.
|
||||
*
|
||||
* The exception is that, if you link the GUILE library with other files
|
||||
* to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the GUILE library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the
|
||||
* Free Software Foundation under the name GUILE. If you copy
|
||||
* code from other Free Software Foundation releases into a copy of
|
||||
* GUILE, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for GUILE, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice. */
|
||||
|
||||
/* This file is included in vm_engine.c */
|
||||
|
||||
/*
|
||||
* VM Options
|
||||
*/
|
||||
|
||||
#undef VM_USE_BOOT_HOOK
|
||||
#undef VM_USE_HALT_HOOK
|
||||
#undef VM_USE_NEXT_HOOK
|
||||
#undef VM_USE_CALL_HOOK
|
||||
#undef VM_USE_APPLY_HOOK
|
||||
#undef VM_USE_RETURN_HOOK
|
||||
#undef VM_INIT_LOCAL_VARIABLES
|
||||
#undef VM_CHECK_LINK
|
||||
#undef VM_CHECK_BINDING
|
||||
#undef VM_CHECK_PROGRAM_COUNTER
|
||||
|
||||
#if VM_ENGINE == SCM_VM_REGULAR_ENGINE
|
||||
#define VM_USE_BOOT_HOOK 0
|
||||
#define VM_USE_HALT_HOOK 0
|
||||
#define VM_USE_NEXT_HOOK 0
|
||||
#define VM_USE_CALL_HOOK 0
|
||||
#define VM_USE_APPLY_HOOK 0
|
||||
#define VM_USE_RETURN_HOOK 0
|
||||
#define VM_INIT_LOCAL_VARIABLES 0
|
||||
#define VM_CHECK_LINK 0
|
||||
#define VM_CHECK_BINDING 1
|
||||
#define VM_CHECK_PROGRAM_COUNTER 0
|
||||
#else
|
||||
#if VM_ENGINE == SCM_VM_DEBUG_ENGINE
|
||||
#define VM_USE_BOOT_HOOK 1
|
||||
#define VM_USE_HALT_HOOK 1
|
||||
#define VM_USE_NEXT_HOOK 1
|
||||
#define VM_USE_CALL_HOOK 1
|
||||
#define VM_USE_APPLY_HOOK 1
|
||||
#define VM_USE_RETURN_HOOK 1
|
||||
#define VM_INIT_LOCAL_VARIABLES 1
|
||||
#define VM_CHECK_LINK 1
|
||||
#define VM_CHECK_BINDING 1
|
||||
#define VM_CHECK_PROGRAM_COUNTER 1
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#undef VM_USE_HOOK
|
||||
#if VM_USE_BOOT_HOOK || VM_USE_HALT_HOOK || VM_USE_NEXT_HOOK \
|
||||
|| VM_USE_CALL_HOOK || VM_USE_APPLY_HOOK || VM_USE_RETURN_HOOK
|
||||
#define VM_USE_HOOK 1
|
||||
#else
|
||||
#define VM_USE_HOOK 0
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
* Type checking
|
||||
*/
|
||||
|
||||
#define VM_ASSERT_PROGRAM(OBJ) SCM_VALIDATE_PROGRAM (1, OBJ)
|
||||
|
||||
#undef VM_ASSERT_BOUND
|
||||
#if VM_CHECK_BINDING
|
||||
#define VM_ASSERT_BOUND(CELL) \
|
||||
if (SCM_UNBNDP (SCM_CDR (CELL))) \
|
||||
SCM_MISC_ERROR ("Unbound variable: ~S", SCM_LIST1 (SCM_CAR (CELL)))
|
||||
#else
|
||||
#define VM_ASSERT_BOUND(CELL)
|
||||
#endif
|
||||
|
||||
#undef VM_ASSERT_LINK
|
||||
#if VM_CHECK_LINK
|
||||
#define VM_ASSERT_LINK(OBJ) \
|
||||
if (SCM_FALSEP (OBJ)) \
|
||||
SCM_MISC_ERROR ("VM broken link", SCM_EOL)
|
||||
#else
|
||||
#define VM_ASSERT_LINK(OBJ)
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
* Hooks
|
||||
*/
|
||||
|
||||
#undef VM_BOOT_HOOK
|
||||
#if VM_USE_BOOT_HOOK
|
||||
#define VM_BOOT_HOOK() SYNC (); scm_c_run_hook (vmp->boot_hook, hook_args)
|
||||
#else
|
||||
#define VM_BOOT_HOOK()
|
||||
#endif
|
||||
|
||||
#undef VM_HALT_HOOK
|
||||
#if VM_USE_HALT_HOOK
|
||||
#define VM_HALT_HOOK() SYNC (); scm_c_run_hook (vmp->halt_hook, hook_args)
|
||||
#else
|
||||
#define VM_HALT_HOOK()
|
||||
#endif
|
||||
|
||||
#undef VM_NEXT_HOOK
|
||||
#if VM_USE_NEXT_HOOK
|
||||
#define VM_NEXT_HOOK() SYNC (); scm_c_run_hook (vmp->next_hook, hook_args)
|
||||
#else
|
||||
#define VM_NEXT_HOOK()
|
||||
#endif
|
||||
|
||||
#undef VM_CALL_HOOK
|
||||
#if VM_USE_CALL_HOOK
|
||||
#define VM_CALL_HOOK() SYNC (); scm_c_run_hook (vmp->call_hook, hook_args)
|
||||
#else
|
||||
#define VM_CALL_HOOK()
|
||||
#endif
|
||||
|
||||
#undef VM_APPLY_HOOK
|
||||
#if VM_USE_APPLY_HOOK
|
||||
#define VM_APPLY_HOOK() SYNC (); scm_c_run_hook (vmp->apply_hook, hook_args)
|
||||
#else
|
||||
#define VM_APPLY_HOOK()
|
||||
#endif
|
||||
|
||||
#undef VM_RETURN_HOOK
|
||||
#if VM_USE_RETURN_HOOK
|
||||
#define VM_RETURN_HOOK() SYNC (); scm_c_run_hook (vmp->return_hook, hook_args)
|
||||
#else
|
||||
#define VM_RETURN_HOOK()
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
* Basic operations
|
||||
*/
|
||||
|
||||
#define LOAD() \
|
||||
{ \
|
||||
ac = vmp->ac; \
|
||||
pc = vmp->pc; \
|
||||
sp = vmp->sp; \
|
||||
fp = vmp->fp; \
|
||||
stack_base = vmp->stack_base; \
|
||||
stack_limit = vmp->stack_limit; \
|
||||
}
|
||||
|
||||
#define SYNC() \
|
||||
{ \
|
||||
vmp->ac = ac; \
|
||||
vmp->pc = pc; \
|
||||
vmp->sp = sp; \
|
||||
vmp->fp = fp; \
|
||||
}
|
||||
|
||||
#define FETCH() *pc++
|
||||
|
||||
#define CONS(X,Y,Z) \
|
||||
{ \
|
||||
SCM cell; \
|
||||
SYNC (); \
|
||||
SCM_NEWCELL (cell); \
|
||||
SCM_SET_CELL_OBJECT_0 (cell, Y); \
|
||||
SCM_SET_CELL_OBJECT_1 (cell, Z); \
|
||||
X = cell; \
|
||||
}
|
||||
|
||||
#define VM_SETUP_ARGS2() an = 2; a2 = ac; POP (ac);
|
||||
#define VM_SETUP_ARGS3() an = 3; a3 = ac; POP (a2); POP (ac);
|
||||
#define VM_SETUP_ARGS4() an = 4; a4 = ac; POP (a3); POP (a2); POP (ac);
|
||||
#define VM_SETUP_ARGSN() an = SCM_INUM (FETCH ());
|
||||
|
||||
|
||||
/*
|
||||
* Stack operation
|
||||
*/
|
||||
|
||||
#define PUSH(X) \
|
||||
{ \
|
||||
if (sp < stack_base) \
|
||||
SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL); \
|
||||
*sp-- = (X); \
|
||||
}
|
||||
|
||||
#define POP(X) \
|
||||
{ \
|
||||
if (sp == stack_limit) \
|
||||
SCM_MISC_ERROR ("FIXME: Stack underflow", SCM_EOL); \
|
||||
(X) = *++sp; \
|
||||
}
|
||||
|
||||
#define POP_LIST(N,L) \
|
||||
{ \
|
||||
while (N-- > 0) \
|
||||
{ \
|
||||
SCM obj; \
|
||||
POP (obj); \
|
||||
CONS (L, obj, L); \
|
||||
} \
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Frame allocation
|
||||
*/
|
||||
|
||||
/* an = the number of arguments */
|
||||
#define VM_SETUP_ARGS(PROG,NREQS,RESTP) \
|
||||
{ \
|
||||
if (RESTP) \
|
||||
/* have a rest argument */ \
|
||||
{ \
|
||||
SCM list; \
|
||||
if (an < NREQS) \
|
||||
scm_wrong_num_args (PROG); \
|
||||
\
|
||||
/* Construct the rest argument list */ \
|
||||
an -= NREQS; /* the number of rest arguments */ \
|
||||
list = SCM_EOL; /* list of the rest arguments */ \
|
||||
POP_LIST (an, list); \
|
||||
PUSH (list); \
|
||||
} \
|
||||
else \
|
||||
/* not have a rest argument */ \
|
||||
{ \
|
||||
if (an != NREQS) \
|
||||
scm_wrong_num_args (PROG); \
|
||||
} \
|
||||
}
|
||||
|
||||
#define VM_EXPORT_ARGS(FP,PROG) \
|
||||
{ \
|
||||
int *exts = SCM_PROGRAM_EXTS (PROG); \
|
||||
if (exts) \
|
||||
{ \
|
||||
int n = exts[0]; \
|
||||
while (n-- > 0) \
|
||||
SCM_VM_EXTERNAL_VARIABLE (SCM_PROGRAM_ENV (PROG), n) \
|
||||
= SCM_VM_FRAME_VARIABLE (FP, exts[n + 1]); \
|
||||
} \
|
||||
}
|
||||
|
||||
#undef VM_FRAME_INIT_VARIABLES
|
||||
#if VM_INIT_LOCAL_VARIABLES
|
||||
/* This is necessary when creating frame objects for debugging */
|
||||
#define VM_FRAME_INIT_VARIABLES(FP,NVARS) \
|
||||
{ \
|
||||
int i; \
|
||||
for (i = 0; i < NVARS; i++) \
|
||||
SCM_VM_FRAME_VARIABLE (FP, i) = SCM_UNDEFINED; \
|
||||
}
|
||||
#else
|
||||
#define VM_FRAME_INIT_VARIABLES(FP,NVARS)
|
||||
#endif
|
||||
|
||||
#define VM_NEW_FRAME(FP,PROG,DL,SP,RA) \
|
||||
{ \
|
||||
int nvars = SCM_PROGRAM_NVARS (PROG); /* the number of local vars */ \
|
||||
int nreqs = SCM_PROGRAM_NREQS (PROG); /* the number of required args */ \
|
||||
int restp = SCM_PROGRAM_RESTP (PROG); /* have a rest argument or not */ \
|
||||
\
|
||||
VM_SETUP_ARGS (PROG, nreqs, restp); \
|
||||
if (sp - nvars - SCM_VM_FRAME_DATA_SIZE < stack_base - 1) \
|
||||
SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL); \
|
||||
sp -= nvars + SCM_VM_FRAME_DATA_SIZE; \
|
||||
FP = sp + SCM_VM_FRAME_DATA_SIZE + 1; \
|
||||
SCM_VM_FRAME_SIZE (FP) = SCM_MAKINUM (nvars); \
|
||||
SCM_VM_FRAME_PROGRAM (FP) = PROG; \
|
||||
SCM_VM_FRAME_DYNAMIC_LINK (FP) = DL; \
|
||||
SCM_VM_FRAME_STACK_POINTER (FP) = SP; \
|
||||
SCM_VM_FRAME_RETURN_ADDRESS (FP) = RA; \
|
||||
VM_FRAME_INIT_VARIABLES (FP, nvars); \
|
||||
VM_EXPORT_ARGS (FP, PROG); \
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Goto next
|
||||
*/
|
||||
|
||||
#undef VM_PROGRAM_COUNTER_CHECK
|
||||
#if VM_CHECK_PROGRAM_COUNTER
|
||||
#define VM_PROGRAM_COUNTER_CHECK() \
|
||||
{ \
|
||||
SCM prog = SCM_VM_FRAME_PROGRAM (fp); \
|
||||
if (pc < SCM_PROGRAM_BASE (prog) \
|
||||
|| pc >= (SCM_PROGRAM_BASE (prog) + SCM_PROGRAM_SIZE (prog))) \
|
||||
SCM_MISC_ERROR ("VM accessed invalid program address", SCM_EOL); \
|
||||
}
|
||||
#else
|
||||
#define VM_PROGRAM_COUNTER_CHECK()
|
||||
#endif
|
||||
|
||||
#undef VM_GOTO_NEXT
|
||||
#if HAVE_LABELS_AS_VALUES
|
||||
#if VM_ENGINE == SCM_VM_DEBUG_ENGINE
|
||||
#define VM_GOTO_NEXT() goto *SCM_CODE_TO_DEBUG_ADDR (FETCH ())
|
||||
#else /* not SCM_VM_DEBUG_ENGINE */
|
||||
#define VM_GOTO_NEXT() goto *SCM_CODE_TO_ADDR (FETCH ())
|
||||
#endif
|
||||
#else /* not HAVE_LABELS_AS_VALUES */
|
||||
#define VM_GOTO_NEXT() goto vm_start
|
||||
#endif
|
||||
|
||||
#define NEXT \
|
||||
{ \
|
||||
VM_PROGRAM_COUNTER_CHECK (); \
|
||||
VM_NEXT_HOOK (); \
|
||||
VM_GOTO_NEXT (); \
|
||||
}
|
||||
|
||||
/* Just an abbreviation */
|
||||
#define RETURN(X) { ac = (X); NEXT; }
|
||||
Loading…
Add table
Add a link
Reference in a new issue