mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-15 10:10:21 +02:00
Code Activity

Create external frames dynamically.

Browse source
This commit is contained in:
Keisuke Nishida 2000-08-22 19:02:22 +00:00
parent dbb74d8137
commit d608d68d7b
5 changed files with 74 additions and 70 deletions
Download patch file Download diff file Expand all files Collapse all files

41
src/vm.c
View file

@ -44,7 +44,7 @@
#include "vm.h" #include "vm.h"
/* default stack size in the number of SCM */ /* default stack size in the number of SCM */
#define VM_DEFAULT_STACK_SIZE (1 * 1024) /* = 128KB */ #define VM_DEFAULT_STACK_SIZE (16 * 1024) /* = 64KB */
#define VM_MAXIMUM_STACK_SIZE (1024 * 1024) /* = 4MB */ #define VM_MAXIMUM_STACK_SIZE (1024 * 1024) /* = 4MB */
/* I sometimes use this for debugging. */ /* I sometimes use this for debugging. */
@ -526,21 +526,9 @@ SCM_DEFINE (scm_bytecode_decode, "bytecode-decode", 1, 0, 0,
static long scm_program_tag; static long scm_program_tag;
static SCM static SCM
make_program (SCM bytecode, SCM parent) make_program (SCM code, SCM env)
{ {
SCM env = SCM_PROGRAM_P (parent) ? SCM_PROGRAM_ENV (parent) : SCM_BOOL_F; SCM_RETURN_NEWSMOB2 (scm_program_tag, SCM_UNPACK (code), SCM_UNPACK (env));
int nexts = SCM_BYTECODE_NEXTS (bytecode);
if (nexts)
{
SCM tmp = SCM_VM_MAKE_EXTERNAL (nexts);
SCM_VM_EXTERNAL_LINK (tmp) = env;
env = tmp;
}
SCM_RETURN_NEWSMOB2 (scm_program_tag,
SCM_UNPACK (bytecode),
SCM_UNPACK (env));
} }
static SCM static SCM
@ -629,16 +617,6 @@ SCM_DEFINE (scm_program_base, "program-base", 1, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_program_external, "program-external", 1, 0, 0,
(SCM program),
"")
#define FUNC_NAME s_scm_program_external
{
SCM_VALIDATE_PROGRAM (1, program);
return SCM_PROGRAM_ENV (program);
}
#undef FUNC_NAME
/* /*
* VM Frame * VM Frame
@ -652,6 +630,7 @@ struct scm_vm_frame {
SCM program; SCM program;
SCM variables; SCM variables;
SCM dynamic_link; SCM dynamic_link;
SCM external_link;
SCM stack_pointer; SCM stack_pointer;
SCM return_address; SCM return_address;
}; };
@ -668,6 +647,7 @@ make_vm_frame (SCM *fp)
struct scm_vm_frame *p = scm_must_malloc (sizeof (*p), "make_vm_frame"); struct scm_vm_frame *p = scm_must_malloc (sizeof (*p), "make_vm_frame");
p->program = SCM_VM_FRAME_PROGRAM (fp); p->program = SCM_VM_FRAME_PROGRAM (fp);
p->dynamic_link = SCM_VM_FRAME_DYNAMIC_LINK (fp); p->dynamic_link = SCM_VM_FRAME_DYNAMIC_LINK (fp);
p->external_link = SCM_VM_FRAME_EXTERNAL_LINK (fp);
p->stack_pointer = SCM_VM_FRAME_STACK_POINTER (fp); p->stack_pointer = SCM_VM_FRAME_STACK_POINTER (fp);
p->return_address = SCM_VM_FRAME_RETURN_ADDRESS (fp); p->return_address = SCM_VM_FRAME_RETURN_ADDRESS (fp);
@ -688,6 +668,7 @@ mark_vm_frame (SCM frame)
struct scm_vm_frame *p = SCM_VM_FRAME_DATA (frame); struct scm_vm_frame *p = SCM_VM_FRAME_DATA (frame);
scm_gc_mark (p->program); scm_gc_mark (p->program);
scm_gc_mark (p->dynamic_link); scm_gc_mark (p->dynamic_link);
scm_gc_mark (p->external_link);
return p->variables; return p->variables;
} }
@ -739,6 +720,16 @@ SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_frame_external_link, "frame-external-link", 1, 0, 0,
(SCM frame),
"")
#define FUNC_NAME s_scm_frame_external_link
{
SCM_VALIDATE_VM_FRAME (1, frame);
return SCM_VM_FRAME_DATA (frame)->external_link;
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_stack_pointer, "frame-stack-pointer", 1, 0, 0, SCM_DEFINE (scm_frame_stack_pointer, "frame-stack-pointer", 1, 0, 0,
(SCM frame), (SCM frame),
"") "")

7
src/vm.h
View file

@ -188,13 +188,14 @@ extern SCM scm_program_base (SCM program);
/* VM frame is allocated in the stack */ /* VM frame is allocated in the stack */
/* NOTE: Modify make_vm_frame and VM_NEW_FRAME too! */ /* NOTE: Modify make_vm_frame and VM_NEW_FRAME too! */
#define SCM_VM_FRAME_DATA_SIZE 5 #define SCM_VM_FRAME_DATA_SIZE 6
#define SCM_VM_FRAME_VARIABLE(FP,N) (FP[N]) #define SCM_VM_FRAME_VARIABLE(FP,N) (FP[N])
#define SCM_VM_FRAME_SIZE(FP) (FP[-1]) #define SCM_VM_FRAME_SIZE(FP) (FP[-1])
#define SCM_VM_FRAME_PROGRAM(FP) (FP[-2]) #define SCM_VM_FRAME_PROGRAM(FP) (FP[-2])
#define SCM_VM_FRAME_DYNAMIC_LINK(FP) (FP[-3]) #define SCM_VM_FRAME_DYNAMIC_LINK(FP) (FP[-3])
#define SCM_VM_FRAME_STACK_POINTER(FP) (FP[-4]) #define SCM_VM_FRAME_EXTERNAL_LINK(FP) (FP[-4])
#define SCM_VM_FRAME_RETURN_ADDRESS(FP) (FP[-5]) #define SCM_VM_FRAME_STACK_POINTER(FP) (FP[-5])
#define SCM_VM_FRAME_RETURN_ADDRESS(FP) (FP[-6])
/* /*

20
src/vm_engine.c
View file

@ -61,24 +61,24 @@ VM_NAME (SCM vm, SCM program)
#define FUNC_NAME "vm-engine" #define FUNC_NAME "vm-engine"
{ {
/* Copies of VM registers */ /* Copies of VM registers */
SCM ac = SCM_PACK (0); SCM ac = SCM_PACK (0); /* accumulator */
SCM *pc = NULL; SCM *pc = NULL; /* program counter */
SCM *sp = NULL; SCM *sp = NULL; /* stack pointer */
SCM *fp = NULL; SCM *fp = NULL; /* frame pointer */
/* Stack boundaries */ /* Cache variables */
SCM *stack_base = NULL; struct scm_vm *vmp = NULL; /* the VM data pointer */
SCM *stack_limit = NULL; SCM ext = SCM_BOOL_F; /* the current external frame */
SCM *stack_base = NULL; /* stack base address */
SCM *stack_limit = NULL; /* stack limit address */
/* Function arguments */ /* Function arguments */
int an = 0; int an = 0;
SCM a2 = SCM_PACK (0); SCM a2 = SCM_PACK (0);
SCM a3 = SCM_PACK (0); SCM a3 = SCM_PACK (0);
/* Miscellaneous variables */ /* Internal variables */
SCM dynwinds = SCM_EOL; SCM dynwinds = SCM_EOL;
struct scm_vm *vmp = NULL;
#if VM_USE_HOOK #if VM_USE_HOOK
SCM hook_args = SCM_LIST1 (vm); SCM hook_args = SCM_LIST1 (vm);
#endif #endif

55
src/vm_engine.h
View file

@ -237,7 +237,7 @@
*/ */
/* an = the number of arguments */ /* an = the number of arguments */
#define VM_SETUP_ARGS(PROG,NREQS,RESTP) \ #define VM_FRAME_INIT_ARGS(PROG,NREQS,RESTP) \
{ \ { \
if (RESTP) \ if (RESTP) \
/* have a rest argument */ \ /* have a rest argument */ \
@ -260,49 +260,66 @@
} \ } \
} }
#define VM_EXPORT_ARGS(FP,PROG) \ #undef VM_FRAME_INIT_LOCAL_VARIABLES
{ \
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 #if VM_INIT_LOCAL_VARIABLES
/* This is necessary when creating frame objects for debugging */ /* This is necessary when creating frame objects for debugging */
#define VM_FRAME_INIT_VARIABLES(FP,NVARS) \ #define VM_FRAME_INIT_LOCAL_VARIABLES(FP,NVARS) \
{ \ { \
int i; \ int i; \
for (i = 0; i < NVARS; i++) \ for (i = 0; i < NVARS; i++) \
SCM_VM_FRAME_VARIABLE (FP, i) = SCM_UNDEFINED; \ SCM_VM_FRAME_VARIABLE (FP, i) = SCM_UNDEFINED; \
} }
#else #else
#define VM_FRAME_INIT_VARIABLES(FP,NVARS) #define VM_FRAME_INIT_LOCAL_VARIABLES(FP,NVARS)
#endif #endif
#define VM_FRAME_INIT_EXTERNAL_VARIABLES(FP,PROG) \
{ \
int *exts = SCM_PROGRAM_EXTS (PROG); \
if (exts) \
{ \
/* Export variables */ \
int n = exts[0]; \
while (n-- > 0) \
SCM_VM_EXTERNAL_VARIABLE (ext, n) \
= SCM_VM_FRAME_VARIABLE (FP, exts[n + 1]); \
} \
}
#define VM_NEW_FRAME(FP,PROG,DL,SP,RA) \ #define VM_NEW_FRAME(FP,PROG,DL,SP,RA) \
{ \ { \
int nvars = SCM_PROGRAM_NVARS (PROG); /* the number of local vars */ \ int nvars = SCM_PROGRAM_NVARS (PROG); /* the number of local vars */ \
int nreqs = SCM_PROGRAM_NREQS (PROG); /* the number of required args */ \ int nreqs = SCM_PROGRAM_NREQS (PROG); /* the number of required args */ \
int restp = SCM_PROGRAM_RESTP (PROG); /* have a rest argument or not */ \ int restp = SCM_PROGRAM_RESTP (PROG); /* have a rest argument or not */ \
int nexts = SCM_PROGRAM_NEXTS (PROG); /* the number of external vars */ \
\ \
VM_SETUP_ARGS (PROG, nreqs, restp); \ VM_FRAME_INIT_ARGS (PROG, nreqs, restp); \
\
/* Allocate the new frame */ \
if (sp - nvars - SCM_VM_FRAME_DATA_SIZE < stack_base - 1) \ if (sp - nvars - SCM_VM_FRAME_DATA_SIZE < stack_base - 1) \
SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL); \ SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL); \
sp -= nvars + SCM_VM_FRAME_DATA_SIZE; \ sp -= nvars + SCM_VM_FRAME_DATA_SIZE; \
FP = sp + SCM_VM_FRAME_DATA_SIZE + 1; \ FP = sp + SCM_VM_FRAME_DATA_SIZE + 1; \
\
/* Setup the new external frame */ \
if (!SCM_FALSEP (SCM_PROGRAM_ENV (PROG))) \
ext = SCM_PROGRAM_ENV (PROG); /* Use program's environment */ \
if (nexts) \
{ \
SCM new = SCM_VM_MAKE_EXTERNAL (nexts); /* new external */ \
SCM_VM_EXTERNAL_LINK (new) = ext; \
ext = new; \
} \
\
/* Setup the new frame */ \
SCM_VM_FRAME_SIZE (FP) = SCM_MAKINUM (nvars); \ SCM_VM_FRAME_SIZE (FP) = SCM_MAKINUM (nvars); \
SCM_VM_FRAME_PROGRAM (FP) = PROG; \ SCM_VM_FRAME_PROGRAM (FP) = PROG; \
SCM_VM_FRAME_DYNAMIC_LINK (FP) = DL; \ SCM_VM_FRAME_DYNAMIC_LINK (FP) = DL; \
SCM_VM_FRAME_EXTERNAL_LINK (FP) = ext; \
SCM_VM_FRAME_STACK_POINTER (FP) = SP; \ SCM_VM_FRAME_STACK_POINTER (FP) = SP; \
SCM_VM_FRAME_RETURN_ADDRESS (FP) = RA; \ SCM_VM_FRAME_RETURN_ADDRESS (FP) = RA; \
VM_FRAME_INIT_VARIABLES (FP, nvars); \ VM_FRAME_INIT_LOCAL_VARIABLES (FP, nvars); \
VM_EXPORT_ARGS (FP, PROG); \ VM_FRAME_INIT_EXTERNAL_VARIABLES (FP, PROG); \
} }

21
src/vm_system.c
View file

@ -47,14 +47,12 @@
* Variable access * Variable access
*/ */
#undef LOCAL_VAR
#define LOCAL_VAR(OFFSET) SCM_VM_FRAME_VARIABLE (fp, OFFSET) #define LOCAL_VAR(OFFSET) SCM_VM_FRAME_VARIABLE (fp, OFFSET)
#undef EXTERNAL_FOCUS
#define EXTERNAL_FOCUS(DEPTH) \ #define EXTERNAL_FOCUS(DEPTH) \
{ \ { \
int depth = DEPTH; \ int depth = DEPTH; \
env = SCM_PROGRAM_ENV (SCM_VM_FRAME_PROGRAM (fp)); \ env = ext; \
while (depth-- > 0) \ while (depth-- > 0) \
{ \ { \
VM_ASSERT_LINK (env); \ VM_ASSERT_LINK (env); \
@ -62,16 +60,12 @@
} \ } \
} }
#undef EXTERNAL_VAR
#define EXTERNAL_VAR(OFFSET) SCM_VM_EXTERNAL_VARIABLE (env, OFFSET) #define EXTERNAL_VAR(OFFSET) SCM_VM_EXTERNAL_VARIABLE (env, OFFSET)
#undef EXTERNAL_VAR0 #define EXTERNAL_VAR0(OFFSET) SCM_VM_EXTERNAL_VARIABLE (ext, OFFSET)
#define EXTERNAL_VAR0(OFFSET) SCM_VM_EXTERNAL_VARIABLE (SCM_PROGRAM_ENV (SCM_VM_FRAME_PROGRAM (fp)), OFFSET) #define EXTERNAL_VAR1(OFFSET) SCM_VM_EXTERNAL_VARIABLE (SCM_VM_EXTERNAL_LINK (ext), OFFSET)
#define EXTERNAL_VAR1(OFFSET) SCM_VM_EXTERNAL_VARIABLE (SCM_VM_EXTERNAL_LINK (SCM_PROGRAM_ENV (SCM_VM_FRAME_PROGRAM (fp))), OFFSET) #define EXTERNAL_VAR2(OFFSET) SCM_VM_EXTERNAL_VARIABLE (SCM_VM_EXTERNAL_LINK (SCM_VM_EXTERNAL_LINK (ext)), OFFSET)
#define EXTERNAL_VAR2(OFFSET) SCM_VM_EXTERNAL_VARIABLE (SCM_VM_EXTERNAL_LINK (SCM_VM_EXTERNAL_LINK (SCM_PROGRAM_ENV (SCM_VM_FRAME_PROGRAM (fp)))), OFFSET)
#undef TOPLEVEL_VAR
#define TOPLEVEL_VAR(CELL) SCM_CDR (CELL) #define TOPLEVEL_VAR(CELL) SCM_CDR (CELL)
#undef TOPLEVEL_VAR_SET
#define TOPLEVEL_VAR_SET(CELL,OBJ) SCM_SETCDR (CELL, OBJ) #define TOPLEVEL_VAR_SET(CELL,OBJ) SCM_SETCDR (CELL, OBJ)
@ -399,7 +393,7 @@ SCM_DEFINE_INSTRUCTION (jump, "%jump", INST_ADDR)
SCM_DEFINE_INSTRUCTION (make_program, "%make-program", INST_CODE) SCM_DEFINE_INSTRUCTION (make_program, "%make-program", INST_CODE)
{ {
SYNC (); /* must be called before GC */ SYNC (); /* must be called before GC */
RETURN (SCM_MAKE_PROGRAM (FETCH (), SCM_VM_FRAME_PROGRAM (fp))); RETURN (SCM_MAKE_PROGRAM (FETCH (), SCM_VM_FRAME_EXTERNAL_LINK (fp)));
} }
/* Before: /* Before:
@ -487,7 +481,7 @@ SCM_DEFINE_INSTRUCTION (tail_call, "%tail-call", INST_INUM)
int nvars = SCM_PROGRAM_NVARS (ac); /* the number of local vars */ int nvars = SCM_PROGRAM_NVARS (ac); /* the number of local vars */
int nreqs = SCM_PROGRAM_NREQS (ac); /* the number of require args */ int nreqs = SCM_PROGRAM_NREQS (ac); /* the number of require args */
int restp = SCM_PROGRAM_RESTP (ac); /* have a rest argument */ int restp = SCM_PROGRAM_RESTP (ac); /* have a rest argument */
VM_SETUP_ARGS (ac, nreqs, restp); VM_FRAME_INIT_ARGS (ac, nreqs, restp);
/* Move arguments */ /* Move arguments */
nreqs += restp; nreqs += restp;
@ -497,7 +491,7 @@ SCM_DEFINE_INSTRUCTION (tail_call, "%tail-call", INST_INUM)
POP (obj); POP (obj);
SCM_VM_FRAME_VARIABLE (fp, nvars++) = obj; SCM_VM_FRAME_VARIABLE (fp, nvars++) = obj;
} }
VM_EXPORT_ARGS (fp, ac); VM_FRAME_INIT_EXTERNAL_VARIABLES (fp, ac);
} }
else else
/* Dynamic return call */ /* Dynamic return call */
@ -545,5 +539,6 @@ SCM_DEFINE_INSTRUCTION (return, "%return", INST_NONE)
fp = SCM_VM_ADDRESS (SCM_VM_FRAME_DYNAMIC_LINK (last_fp)); fp = SCM_VM_ADDRESS (SCM_VM_FRAME_DYNAMIC_LINK (last_fp));
sp = SCM_VM_ADDRESS (SCM_VM_FRAME_STACK_POINTER (last_fp)); sp = SCM_VM_ADDRESS (SCM_VM_FRAME_STACK_POINTER (last_fp));
pc = SCM_VM_ADDRESS (SCM_VM_FRAME_RETURN_ADDRESS (last_fp)); pc = SCM_VM_ADDRESS (SCM_VM_FRAME_RETURN_ADDRESS (last_fp));
ext = SCM_VM_FRAME_EXTERNAL_LINK (fp);
NEXT; NEXT;
} }