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:
colin.smith 2006-08-14 22:25:55 +00:00
parent 4beb1eb8fe
commit e0f1e47b53
4 changed files with 30 additions and 6 deletions

View File

@ -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)

View File

@ -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 '())

View File

@ -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;

View File

@ -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).