Fixed bug where we'd have trouble if a subr's definition was
overwritten by a compiled procedure. Don't use nconc in compiler, it's not safe. git-svn-id: svn://localhost/root/svnrepo/trunk@9 bee25f81-8ba7-4b93-944d-dfac3d1a11cc
This commit is contained in:
parent
4beb1eb8fe
commit
e0f1e47b53
|
@ -92,14 +92,14 @@ TESTARENA = SLABSIZE=1000000
|
||||||
|
|
||||||
test-interp: vxs-interp
|
test-interp: vxs-interp
|
||||||
@echo '========== TESTING INTERPRETER =========='
|
@echo '========== TESTING INTERPRETER =========='
|
||||||
@if [ -d /usr/share/guile/slib ]; then \
|
@if [ -d /usr/share/slib ]; then \
|
||||||
(cd ../lib; ../src/vxs-interp < vx-slib-test.scm); \
|
(cd ../lib; ../src/vxs-interp < vx-slib-test.scm); \
|
||||||
fi
|
fi
|
||||||
@(cd ../testcases; $(TESTARENA) ../src/vxs-interp < vx-test.scm)
|
@(cd ../testcases; $(TESTARENA) ../src/vxs-interp < vx-test.scm)
|
||||||
|
|
||||||
test-compile: vx-scheme
|
test-compile: vx-scheme
|
||||||
@echo '========== TESTING COMPILER =========='
|
@echo '========== TESTING COMPILER =========='
|
||||||
@if [ -d /usr/share/guile/slib ]; then \
|
@if [ -d /usr/share/slib ]; then \
|
||||||
(cd ../lib; ../src/vx-scheme < vx-slib-test.scm); \
|
(cd ../lib; ../src/vx-scheme < vx-slib-test.scm); \
|
||||||
fi
|
fi
|
||||||
@(cd ../testcases; $(TESTARENA) ../src/vx-scheme < vx-test.scm)
|
@(cd ../testcases; $(TESTARENA) ../src/vx-scheme < vx-test.scm)
|
||||||
|
|
|
@ -87,7 +87,7 @@
|
||||||
(rest lst))
|
(rest lst))
|
||||||
(if (null? rest)
|
(if (null? rest)
|
||||||
result
|
result
|
||||||
(loop (nconc result (list (func (car rest)))) (cdr rest)))))
|
(loop (append result (list (func (car rest)))) (cdr rest)))))
|
||||||
|
|
||||||
(define (_map2 func lst1 lst2)
|
(define (_map2 func lst1 lst2)
|
||||||
(let loop ((result '())
|
(let loop ((result '())
|
||||||
|
|
|
@ -933,7 +933,7 @@ Cell* nconc(Context* ctx, Cell* arglist) {
|
||||||
|
|
||||||
if (arglist == nil) return nil;
|
if (arglist == nil) return nil;
|
||||||
|
|
||||||
while(cdr(arglist) != nil) {
|
while (cdr(arglist) != nil) {
|
||||||
Cell* list_head = car(arglist);
|
Cell* list_head = car(arglist);
|
||||||
if (list_head != nil) {
|
if (list_head != nil) {
|
||||||
Cell* list_tail = list_head;
|
Cell* list_tail = list_head;
|
||||||
|
|
28
src/vm.cpp
28
src/vm.cpp
|
@ -292,8 +292,32 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
||||||
if (!insn->flag(Cell::QUICK)) {
|
if (!insn->flag(Cell::QUICK)) {
|
||||||
Cell* subr = find_var(root_envt, insn->cd.y, 0);
|
Cell* subr = find_var(root_envt, insn->cd.y, 0);
|
||||||
if (!subr) error("missing primitive procedure");
|
if (!subr) error("missing primitive procedure");
|
||||||
insn->cd.f = cdr(subr)->SubrValue();
|
Cell* proc = cdr(subr);
|
||||||
insn->flag(Cell::QUICK, true);
|
type = proc->type();
|
||||||
|
if (type == Cell::Cproc) {
|
||||||
|
// Yuck. When the current procedure was compiled, the
|
||||||
|
// routine we are about to invoke was a builtin (subr): now
|
||||||
|
// it's a compiled procedure. The optimized calling
|
||||||
|
// convention for subrs no longer applies. We must pop
|
||||||
|
// the args off the stack, then push a continuation, then
|
||||||
|
// re-push the args, and dispatch to the procedure.
|
||||||
|
n_args = INSN_COUNT(insn);
|
||||||
|
cellvector cv;
|
||||||
|
for (int ix = 0; ix < n_args; ++ix)
|
||||||
|
cv.push(m_stack.pop());
|
||||||
|
save(r_envt);
|
||||||
|
save(r_cproc);
|
||||||
|
save(pc+1);
|
||||||
|
for (int ix = 0; ix < n_args; ++ix)
|
||||||
|
m_stack.push(cv.pop());
|
||||||
|
r_cproc = proc;
|
||||||
|
goto PROC;
|
||||||
|
} else if (type == Cell::Subr) {
|
||||||
|
insn->cd.f = cdr(subr)->SubrValue();
|
||||||
|
insn->flag(Cell::QUICK, true);
|
||||||
|
} else {
|
||||||
|
error("subr invoked on non-procedure");
|
||||||
|
}
|
||||||
}
|
}
|
||||||
r_val = pop_list (INSN_COUNT (insn));
|
r_val = pop_list (INSN_COUNT (insn));
|
||||||
// Subr's can change anything (in particular they can reenter execute).
|
// Subr's can change anything (in particular they can reenter execute).
|
||||||
|
|
Loading…
Reference in New Issue