diff options
author | Ludovic Courtes <ludovic.courtes@laas.fr> | 2005-06-25 03:13:56 +0000 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2008-04-25 19:09:30 +0200 |
commit | 0b5f0e49a8b172544e2a7cb564c01c2ec439aaec (patch) | |
tree | 42265eb157f9bd5869eccfc93e395f9fed89b2bf /src | |
parent | 6208295910a6fab78228b8255ed56ccd089bd5f0 (diff) | |
download | guile-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.c | 6 | ||||
-rw-r--r-- | src/vm_engine.c | 14 | ||||
-rw-r--r-- | src/vm_engine.h | 30 | ||||
-rw-r--r-- | src/vm_system.c | 4 |
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; } |