73 lines
2.9 KiB
ArmAsm
73 lines
2.9 KiB
ArmAsm
|
;
|
|||
|
; The following code is an example of an error handler for I/O errors. The
|
|||
|
; function open-input-file attempts to open filename for input. Note that
|
|||
|
; a continuation is saved in the fluid variable my%ioerr before the call to
|
|||
|
; open-input-file. Upon return from the open, the variable port is
|
|||
|
; interrogated to determine the status- To retry the operation with the same
|
|||
|
; filename, retry the operation with a different filename, or return the port
|
|||
|
; object.
|
|||
|
;
|
|||
|
|
|||
|
(define (open-input-file filename)
|
|||
|
(let ((port (call/cc
|
|||
|
(fluid-lambda (my%ioerr)
|
|||
|
((access open-input-file user-global-environment)
|
|||
|
filename)))))
|
|||
|
(cond ((eq? port 'retry)
|
|||
|
(open-input-file filename))
|
|||
|
((string? port)
|
|||
|
(open-input-file port))
|
|||
|
(else
|
|||
|
port))))
|
|||
|
|
|||
|
;
|
|||
|
; *USER-ERROR-HANDLER* has been designed to trap on all I/O errors, pop up a
|
|||
|
; window to indicate the error, and illicit a response from the user. The
|
|||
|
; result is then returned via the continuation bound to the fluid variable
|
|||
|
; my%ioerr. The system error handler is called for all other errors.
|
|||
|
;
|
|||
|
; See the User's Guide for a discussion on user error handling and a list of
|
|||
|
; all I/O errors.
|
|||
|
;
|
|||
|
|
|||
|
(set! (access *user-error-handler* user-global-environment)
|
|||
|
(lambda (error-num error-msg irritant sys-error-handler)
|
|||
|
(if (and (fluid-bound? my%ioerr)
|
|||
|
(number? error-num)
|
|||
|
(>= error-num 1)
|
|||
|
(<= error-num 88))
|
|||
|
(let ((win (make-window error-msg #t))
|
|||
|
(result '()))
|
|||
|
(window-set-position! win 10 10)
|
|||
|
(window-set-size! win 6 50)
|
|||
|
(window-set-cursor! win 2 5)
|
|||
|
(window-popup win)
|
|||
|
(case error-num
|
|||
|
((2 3) ;file/path not found
|
|||
|
(display "File/Path not found : " win)
|
|||
|
(display irritant win)
|
|||
|
(newline win)
|
|||
|
(display "Enter new pathname (or return to exit) - " win)
|
|||
|
(set! result (read-line win))
|
|||
|
(if (string=? result "")
|
|||
|
(set! result '())))
|
|||
|
((21) ;drive not ready
|
|||
|
(display "Drive not ready - Retry (y/n)?" win)
|
|||
|
(set! result
|
|||
|
(if (char=? (char-upcase (read-char win)) #\Y)
|
|||
|
'retry
|
|||
|
'())))
|
|||
|
(else
|
|||
|
(display "Extended Dos I/O Error - " win)
|
|||
|
(display irritant win)
|
|||
|
(newline win)
|
|||
|
(newline win)
|
|||
|
(char-upcase (read-char win))
|
|||
|
(set! result '())))
|
|||
|
|
|||
|
(window-popup-delete win)
|
|||
|
((fluid my%ioerr) result))
|
|||
|
;else
|
|||
|
(sys-error-handler))))
|
|||
|
|
|||
|
|