From e0f1e47b53dcfb22e5d0fe716699f182e71243d1 Mon Sep 17 00:00:00 2001
From: "colin.smith" <colin.smith@bee25f81-8ba7-4b93-944d-dfac3d1a11cc>
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).