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

View File

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

View File

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

View File

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