From e0f1e47b53dcfb22e5d0fe716699f182e71243d1 Mon Sep 17 00:00:00 2001 From: "colin.smith" Date: Mon, 14 Aug 2006 22:25:55 +0000 Subject: [PATCH] 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 --- src/Makefile | 4 ++-- src/compiler.scm | 2 +- src/subr.cpp | 2 +- src/vm.cpp | 28 ++++++++++++++++++++++++++-- 4 files changed, 30 insertions(+), 6 deletions(-) diff --git a/src/Makefile b/src/Makefile index ff3ef74..6bcd611 100755 --- a/src/Makefile +++ b/src/Makefile @@ -92,14 +92,14 @@ TESTARENA = SLABSIZE=1000000 test-interp: vxs-interp @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); \ fi @(cd ../testcases; $(TESTARENA) ../src/vxs-interp < vx-test.scm) test-compile: vx-scheme @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); \ fi @(cd ../testcases; $(TESTARENA) ../src/vx-scheme < vx-test.scm) diff --git a/src/compiler.scm b/src/compiler.scm index ee7494e..036987f 100644 --- a/src/compiler.scm +++ b/src/compiler.scm @@ -87,7 +87,7 @@ (rest lst)) (if (null? rest) result - (loop (nconc result (list (func (car rest)))) (cdr rest))))) + (loop (append result (list (func (car rest)))) (cdr rest))))) (define (_map2 func lst1 lst2) (let loop ((result '()) diff --git a/src/subr.cpp b/src/subr.cpp index f1d0081..61ce0a9 100644 --- a/src/subr.cpp +++ b/src/subr.cpp @@ -933,7 +933,7 @@ Cell* nconc(Context* ctx, Cell* arglist) { if (arglist == nil) return nil; - while(cdr(arglist) != nil) { + while (cdr(arglist) != nil) { Cell* list_head = car(arglist); if (list_head != nil) { Cell* list_tail = list_head; diff --git a/src/vm.cpp b/src/vm.cpp index 67a2e09..87e85dc 100644 --- a/src/vm.cpp +++ b/src/vm.cpp @@ -292,8 +292,32 @@ Cell* Context::execute (Cell* proc, Cell* args) { if (!insn->flag(Cell::QUICK)) { Cell* subr = find_var(root_envt, insn->cd.y, 0); if (!subr) error("missing primitive procedure"); - insn->cd.f = cdr(subr)->SubrValue(); - insn->flag(Cell::QUICK, true); + Cell* proc = cdr(subr); + 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)); // Subr's can change anything (in particular they can reenter execute).