diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | benchmark/lib.scm | 7 | ||||
| -rw-r--r-- | configure.in | 3 | ||||
| -rw-r--r-- | doc/guile-vm.texi | 62 | ||||
| -rw-r--r-- | module/system/vm/assemble.scm | 22 | ||||
| -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 | ||||
| -rw-r--r-- | testsuite/Makefile.am | 24 | ||||
| -rw-r--r-- | testsuite/run-vm-tests.scm | 73 | ||||
| -rw-r--r-- | testsuite/t-closure.scm | 5 | ||||
| -rw-r--r-- | testsuite/t-closure2.scm | 8 | ||||
| -rw-r--r-- | testsuite/t-closure3.scm | 5 | ||||
| -rw-r--r-- | testsuite/t-do-loop.scm | 5 | ||||
| -rw-r--r-- | testsuite/t-global-bindings.scm | 13 | ||||
| -rw-r--r-- | testsuite/t-macros.scm | 3 | ||||
| -rw-r--r-- | testsuite/t-match.scm | 23 | ||||
| -rw-r--r-- | testsuite/t-proc-with-setter.scm | 14 | ||||
| -rw-r--r-- | testsuite/t-records.scm | 12 | ||||
| -rw-r--r-- | testsuite/t-values.scm | 8 | ||||
| -rw-r--r-- | testsuite/the-bug.txt | 95 |
22 files changed, 383 insertions, 55 deletions
diff --git a/Makefile.am b/Makefile.am index 1b0e4dd45..feaaaa9d7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,4 +1,4 @@ -SUBDIRS = src doc module +SUBDIRS = src doc module testsuite EXTRA_DIST = acconfig.h diff --git a/benchmark/lib.scm b/benchmark/lib.scm index 31e524453..d46e00ca9 100644 --- a/benchmark/lib.scm +++ b/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 diff --git a/configure.in b/configure.in index ef35f5bf9..3adf91ea3 100644 --- a/configure.in +++ b/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) diff --git a/doc/guile-vm.texi b/doc/guile-vm.texi index 8dee2e48f..44213beb3 100644 --- a/doc/guile-vm.texi +++ b/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}. - -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. +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}. + +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' diff --git a/module/system/vm/assemble.scm b/module/system/vm/assemble.scm index 3332e5061..49dc1fc09 100644 --- a/module/system/vm/assemble.scm +++ b/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 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; } diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am new file mode 100644 index 000000000..5b929f698 --- /dev/null +++ b/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) diff --git a/testsuite/run-vm-tests.scm b/testsuite/run-vm-tests.scm new file mode 100644 index 000000000..24da98690 --- /dev/null +++ b/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))))) + diff --git a/testsuite/t-closure.scm b/testsuite/t-closure.scm new file mode 100644 index 000000000..65d14dd4b --- /dev/null +++ b/testsuite/t-closure.scm @@ -0,0 +1,5 @@ +(let ((x 2)) + (lambda () + (let ((x++ (+ 1 x))) + (set! x x++) + x++))) diff --git a/testsuite/t-closure2.scm b/testsuite/t-closure2.scm new file mode 100644 index 000000000..0142c80b4 --- /dev/null +++ b/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))) diff --git a/testsuite/t-closure3.scm b/testsuite/t-closure3.scm new file mode 100644 index 000000000..519261d46 --- /dev/null +++ b/testsuite/t-closure3.scm @@ -0,0 +1,5 @@ +(define (stuff) + (let* ((x 2) + (chbouib (lambda (z) + (+ 7 z x)))) + (chbouib 77))) diff --git a/testsuite/t-do-loop.scm b/testsuite/t-do-loop.scm new file mode 100644 index 000000000..257677f8c --- /dev/null +++ b/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-))) diff --git a/testsuite/t-global-bindings.scm b/testsuite/t-global-bindings.scm new file mode 100644 index 000000000..c8ae3692c --- /dev/null +++ b/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))) + diff --git a/testsuite/t-macros.scm b/testsuite/t-macros.scm new file mode 100644 index 000000000..ff5501e9d --- /dev/null +++ b/testsuite/t-macros.scm @@ -0,0 +1,3 @@ +;; Are macros well-expanded at compilation-time? + +(false-if-exception (+ 2 2)) diff --git a/testsuite/t-match.scm b/testsuite/t-match.scm new file mode 100644 index 000000000..d6afd3044 --- /dev/null +++ b/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))) diff --git a/testsuite/t-proc-with-setter.scm b/testsuite/t-proc-with-setter.scm new file mode 100644 index 000000000..bfb66386a --- /dev/null +++ b/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))))) diff --git a/testsuite/t-records.scm b/testsuite/t-records.scm new file mode 100644 index 000000000..eedd44e21 --- /dev/null +++ b/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)))) diff --git a/testsuite/t-values.scm b/testsuite/t-values.scm new file mode 100644 index 000000000..e741ae423 --- /dev/null +++ b/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))) + diff --git a/testsuite/the-bug.txt b/testsuite/the-bug.txt new file mode 100644 index 000000000..95683f445 --- /dev/null +++ b/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 + |