Martin Gasbichler wrote:
Grant Miner <mine0057@mrs.umn.edu> writes:
Hello,
I receive this exception in my scsh program:
Error: exception
extension-exception
(vm-extension 103 '#(0. 0. 0.))
What should I do?
Could you please post the program, the backtrace (",preview") or the
output of the debugger (",debug" followed by several "d" key strokes).
Thank you,
Here's that output.
> (load "bench.scm")
bench.scm
Outputting results in /root/results.txt
The filesystems will be stored on /dev/hdb2
This will destroy all data on /dev/hdb2! Continue (Y/N)?Y
Creating filesystem...reiser4 created.
Started test sync...done.
Started test test1...
Error: exception
extension-exception
(vm-extension 103 '#(0. 0. 0.))
1> 1> ,preview
unnamed in float&float->float in floatnums
/ in scheme-level-0
tester in run-tests in "bench.scm"
run-tests in "bench.scm"
"bench.scm"
evaluate-and-select in command-processor
loop
thread-start in thread-top-level in threads
1>
1> ,debug
'#{Exception-continuation (pc 58) (unnamed in float&float->float in
floatnums)}
[0: res] 0.
[1: a] 0.
[2: b] 0.
[3: op] 3
inspect: d
'#{Exception-continuation (pc 15) (/ in scheme-level-0)}
inspect: d
'#{Continuation (pc 360) (tester in run-tests)}
Waiting for (/ (+ (cadr score) (caddr score)) (car score))
in (display ^^^ results)
[0: score] '(0. 0. 0.)
[1: tests] '("test1" ("sync") "test2" ("sync"))
[2: scores] '((0.01 0. 0.))
[3: tester] '#{Procedure 14402 (tester in run-tests)}
[4: filesystem-creators] '(#{Procedure 14429 reiser4})
[5: tests] '("sync" ("sync") "test1" ("sync") "test2" ---)
inspect: d
'#{Continuation (pc 162) run-tests}
Waiting for (letrec ((tester #)) (tester tests '()))
in (begin (newline) (display "Creating filesystem...") ((car
filesystem-creators)) (display (string-append currentfs " created.")) ---)
[0: filesystem-creators] '(#{Procedure 14429 reiser4})
[1: tests] '("sync" ("sync") "test1" ("sync") "test2" ---)
inspect: d
'#{Continuation (pc 80) 14393}
inspect: d
'#{Continuation (pc 25) (evaluate-and-select in command-processor)}
[0] '#{Procedure 5856 (unnamed in evaluate-and-select in
command-processor)}
[1] '(load "bench.scm")
[2] '#{Package 166 user}
inspect: d
'#{Continuation (pc 67) (loop in unnamed in real-command-loop ---)}
[0] '(run (load "bench.scm"))
[1] '()
[2] '#{Procedure 5886 (loop in unnamed in real-command-loop ---)}
inspect: d
'#{Continuation (pc 62) (with-dynamic-env in fluids)}
[0] '#{Procedure 1109 (unnamed in with-dynamic-env in fluids)}
[1] '((# # # # # ---) (# . #) (# # # # # ---) (# # # # #) (# # # #) ---)
[2] #f
[3] #f
inspect: d
'#{Continuation (pc 15) (thread-start in thread-top-level in threads)}
[0] '#{Procedure 1505 (unnamed in thread-start in thread-top-level ---)}
[1] '#{Procedure 5884 (real-command-loop in command-processor)}
inspect: d
#f
inspect: d
Can't go down from a non-continuation.
#!/usr/bin/scsh \
-ds -s
!#
;;; CONFIGURATION
; benchmark results stored here
(define results-file "/root/results.txt")
; to-be-tested filesystem is mounted here
(define mountpoint "/mnt/test")
; device to store the filesystem
; (define device "/dev/null")
(define device "/dev/hdb2")
;;; The tests to perform: first item is the name of your test (for the results
output), second is what to run
(define tests '(
; "bigdir" ("cp" "-a" "/home/test/mozilla" "/mnt/test")
; "cp" ("cp" "-a" "/mnt/test/mozilla" "/mnt/test/mozilla-2")
; "cp2" ("cp" "-a" "/mnt/test/mozilla-2" "/mnt/test/mozilla-3")
"rm" ("rm" "-rf" "/mnt/test/mozilla")
; "rm2" ("rm" "-rf" "/mnt/test/mozilla-2")
; "rm3" ("rm" "-rf" "/mnt/test/mozilla-3")
"sync" ("sync")
; "fall" ("sync")
; "flip" ("sync")
))
;;; PROGRAM FOLLOWS
(define results (open-output-file results-file))
(define join (lambda (source destination)
(letrec ((helper (lambda (source destination)
(if (null? source)
destination
(helper (cdr source) (cons (car source)
destination))))))
(helper (reverse source) destination))))
; the name of the filesystem currently being tested
(define currentfs "none")
;;; helper procedure, makes a filesystem
;;; @mkfs-proc a procedure to create the filesystem, takes a device name
;;; @type the filesystem name, so that mount can know what filesystem it is to
use
(define mkfs (lambda (type mkfs-proc)
(run (umount ,device))
(mkfs-proc device)
(run (mount "-t" ,type ,device ,mountpoint))
(set! currentfs type)))
(define reiser4 (lambda ()
(mkfs "reiser4" (lambda (device) (run (| (yes) (mkfs.reiser4
"--keys=SHORT" ,device)) (> "/dev/null") (> 2 "/dev/null"))))))
(define ext2 (lambda ()
(mkfs "ext2" (lambda (device) (run (mkfs.ext2 ,device) (>
"/dev/null") (> 2 "/dev/null"))))))
(define ext3 (lambda ()
(mkfs "ext3" (lambda (device) (run (mkfs.ext3 ,device) (>
"/dev/null") (> 2 "/dev/null"))))))
(define jfs (lambda ()
(mkfs "jfs" (lambda (device) (run (| (yes) (mkfs.jfs ,device)) (>
"/dev/null") (> 2 "/dev/null"))))))
(define reiserfs (lambda ()
(mkfs "reiserfs" (lambda (device) (run (| (yes) (mkfs.reiserfs
,device)) (> "/dev/null") (> 2 "/dev/null"))))))
(define xfs (lambda ()
(mkfs "xfs" (lambda (device) (run (mkfs.xfs "-f" ,device) (>
"/dev/null") (> 2 "/dev/null"))))))
; which filesystems to use (a list of procedures to make the right filesystem
on 'device)
;;; All
;(define filesystem-creators (cons ext2 (cons ext3 (cons jfs (cons reiserfs
(cons reiser4 (cons xfs '())))))))
;;; Just ext2
;(define filesystem-creators (cons ext2 '()))
;;; Just ext2 and reiser4
;(define filesystem-creators (cons ext2 (cons reiser4 '())))
(define filesystem-creators (cons reiser4 '()))
(define (run-tests filesystem-creators tests)
(if (not (null? filesystem-creators))
(begin
(newline)
(display "Creating filesystem...")
((car filesystem-creators))
(display (string-append currentfs " created."))
(newline results)
(display currentfs results)
(letrec ((tester (lambda (tests scores)
(if (null? tests)
;come up with a total
'()
; (letrec ((total (lambda (scores sum)
; (if (null? scores)
; sum
; (total (cdr scores) (cons (+
(caar (scores)) (car sum))
;
(cons (+ (cadar (scores)) (cadr sum))
;
(cons (+ (caddar (scores)) (caddr sum))
;
'()))))))))
; (let ((sum (total scores '())))
; (display "\t" results)
; (display (car sum) results)
; (display (/ (+ (cdr sum) (cadr sum)) (car
sum)) results)))
(begin
(display "\t" results)
;(= 2 1) sends stdout to port 2 (basically discards it)
;(= 1 3) sends stderr, which is where time puts its results, to stdout (what
run/strings uses)
(newline)
(display (string-append "Started test " (car
tests) "..."))
;(display (run/sexps ,(join (cons 'time
(cons "-f" (cons "%e %S %U" '()))) (cadr tests)) (= 2 1) (= 1 3)) results)
(let ((score (run/sexps ,(join (cons 'time
(cons "-f" (cons "%e %S %U" '()))) (cadr tests)) (= 2 1) (= 1 3))))
(display (car score) results)
(display " " results)
(display (/ (+ (cadr score) (caddr score))
(car score)) results)
(display "done.")
(tester (cddr tests) (cons score
scores))))))))
(tester tests '()))
(run-tests (cdr filesystem-creators) tests))))
(display (string-append "Outputting results in " results-file))
(newline)
(display (string-append "The filesystems will be stored on " device))
(newline)
(display (string-append "This will destroy all data on " device "! Continue
(Y/N)?"))
(let ((ans (read)))
(if (equal? ans 'Y)
(begin
;print out a line with the names of the tests
(letrec ((output-names (lambda (tests)
(display "\t" results)
(if (not (null? tests))
(begin
(display (car tests) results)
(display "\t" results)
(output-names (cddr tests)))))))
(output-names tests))
(run-tests filesystem-creators tests))))
(newline)
|