summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorLudovic Courtes <ludovic.courtes@laas.fr>2005-06-25 03:13:56 +0000
committerLudovic Courtès <ludo@gnu.org>2008-04-25 19:09:30 +0200
commit0b5f0e49a8b172544e2a7cb564c01c2ec439aaec (patch)
tree42265eb157f9bd5869eccfc93e395f9fed89b2bf /src
parent6208295910a6fab78228b8255ed56ccd089bd5f0 (diff)
downloadguile-0b5f0e49a8b172544e2a7cb564c01c2ec439aaec.tar.gz
* src/objcodes.c (make_objcode_by_mmap): Fixed the error type when the
object file is too small. * doc/guile-vm.texi: Documented `make-closure'. Improved the documentation of `load-program'. * testsuite: New directory. * configure.in: Added `testsuite/Makefile' to `AC_OUTPUT'. * Makefile.am (SUBDIRS): Added `testsuite'. * src/vm_engine.h (VM_CHECK_OBJECT): New option. (CHECK_OBJECT): New macro. * src/vm_system.c (object-ref): Use VM_CHECK_OBJECT. * module/system/vm/assemble.scm (preprocess): Commented out the debugging code. * benchmark/lib.scm (do-loop): New procedure. git-archimport-id: lcourtes@laas.fr--2005-mobile/guile-vm--mobile--0.6--patch-2
Diffstat (limited to 'src')
-rw-r--r--src/objcodes.c6
-rw-r--r--src/vm_engine.c14
-rw-r--r--src/vm_engine.h30
-rw-r--r--src/vm_system.c4
4 files changed, 39 insertions, 15 deletions
diff --git a/src/objcodes.c b/src/objcodes.c
index 8903bd338..e1a3b17e8 100644
--- a/src/objcodes.c
+++ b/src/objcodes.c
@@ -82,9 +82,13 @@ make_objcode_by_mmap (int fd)
struct scm_objcode *p;
ret = fstat (fd, &st);
- if ((ret < 0) || (st.st_size <= strlen (OBJCODE_COOKIE)))
+ if (ret < 0)
SCM_SYSERROR;
+ if (st.st_size <= strlen (OBJCODE_COOKIE))
+ scm_misc_error (FUNC_NAME, "object file too small (~a bytes)",
+ SCM_LIST1 (SCM_I_MAKINUM (st.st_size)));
+
addr = mmap (0, st.st_size, PROT_READ, MAP_SHARED, fd, 0);
if (addr == MAP_FAILED)
SCM_SYSERROR;
diff --git a/src/vm_engine.c b/src/vm_engine.c
index 3a18067cb..8c93c1de0 100644
--- a/src/vm_engine.c
+++ b/src/vm_engine.c
@@ -58,6 +58,7 @@ vm_run (SCM vm, SCM program, SCM args)
struct scm_program *bp = NULL; /* program base pointer */
SCM external = SCM_EOL; /* external environment */
SCM *objects = NULL; /* constant objects */
+ size_t object_count; /* length of OBJECTS */
SCM *stack_base = vp->stack_base; /* stack base address */
SCM *stack_limit = vp->stack_limit; /* stack limit address */
@@ -138,8 +139,10 @@ vm_run (SCM vm, SCM program, SCM args)
goto vm_error;
vm_error_wrong_type_apply:
- err_msg = scm_from_locale_string ("VM: Wrong type to apply: ~S");
- err_args = SCM_LIST1 (program);
+ err_msg = scm_from_locale_string ("VM: Wrong type to apply: ~S "
+ "[IP offset: ~a]");
+ err_args = SCM_LIST2 (program,
+ SCM_I_MAKINUM (ip - bp->base));
goto vm_error;
vm_error_stack_overflow:
@@ -166,6 +169,13 @@ vm_run (SCM vm, SCM program, SCM args)
goto vm_error;
#endif
+#if VM_CHECK_OBJECT
+ vm_error_object:
+ err_msg = scm_from_locale_string ("VM: Invalid object table access");
+ err_args = SCM_EOL;
+ goto vm_error;
+#endif
+
vm_error:
SYNC_ALL ();
vp->last_frame = vm_heapify_frames (vm);
diff --git a/src/vm_engine.h b/src/vm_engine.h
index 3c7ef7b02..ac12caabe 100644
--- a/src/vm_engine.h
+++ b/src/vm_engine.h
@@ -48,6 +48,7 @@
#define VM_USE_HOOKS 1 /* Various hooks */
#define VM_USE_CLOCK 1 /* Bogoclock */
#define VM_CHECK_EXTERNAL 1 /* Check external link */
+#define VM_CHECK_OBJECT 1 /* Check object table */
/*
@@ -133,17 +134,16 @@
/* Get a local copy of the program's "object table" (i.e. the vector of
external bindings that are referenced by the program), initialized by
`load-program'. */
-#define CACHE_PROGRAM() \
-{ \
- size_t _vsize; \
- ssize_t _vincr; \
- scm_t_array_handle _vhandle; \
- \
- bp = SCM_PROGRAM_DATA (program); \
- /* Was: objects = SCM_VELTS (bp->objs); */ \
- objects = scm_vector_elements (bp->objs, &_vhandle, \
- &_vsize, &_vincr); \
- scm_array_handle_release (&_vhandle); \
+#define CACHE_PROGRAM() \
+{ \
+ ssize_t _vincr; \
+ scm_t_array_handle _vhandle; \
+ \
+ bp = SCM_PROGRAM_DATA (program); \
+ /* Was: objects = SCM_VELTS (bp->objs); */ \
+ objects = scm_vector_elements (bp->objs, &_vhandle, \
+ &object_count, &_vincr); \
+ scm_array_handle_release (&_vhandle); \
}
#define SYNC_BEFORE_GC() \
@@ -169,6 +169,14 @@
#define CHECK_EXTERNAL(e)
#endif
+/* Accesses to a program's object table. */
+#if VM_CHECK_OBJECT
+#define CHECK_OBJECT(_num) \
+ do { if ((_num) >= object_count) goto vm_error_object; } while (0)
+#else
+#define CHECK_OBJECT(_num)
+#endif
+
/*
* Hooks
diff --git a/src/vm_system.c b/src/vm_system.c
index dc71896dd..5eb125b88 100644
--- a/src/vm_system.c
+++ b/src/vm_system.c
@@ -208,7 +208,9 @@ VM_DEFINE_INSTRUCTION (list_break, "list-break", 0, 0, 0)
VM_DEFINE_INSTRUCTION (object_ref, "object-ref", 1, 0, 1)
{
- PUSH (OBJECT_REF (FETCH ()));
+ register objnum = FETCH ();
+ CHECK_OBJECT (objnum);
+ PUSH (OBJECT_REF (objnum));
NEXT;
}