mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-15 18:20:42 +02:00
* src/vm_system.c (push_list): New instruction.
* src/vm_engine.c (VM_NAME): Don\'t validate VM and PROGRAM. * src/vm.c (scm_vm_apply): New procedure. (apply_program): New function. (init_program_type): Set the apply function for the program type. * src/vm.c (lookup_variable): Use scm_eval_closure_lookup.
This commit is contained in:
parent
4405d598ef
commit
2640369017
3 changed files with 67 additions and 7 deletions
63
src/vm.c
63
src/vm.c
|
@ -339,10 +339,10 @@ init_bytecode_type ()
|
||||||
static SCM
|
static SCM
|
||||||
lookup_variable (SCM sym)
|
lookup_variable (SCM sym)
|
||||||
{
|
{
|
||||||
SCM closure = scm_standard_eval_closure (scm_selected_module ());
|
SCM eclo = scm_standard_eval_closure (scm_selected_module ());
|
||||||
SCM var = scm_apply (closure, SCM_LIST2 (sym, SCM_BOOL_F), SCM_EOL);
|
SCM var = scm_eval_closure_lookup (eclo, sym, SCM_BOOL_F);
|
||||||
if (SCM_FALSEP (var))
|
if (SCM_FALSEP (var))
|
||||||
var = scm_apply (closure, SCM_LIST2 (sym, SCM_BOOL_T), SCM_EOL);
|
var = scm_eval_closure_lookup (eclo, sym, SCM_BOOL_T);
|
||||||
return var;
|
return var;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -570,12 +570,22 @@ print_program (SCM obj, SCM port, scm_print_state *pstate)
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static SCM scm_vm_apply (SCM vm, SCM program, SCM args);
|
||||||
|
static SCM make_vm (int stack_size);
|
||||||
|
|
||||||
|
static SCM
|
||||||
|
apply_program (SCM program, SCM args)
|
||||||
|
{
|
||||||
|
return scm_vm_apply (make_vm (VM_DEFAULT_STACK_SIZE), program, args);
|
||||||
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
init_program_type ()
|
init_program_type ()
|
||||||
{
|
{
|
||||||
scm_program_tag = scm_make_smob_type ("program", 0);
|
scm_program_tag = scm_make_smob_type ("program", 0);
|
||||||
scm_set_smob_mark (scm_program_tag, mark_program);
|
scm_set_smob_mark (scm_program_tag, mark_program);
|
||||||
scm_set_smob_print (scm_program_tag, print_program);
|
scm_set_smob_print (scm_program_tag, print_program);
|
||||||
|
scm_set_smob_apply (scm_program_tag, apply_program, 0, 0, 1);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Scheme interface */
|
/* Scheme interface */
|
||||||
|
@ -1115,7 +1125,7 @@ SCM_DEFINE (scm_vm_run, "vm-run", 2, 0, 0,
|
||||||
if (SCM_EQ_P (template[0], SCM_PACK (0)))
|
if (SCM_EQ_P (template[0], SCM_PACK (0)))
|
||||||
{
|
{
|
||||||
template[0] = VM_CODE ("%loadc");
|
template[0] = VM_CODE ("%loadc");
|
||||||
template[1] = SCM_BOOL_F;
|
template[1] = SCM_BOOL_F; /* overwritten */
|
||||||
template[2] = VM_CODE ("%call");
|
template[2] = VM_CODE ("%call");
|
||||||
template[3] = SCM_MAKINUM (0);
|
template[3] = SCM_MAKINUM (0);
|
||||||
template[4] = VM_CODE ("%halt");
|
template[4] = VM_CODE ("%halt");
|
||||||
|
@ -1140,6 +1150,51 @@ SCM_DEFINE (scm_vm_run, "vm-run", 2, 0, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
SCM_DEFINE (scm_vm_apply, "vm-apply", 3, 0, 0,
|
||||||
|
(SCM vm, SCM program, SCM args),
|
||||||
|
"")
|
||||||
|
#define FUNC_NAME s_scm_vm_apply
|
||||||
|
{
|
||||||
|
int len;
|
||||||
|
SCM bootcode;
|
||||||
|
static SCM template[7];
|
||||||
|
|
||||||
|
SCM_VALIDATE_VM (1, vm);
|
||||||
|
SCM_VALIDATE_PROGRAM (2, program);
|
||||||
|
SCM_VALIDATE_LIST_COPYLEN (3, args, len);
|
||||||
|
|
||||||
|
if (SCM_EQ_P (template[0], SCM_PACK (0)))
|
||||||
|
{
|
||||||
|
template[0] = VM_CODE ("%push-list");
|
||||||
|
template[1] = SCM_EOL; /* overwritten */
|
||||||
|
template[2] = VM_CODE ("%loadc");
|
||||||
|
template[3] = SCM_BOOL_F; /* overwritten */
|
||||||
|
template[4] = VM_CODE ("%call");
|
||||||
|
template[5] = SCM_MAKINUM (0); /* overwritten */
|
||||||
|
template[6] = VM_CODE ("%halt");
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Create a boot program */
|
||||||
|
bootcode = make_bytecode (7);
|
||||||
|
memcpy (SCM_BYTECODE_BASE (bootcode), template, sizeof (SCM) * 7);
|
||||||
|
SCM_BYTECODE_BASE (bootcode)[1] = args;
|
||||||
|
SCM_BYTECODE_BASE (bootcode)[3] = program;
|
||||||
|
SCM_BYTECODE_BASE (bootcode)[5] = SCM_MAKINUM (len);
|
||||||
|
SCM_BYTECODE_SIZE (bootcode) = 7;
|
||||||
|
SCM_BYTECODE_EXTS (bootcode) = NULL;
|
||||||
|
SCM_BYTECODE_NREQS (bootcode) = 0;
|
||||||
|
SCM_BYTECODE_RESTP (bootcode) = 0;
|
||||||
|
SCM_BYTECODE_NVARS (bootcode) = 0;
|
||||||
|
SCM_BYTECODE_NEXTS (bootcode) = 0;
|
||||||
|
program = SCM_MAKE_PROGRAM (bootcode, SCM_BOOL_F);
|
||||||
|
|
||||||
|
if (SCM_FALSEP (scm_vm_option (vm, sym_debug)))
|
||||||
|
return scm_regular_vm (vm, program);
|
||||||
|
else
|
||||||
|
return scm_debug_vm (vm, program);
|
||||||
|
}
|
||||||
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* The VM engines
|
* The VM engines
|
||||||
|
|
|
@ -94,9 +94,6 @@ VM_NAME (SCM vm, SCM program)
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM_VALIDATE_VM (1, vm);
|
|
||||||
SCM_VALIDATE_PROGRAM (2, program);
|
|
||||||
|
|
||||||
/* Initialize the VM */
|
/* Initialize the VM */
|
||||||
vmp = SCM_VM_DATA (vm);
|
vmp = SCM_VM_DATA (vm);
|
||||||
vmp->pc = SCM_PROGRAM_BASE (program);
|
vmp->pc = SCM_PROGRAM_BASE (program);
|
||||||
|
|
|
@ -94,6 +94,14 @@ SCM_DEFINE_INSTRUCTION (push, "%push", INST_NONE)
|
||||||
NEXT;
|
NEXT;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
SCM_DEFINE_INSTRUCTION (push_list, "%push-list", INST_SCM)
|
||||||
|
{
|
||||||
|
SCM list;
|
||||||
|
for (list = FETCH (); SCM_NIMP (list); list = SCM_CDR (list))
|
||||||
|
PUSH (SCM_CAR (list));
|
||||||
|
NEXT;
|
||||||
|
}
|
||||||
|
|
||||||
SCM_DEFINE_INSTRUCTION (pushc, "%pushc", INST_SCM)
|
SCM_DEFINE_INSTRUCTION (pushc, "%pushc", INST_SCM)
|
||||||
{
|
{
|
||||||
PUSH (FETCH ());
|
PUSH (FETCH ());
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue