* 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

Makefile.am

@@ -1,4 +1,4 @@
-SUBDIRS = src doc module
+SUBDIRS = src doc module testsuite
 
 EXTRA_DIST = acconfig.h
 

benchmark/lib.scm

@@ -99,6 +99,13 @@
 	0
 	(loopi (1- n)))))
 
+(define (do-loop n)
+  ;; Same as `loop' using `do'.
+  (do ((i n (1- i)))
+      ((= 0 i))
+    ;; do nothing
+    ))
+
 
 (define (do-cons x)
   ;; This one shows that the built-in `cons' instruction yields a significant

configure.in

@@ -23,4 +23,5 @@ AC_SUBST(GUILEC)
 AC_OUTPUT(Makefile src/Makefile doc/Makefile module/Makefile
   module/system/Makefile module/system/base/Makefile
   module/system/vm/Makefile module/system/il/Makefile
-  module/system/repl/Makefile)
+  module/system/repl/Makefile
+  testsuite/Makefile)

doc/guile-vm.texi

@@ -458,19 +458,6 @@ External function:
 
 @section Subprogram call
 
-@example
- (define (plus a b) (+ a b))
- (plus 1 2) ->
-
-   %pushi 1                       ; argument 1
-   %pushi 2                       ; argument 2
-   %loadt (plus . #<program xxx>) ; load the program
-   %call  2                       ; call it with two arguments
-   %pushl (0 . 0)                 ; argument 1
-   %loadl (0 . 1)                 ; argument 2
-   add2                           ; ac = 1 + 2
-   %return                        ; result is 3
-@end example
 
 @node Instruction Set,  , Program Execution, Top
 @chapter Instruction Set
@@ -545,7 +532,13 @@ value of the closure variable located at @var{offset} within the
 program's list of external variables.
 @end deffn
 
-Let's look at a more complete example:
+@deffn @insn{} make-closure
+Pop the program object from the stack and assign it the current
+closure variable list as its closure.  Push the result program
+object.
+@end deffn
+
+Let's illustrate this:
 
 @example
 (let ((x 2))
@@ -560,16 +553,19 @@ The resulting program has one external (closure) variable, i.e. its
 This yields the following code:
 
 @example
-   ;; the traditional program prologue
+   ;; the traditional program prologue with NLOCS = 0 and NEXTS = 1
+
    0    (make-int8 2)
    2    (external-set 0)
    4    (make-int8 4)
-   6    (link "+")    ;; lookup `+'
-   9    (vector 1)    ;; create the external variable vector for
-                      ;; later use by `object-ref' and `object-set'
+   6    (link "+")     ;; lookup `+'
+   9    (vector 1)     ;; create the external variable vector for
+                       ;; later use by `object-ref' and `object-set'
         ...
   40    (load-program ##34#)
-  59    (return)
+  59    (make-closure) ;; assign the current closure to the program
+                       ;; just pushed by `load-program'
+  60    (return)
 @end example
 
 The program loaded here by @var{load-program} contains the following
@@ -588,8 +584,8 @@ sequence of instructions:
   16    (return)           ;; return it
 @end example
 
-At this point, you know pretty much everything about the three types
-of variables a program may need to access.
+At this point, you should know pretty much everything about the three
+types of variables a program may need to access.
 
 
 @node Branch Instructions, Subprogram Control Instructions, Environment Control Instructions, Instruction Set
@@ -656,15 +652,19 @@ parameter of every program.
 
 @cindex Object table
 In order to handle such bindings, each program has an @dfn{object
-table} associated to it.  This table (actually a vector) contains all
-the variable objects corresponding to the external bindings referenced
-by the program.  The object table of a program is initialized right
-before a program is loaded and run with @var{load-program}.
+table} associated to it.  This table (actually a Scheme vector)
+contains all constant objects referenced by the program.  The object
+table of a program is initialized right before a program is loaded
+with @var{load-program}.
 
-Therefore, external bindings only need to be looked up once before the
-program is loaded.  References to the corresponding external variables
-from within the program are then performed via the @var{object-ref}
-instruction and are almost as fast as local variable references.
+Variable objects are one such type of constant object: when a global
+binding is defined, a variable object is associated to it and that
+object will remain constant over time, even if the value bound to it
+changes.  Therefore, external bindings only need to be looked up once
+when the program is loaded.  References to the corresponding external
+variables from within the program are then performed via the
+@var{object-ref} instruction and are almost as fast as local variable
+references.
 
 Let us consider the following program (procedure) which references
 external bindings @code{frob} and @var{%magic}:
@@ -698,7 +698,7 @@ argument which is the bytecode of the program itself.  Disassembled,
 this bytecode looks like:
 
 @example
-z(object-ref 0)  ;; push the variable object of `frob'
+(object-ref 0)  ;; push the variable object of `frob'
 (variable-ref)  ;; dereference it
 (local-ref 0)   ;; push the value of `x'
 (object-ref 1)  ;; push the variable object of `%magic'

module/system/vm/assemble.scm

@@ -28,7 +28,7 @@
   :use-module (ice-9 regex)
   :use-module (ice-9 common-list)
   :use-module (srfi srfi-4)
-  :export (preprocess assemble))
+  :export (preprocess codegen assemble))
 
 (define (assemble glil env . opts)
   (codegen (preprocess glil #f) #t))
@@ -50,18 +50,26 @@
 ;;;
 
 (define (preprocess x e)
+;  (format #t "entering~%")
   (match x
     (($ <glil-asm> vars body)
-     (let* ((venv (<venv> :parent e :nexts vars.nexts :closure? #f))
+;     (format #t "preparing to recurse~%")
+     (let* ((venv (<venv> :parent e :nexts (slot vars 'nexts) :closure? #f))
 	    (body (map (lambda (x) (preprocess x venv)) body)))
        (<vm-asm> :venv venv :glil x :body body)))
     (($ <glil-external> op depth index)
-     (do ((d depth (1- d))
-	  (e e e.parent))
+;     (format #t "preparing to return due to external: ~a ~a ~a [e=~a]~%"
+;	     op depth index e)
+     (do ((d depth (- d 1))
+	  (e e (slot e 'parent)))
 	 ((= d 0))
-       (set! e.closure? #t))
+       (set! (slot e 'closure?) #t))
+;     (format #t "returning due to external~%")
      x)
-    (else x)))
+    (else
+     (begin
+;       (format #t "returning~%")
+       x))))
 
 
 ;;;
@@ -98,7 +106,7 @@
 	 (match x
 	   (($ <vm-asm> venv)
 	    (push-object! (codegen x #f))
-	    (if venv.closure? (push-code! `(make-closure))))
+	    (if (slot venv 'closure?) (push-code! `(make-closure))))
 
 	   (($ <glil-bind> binds)
 	    (let ((bindings

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;

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

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

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

testsuite/Makefile.am

@@ -0,0 +1,24 @@
+# The test programs.
+
+# The Libtool executable.
+GUILE_VM = $(top_srcdir)/src/guile-vm
+
+vm_test_files =					\
+      t-global-bindings.scm			\
+      t-closure.scm				\
+      t-closure2.scm				\
+      t-closure3.scm				\
+      t-do-loop.scm				\
+      t-macros.scm				\
+      t-proc-with-setter.scm			\
+      t-values.scm				\
+      t-records.scm				\
+      t-match.scm
+
+EXTRA_DIST = run-vm-tests.scm $(vm_test_files)
+
+
+check:
+	$(GUILE_VM) -L $(top_srcdir)/module		\
+	            -l run-vm-tests.scm -e run-vm-tests	\
+		    $(vm_test_files)

testsuite/run-vm-tests.scm

@@ -0,0 +1,73 @@
+;;; A simple test-running script.
+
+(use-modules (system vm core)
+	     (system vm disasm)
+	     (system base compile)
+	     (system base language)
+
+	     (srfi srfi-1))
+
+
+(define *scheme* (lookup-language 'scheme))
+
+(define (fetch-sexp-from-file file)
+  (with-input-from-file file
+    (lambda ()
+      (let loop ((sexp (read))
+		 (result '()))
+	(if (eof-object? sexp)
+	    (cons 'begin (reverse result))
+	    (loop (read) (cons sexp result)))))))
+
+(define (compile-to-objcode sexp)
+  "Compile the expression @var{sexp} into a VM program and return it."
+  (compile-in sexp (current-module) *scheme*))
+
+(define (run-vm-program objcode)
+  "Run VM program contained into @var{objcode}."
+  (vm-load (the-vm) objcode))
+
+(define (run-test-from-file file)
+  "Run test from source file @var{file} and return a value indicating whether
+it succeeded."
+  (run-vm-program (compile-to-objcode (fetch-sexp-from-file file))))
+
+
+(define-macro (watch-proc proc-name str)
+  `(let ((orig-proc ,proc-name))
+     (set! ,proc-name
+	   (lambda args
+	     (format #t (string-append ,str "...  "))
+	     (apply orig-proc args)))))
+
+(watch-proc fetch-sexp-from-file  "reading")
+(watch-proc compile-to-objcode    "compiling")
+(watch-proc run-vm-program        "running")
+
+
+;; The program.
+
+(define (run-vm-tests files)
+  (let* ((res (map (lambda (file)
+		     (format #t "running `~a'...  " file)
+		     (if (catch #t
+				(lambda ()
+				  (run-test-from-file file))
+				(lambda (key . args)
+				  (format #t "[~a/~a] " key args)
+				  #f))
+			 (format #t "ok~%")
+			 (begin (format #t "FAILED~%") #f)))
+		   files))
+	 (total (length files))
+	 (failed (length (filter not res))))
+
+    (if (= 0 failed)
+	(begin
+	  (format #t "~%All ~a tests passed~%" total)
+	  (exit 0))
+	(begin
+	  (format #t "~%~a tests failed out of ~a~%"
+		  failed total)
+	  (exit failed)))))
+

testsuite/t-closure.scm

@@ -0,0 +1,5 @@
+(let ((x 2))
+  (lambda ()
+    (let ((x++ (+ 1 x)))
+      (set! x x++)
+      x++)))

testsuite/t-closure2.scm

@@ -0,0 +1,8 @@
+
+(define (uid)
+  (let* ((x 2)
+	 (do-uid (lambda ()
+		   (let ((x++ (+ 1 x)))
+		     (set! x x++)
+		     x++))))
+    (do-uid)))

testsuite/t-closure3.scm

@@ -0,0 +1,5 @@
+(define (stuff)
+  (let* ((x 2)
+	 (chbouib (lambda (z)
+		    (+ 7 z x))))
+    (chbouib 77)))

testsuite/t-do-loop.scm

@@ -0,0 +1,5 @@
+(let ((n+ 0))
+  (do ((n- 5  (1- n-))
+       (n+ n+ (1+ n+)))
+      ((= n- 0))
+    (format #t "n- = ~a~%" n-)))

testsuite/t-global-bindings.scm

@@ -0,0 +1,13 @@
+;; Are global bindings reachable at run-time?  This relies on the
+;; `object-ref' and `object-set' instructions.
+
+(begin
+
+  (define the-binding "hello")
+
+  ((lambda () the-binding))
+
+  ((lambda () (set! the-binding "world")))
+
+  ((lambda () the-binding)))
+

testsuite/t-macros.scm

@@ -0,0 +1,3 @@
+;; Are macros well-expanded at compilation-time?
+
+(false-if-exception (+ 2 2))

testsuite/t-match.scm

@@ -0,0 +1,23 @@
+(use-modules (ice-9 match)
+	     (srfi srfi-9))  ;; record type
+
+(define-record-type <stuff>
+  (%make-stuff chbouib)
+  stuff?
+  (chbouib stuff:chbouib stuff:set-chbouib!))
+
+(define (matches? obj)
+;  (format #t "matches? ~a~%" obj)
+  (match obj
+	 (($ stuff) => #t)
+;	 (blurps    #t)
+	 ("hello"   #t)
+	 (else #f)))
+
+
+;(format #t "go!~%")
+(and (matches? (%make-stuff 12))
+     (matches? (%make-stuff 7))
+     (matches? "hello")
+;     (matches? 'blurps)
+     (not (matches? 66)))

testsuite/t-proc-with-setter.scm

@@ -0,0 +1,14 @@
+(define the-struct (vector 1 2))
+
+(define get/set
+  (make-procedure-with-setter
+   (lambda (struct name)
+     (case name
+       ((first)  (vector-ref struct 0))
+       ((second) (vector-ref struct 1))
+       (else     #f)))
+   (lambda (struct name val)
+     (case name
+       ((first)  (vector-set! struct 0 val))
+       ((second) (vector-set! struct 1 val))
+       (else     #f)))))

testsuite/t-records.scm

@@ -0,0 +1,12 @@
+(use-modules (srfi srfi-9))
+
+(define-record-type <stuff>
+  (%make-stuff chbouib)
+  stuff?
+  (chbouib stuff:chbouib stuff:set-chbouib!))
+
+
+(and (stuff? (%make-stuff 12))
+     (= 7 (stuff:chbouib (%make-stuff 7)))
+     (not (stuff? 12))
+     (not (false-if-exception (%make-stuff))))

testsuite/t-values.scm

@@ -0,0 +1,8 @@
+(use-modules (ice-9 receive))
+
+(define (do-stuff x y)
+  (values x y))
+
+(call-with-values (lambda ()    (values 1 2))
+		  (lambda (x y) (cons x y)))
+

testsuite/the-bug.txt

@@ -0,0 +1,95 @@
+-*- Outline -*-
+
+Once (system vm assemble) is compiled, things start to fail in
+unpredictable ways.
+
+* `compile-file' of non-closure-using programs works
+
+$ guile-disasm t-records.go > t-records.ref.asm
+...
+$ diff -uBb t-macros.*.asm
+$ diff -uBb t-records.*.asm
+$ diff -uBb t-global-bindings.*.asm
+
+* `compile-file' of closure-using programs fails
+
+ERROR: During compiling t-closure.scm:
+ERROR: VM: Wrong type to apply: #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) [IP offset: 28]
+
+guile> (vm-debugger (the-vm))
+debug> bt
+#1 #<variable 30b12468 value: (#(<glil-asm> #(<glil-vars> ((nargs . 0) (nrest . 0) (nlocs . 0) (nexts . 1))) (#(<glil-const> 2) #(<glil-bind> ((x external 0))) #(<glil-external> set 0 0) #(<glil-asm> #(<glil-vars> ((nargs . 0) (nrest . 0) (nlocs . 1) (nexts . 0))) (#(<glil-module> ref #f +) #(<glil-const> 1) #(<glil-external> ref 1 0) #(<glil-call> call 2) #(<glil-source> (2 . 15)) #(<glil-bind> ((x++ local 0))) #(<glil-local> set 0) #(<glil-local> ref 0) #(<glil-external> set 1 0) #(<glil-local> ref 0) #(<glil-call> return 0) #(<glil-unbind>))) #(<glil-call> return 0) #(<glil-unbind>))) #<directory (guile-user) 100742d0> ())>
+#2 (#<program 30ae74b8> #(<glil-vars> ...) (#(<glil-const> ...) #(<glil-bind> ...) ...))   
+#3 (#<program 30af7090>)
+#4 (#<program 30af94c0> #(<glil-vars> ...) (#(<glil-module> ...) #(<glil-const> ...) ...)) 
+#5 (#<program 30b00108>)
+#6 (#<program 30b02590> ref ...)
+#7 (_l 1 #(<venv> ...))
+guile> (vm-debugger (the-vm))
+debug> stack
+(#t closure? #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) #<procedure #f (struct name val)> #<primitive-generic map> #<primitive-generic map> #<program 30998470>)
+
+* Compiling anything "by hand" fails
+
+** Example 1:  the read/compile/run loop
+
+guile> (set! %load-path (cons "/home/ludo/src/guile-vm/module" %load-path))
+guile> (use-modules (system vm assemble)(system vm core)(system repl repl))
+guile> (start-repl 'scheme)
+Guile Scheme interpreter 0.5 on Guile 1.7.2
+Copyright (C) 2001 Free Software Foundation, Inc.
+
+Enter `,help' for help.
+scheme@guile-user> (use-modules (ice-9 match)
+	     (system base syntax)
+	     (system vm assemble))
+
+(define (%preprocess x e)
+  (match x
+    (($ <glil-asm> vars body)
+     (let* ((venv (<venv> :parent e :nexts (slot vars 'nexts) :closure? #f))
+	    (body (map (lambda (x) (preprocess x venv)) body)))
+       (<vm-asm> :venv venv :glil x :body body)))
+    (($ <glil-external> op depth index)
+     (do ((d depth (1- d))
+	  (e e (slot e 'parent)))
+	 ((= d 0))
+       (set! (slot e 'closure?) #t))
+     x)
+    (else x)))
+
+scheme@guile-user> preprocess
+#<procedure preprocess (x e)>
+scheme@guile-user> (getpid)
+470
+scheme@guile-user> (set! preprocess %preprocess)
+scheme@guile-user> preprocess
+ERROR: VM: Unbound variable: #<variable 30a0d5e0 value: #<undefined>>
+scheme@guile-user> getpid
+ERROR: VM: Unbound variable: #<variable 30a0d5e0 value: #<undefined>>
+scheme@guile-user>
+
+
+** Example 2:  the test suite (which also reads/compiles/runs)
+
+All the closure-using tests fail.
+
+ludo@lully:~/src/guile-vm/testsuite $ make check
+../src/guile-vm -L ../module            \
+            -l run-vm-tests.scm -e run-vm-tests \
+            t-global-bindings.scm t-closure.scm t-closure2.scm t-closure3.scm t-do-loop.scm t-macros.scm t-proc-with-setter.scm t-values.scm t-records.scm t-match.scm
+
+running `t-global-bindings.scm'...  reading...  compiling...  running...  ok
+running `t-closure.scm'...  reading...  compiling...  [vm-error/(vm-run VM: Wrong type to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
+running `t-closure2.scm'...  reading...  compiling...  [vm-error/(vm-run VM: Wrong type to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 0) (closure? . #f)))) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
+running `t-closure3.scm'...  reading...  compiling...  [vm-error/(vm-run VM: Wrong ype to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 0) (closure? . #f)))) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
+running `t-do-loop.scm'...  reading...  compiling...  [vm-error/(vm-run VM: Wrong type to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
+running `t-macros.scm'...  reading...  compiling...  running...  ok
+running `t-proc-with-setter.scm'...  reading...  compiling...  running...  ok
+running `t-values.scm'...  reading...  compiling...  running...  ok
+running `t-records.scm'...  reading...  compiling...  running...  ok
+running `t-match.scm'...  reading...  compiling...  running...  ok
+
+4 tests failed out of 10
+make: *** [check] Error 4
+