summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2008-10-16 13:24:39 +0200
committerAndy Wingo <wingo@pobox.com>2008-10-16 13:24:39 +0200
commit1f40459f5cd2389d0a44b6c46d431ed58f450f3a (patch)
tree0de6be1a41b25c4652c0372f8b25b6920a1cffac
parent28a2f57bde42030e96b4c2ab574336c6e8c394b5 (diff)
downloadguile-1f40459f5cd2389d0a44b6c46d431ed58f450f3a.tar.gz
ensure that lists pushed onto the stack are proper
I saw this problem when running elisp.test -- it tries to apply a function to an arglist ending in nil, which obviously is not null. * libguile/vm-engine.h (PUSH_LIST): New helper macro, pushes the elements of a list onto the stack. Checks to make sure that the list is proper. * libguile/vm-i-system.c (list-break, mv-call, apply, goto/apply) (goto/cc): Use LIST_BREAK. * libguile/vm-engine.c (vm_error_improper_list): New error case.
-rw-r--r--libguile/vm-engine.c4
-rw-r--r--libguile/vm-engine.h12
-rw-r--r--libguile/vm-i-system.c15
3 files changed, 21 insertions, 10 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index a79786015..3956a389d 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -176,6 +176,10 @@ vm_run (SCM vm, SCM program, SCM args)
err_args = SCM_EOL;
goto vm_error;
+ vm_error_improper_list:
+ err_msg = scm_from_locale_string ("VM: Attempt to unroll an improper list: tail is ~A");
+ goto vm_error;
+
vm_error_no_values:
err_msg = scm_from_locale_string ("VM: 0-valued return");
err_args = SCM_EOL;
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 22a7ef5e4..215f630b1 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -299,6 +299,18 @@ do \
PUSH (l); \
} while (0)
+/* The opposite: push all of the elements in L onto the list. */
+#define PUSH_LIST(l) \
+do \
+{ \
+ for (; scm_is_pair (l); l = SCM_CDR (l)) \
+ PUSH (SCM_CAR (l)); \
+ if (SCM_UNLIKELY (!SCM_NULLP (l))) { \
+ err_args = scm_list_1 (l); \
+ goto vm_error_improper_list; \
+ } \
+} while (0)
+
/* Below is a (slightly broken) experiment to avoid calling `scm_cell' and to
allocate cells on the stack. This is a significant improvement for
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 80eb9249a..fbb94c89a 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -214,8 +214,7 @@ VM_DEFINE_INSTRUCTION (list_break, "list-break", 0, 0, 0)
{
SCM l;
POP (l);
- for (; !SCM_NULLP (l); l = SCM_CDR (l))
- PUSH (SCM_CAR (l));
+ PUSH_LIST (l);
NEXT;
}
@@ -833,8 +832,7 @@ VM_DEFINE_INSTRUCTION (mv_call, "mv-call", 3, -1, 1)
POP (values);
values = scm_struct_ref (values, SCM_INUM0);
len = scm_length (values);
- for (; !SCM_NULLP (values); values = SCM_CDR (values))
- PUSH (SCM_CAR (values));
+ PUSH_LIST (values);
PUSH (len);
ip += offset;
}
@@ -866,8 +864,7 @@ VM_DEFINE_INSTRUCTION (apply, "apply", 1, -1, 1)
if (len < 0)
goto vm_error_wrong_type_arg;
- for (; !SCM_NULLP (ls); ls = SCM_CDR (ls))
- PUSH (SCM_CAR (ls));
+ PUSH_LIST (ls);
nargs += len - 2;
goto vm_call;
@@ -886,8 +883,7 @@ VM_DEFINE_INSTRUCTION (goto_apply, "goto/apply", 1, -1, 1)
if (len < 0)
goto vm_error_wrong_type_arg;
- for (; !SCM_NULLP (ls); ls = SCM_CDR (ls))
- PUSH (SCM_CAR (ls));
+ PUSH_LIST (ls);
nargs += len - 2;
goto vm_goto_args;
@@ -949,8 +945,7 @@ VM_DEFINE_INSTRUCTION (goto_cc, "goto/cc", 0, 1, 1)
SCM values;
values = scm_struct_ref (cont, SCM_INUM0);
nvalues = scm_ilength (values);
- for (; !SCM_NULLP (values); values = SCM_CDR (values))
- PUSH (SCM_CAR (values));
+ PUSH_LIST (values);
goto vm_return_values;
}
else