* Input/output ports are closed when the last reference to them is

dropped.  Dropped files are closed before new files are opened.
This commit is contained in:
Abdulaziz Ghuloum 2006-12-21 11:14:12 +03:00
parent 2fcae826d1
commit 5615b03879
3 changed files with 27 additions and 5 deletions

2
TODO
View File

@ -1,6 +1,6 @@
* Guardians:
CHECK - Implement guardians.
- clean up after file ports are dead by flushing/closing the
CHECK - clean up after file ports are dead by flushing/closing the
underlying file handle.
* Interrupts:

Binary file not shown.

View File

@ -390,6 +390,14 @@
(error 'flush-output-port "~s is not an output-port" p))])))
(let () ;;; INPUT FILES
(define guardian (make-guardian))
(define close-ports
(lambda ()
(cond
[(guardian) =>
(lambda (p)
(close-input-port p)
(close-ports))])))
;;;
(define make-input-file-handler
(lambda (fd port-name)
@ -463,12 +471,14 @@
"message not handled ~s" (cons msg args))])))))
(define open-input-file
(lambda (filename)
(close-ports)
(let ([fd/error (foreign-call "ikrt_open_input_file" filename)])
(if (fixnum? fd/error)
(let ([port (make-input-port
(make-input-file-handler fd/error filename)
(make-string 4096))])
(set-port-input-size! port 0)
(guardian port)
port)
(error 'open-input-file "cannot open ~s: ~a" filename fd/error)))))
(primitive-set! '*standard-input-port*
@ -493,6 +503,14 @@
(error 'open-input-file "~s is not a string" filename)))))
(let () ;;; OUTPUT FILES
(define guardian (make-guardian))
(define close-ports
(lambda ()
(cond
[(guardian) =>
(lambda (p)
(close-output-port p)
(close-ports))])))
;;;
(define do-write-buffer
(lambda (fd port-name p caller)
@ -550,14 +568,18 @@
[else (error 'open-output-file "~s is not a valid mode" x)]))
(define open-output-file
(lambda (filename options)
(close-ports)
(let ([fd/error
(foreign-call "ikrt_open_output_file"
filename
(option-id options))])
(if (fixnum? fd/error)
(let ([port
(make-output-port
(make-output-file-handler fd/error filename)
(make-string 4096))
(make-string 4096))])
(guardian port)
port)
(error 'open-output-file "cannot open ~s: ~a" filename fd/error)))))
(primitive-set! '*standard-output-port*
(make-output-port