HCoop / bpt / guile.git / blame
| Commit | Line | Data |
|---|---|---|
| 0b5f0e49 LC |
1 | -*- Outline -*- |
| 2 | ||
| 3 | Once (system vm assemble) is compiled, things start to fail in | |
| 4 | unpredictable ways. | |
| 5 | ||
| 6 | * `compile-file' of non-closure-using programs works | |
| 7 | ||
| 8 | $ guile-disasm t-records.go > t-records.ref.asm | |
| 9 | ... | |
| 10 | $ diff -uBb t-macros.*.asm | |
| 11 | $ diff -uBb t-records.*.asm | |
| 12 | $ diff -uBb t-global-bindings.*.asm | |
| 13 | ||
| 14 | * `compile-file' of closure-using programs fails | |
| 15 | ||
| 16 | ERROR: During compiling t-closure.scm: | |
| 17 | ERROR: VM: Wrong type to apply: #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) [IP offset: 28] | |
| 18 | ||
| 19 | guile> (vm-debugger (the-vm)) | |
| 20 | debug> bt | |
| 21 | #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> ())> | |
| 22 | #2 (#<program 30ae74b8> #(<glil-vars> ...) (#(<glil-const> ...) #(<glil-bind> ...) ...)) | |
| 23 | #3 (#<program 30af7090>) | |
| 24 | #4 (#<program 30af94c0> #(<glil-vars> ...) (#(<glil-module> ...) #(<glil-const> ...) ...)) | |
| 25 | #5 (#<program 30b00108>) | |
| 26 | #6 (#<program 30b02590> ref ...) | |
| 27 | #7 (_l 1 #(<venv> ...)) | |
| 28 | guile> (vm-debugger (the-vm)) | |
| 29 | debug> stack | |
| 30 | (#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>) | |
| 31 | ||
| 32 | * Compiling anything "by hand" fails | |
| 33 | ||
| 34 | ** Example 1: the read/compile/run loop | |
| 35 | ||
| 36 | guile> (set! %load-path (cons "/home/ludo/src/guile-vm/module" %load-path)) | |
| 37 | guile> (use-modules (system vm assemble)(system vm core)(system repl repl)) | |
| 38 | guile> (start-repl 'scheme) | |
| 39 | Guile Scheme interpreter 0.5 on Guile 1.7.2 | |
| 40 | Copyright (C) 2001 Free Software Foundation, Inc. | |
| 41 | ||
| 42 | Enter `,help' for help. | |
| 43 | scheme@guile-user> (use-modules (ice-9 match) | |
| 44 | (system base syntax) | |
| 45 | (system vm assemble)) | |
| 46 | ||
| 47 | (define (%preprocess x e) | |
| 48 | (match x | |
| 49 | (($ <glil-asm> vars body) | |
| 50 | (let* ((venv (<venv> :parent e :nexts (slot vars 'nexts) :closure? #f)) | |
| 51 | (body (map (lambda (x) (preprocess x venv)) body))) | |
| 52 | (<vm-asm> :venv venv :glil x :body body))) | |
| 53 | (($ <glil-external> op depth index) | |
| 54 | (do ((d depth (1- d)) | |
| 55 | (e e (slot e 'parent))) | |
| 56 | ((= d 0)) | |
| 57 | (set! (slot e 'closure?) #t)) | |
| 58 | x) | |
| 59 | (else x))) | |
| 60 | ||
| 61 | scheme@guile-user> preprocess | |
| 62 | #<procedure preprocess (x e)> | |
| 63 | scheme@guile-user> (getpid) | |
| 64 | 470 | |
| 65 | scheme@guile-user> (set! preprocess %preprocess) | |
| 66 | scheme@guile-user> preprocess | |
| 67 | ERROR: VM: Unbound variable: #<variable 30a0d5e0 value: #<undefined>> | |
| 68 | scheme@guile-user> getpid | |
| 69 | ERROR: VM: Unbound variable: #<variable 30a0d5e0 value: #<undefined>> | |
| 70 | scheme@guile-user> | |
| 71 | ||
| 72 | ||
| 73 | ** Example 2: the test suite (which also reads/compiles/runs) | |
| 74 | ||
| 75 | All the closure-using tests fail. | |
| 76 | ||
| 77 | ludo@lully:~/src/guile-vm/testsuite $ make check | |
| 78 | ../src/guile-vm -L ../module \ | |
| 79 | -l run-vm-tests.scm -e run-vm-tests \ | |
| 80 | 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 | |
| 81 | ||
| 82 | running `t-global-bindings.scm'... reading... compiling... running... ok | |
| 83 | 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 | |
| 84 | 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 | |
| 85 | 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 | |
| 86 | 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 | |
| 87 | running `t-macros.scm'... reading... compiling... running... ok | |
| 88 | running `t-proc-with-setter.scm'... reading... compiling... running... ok | |
| 89 | running `t-values.scm'... reading... compiling... running... ok | |
| 90 | running `t-records.scm'... reading... compiling... running... ok | |
| 91 | running `t-match.scm'... reading... compiling... running... ok | |
| 92 | ||
| 93 | 4 tests failed out of 10 | |
| 94 | make: *** [check] Error 4 | |
| 95 |