conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* removed junk from input-files handlers.

This commit is contained in:
Abdulaziz Ghuloum 2007-05-17 06:46:47 -04:00
parent 52a28f8332
commit bc41665bf3
2 changed files with 0 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

139
src/ikarus.io.input-files.ss
View File

@ -138,145 +138,6 @@
(error 'input-file-handler
"message not handled ~s" (cons msg args))])))))
(define make-input-file-handler-old
(lambda (fd port-name)
(let ((open? #t))
(lambda (msg . args)
(message-case msg args
[(read-char p)
(unless (input-port? p)
(error 'read-char "~s is not an input port" p))
(let ([idx ($port-input-index p)])
(if ($fx< idx ($port-input-size p))
(begin
($set-port-input-index! p ($fxadd1 idx))
(string-ref ($port-input-buffer p) idx))
(if open?
(let ([bytes
(foreign-call "ikrt_read"
fd ($port-input-buffer p))])
;($do-event)
(cond
[($fx> bytes 0)
($set-port-input-size! p bytes)
($read-char p)]
[($fx= bytes 0)
(eof-object)]
[else
(error 'read-char "Cannot read from ~a"
port-name)]))
(error 'read-char "port ~s is closed" p))))]
[(peek-char p)
(unless (input-port? p)
(error 'peek-char "~s is not an input port" p))
(let ([idx ($port-input-index p)])
(if ($fx< idx ($port-input-size p))
(string-ref ($port-input-buffer p) idx)
(if open?
(let ([bytes
(foreign-call "ikrt_read" fd
(port-input-buffer p))])
(cond
[(not bytes)
(error 'peek-char
"Cannot read from ~s" port-name)]
[($fx= bytes 0)
(eof-object)]
[else
($set-port-input-size! p bytes)
($peek-char p)]))
(error 'peek-char "port ~s is closed" p))))]
[(unread-char c p)
(unless (input-port? p)
(error 'unread-char "~s is not an input port" p))
(let ([idx ($fxsub1 ($port-input-index p))])
(if (and ($fx>= idx 0)
($fx< idx ($port-input-size p)))
(begin
($set-port-input-index! p idx)
(string-set! ($port-input-buffer p) idx c))
(if open?
(error 'unread-char "port ~s is closed" p)
(error 'unread-char "too many unread-chars"))))]
[(port-name p) port-name]
[(close-port p)
(unless (input-port? p)
(error 'close-input-port "~s is not an input port" p))
(when open?
($set-port-input-size! p 0)
(set! open? #f)
(unless (foreign-call "ikrt_close_file" fd)
(error 'close-input-port "cannot close ~s" port-name)))]
[else
(error 'input-file-handler
"message not handled ~s" (cons msg args))])))))
(define make-input-file-handler-trans
(lambda (fd port-name)
(let ([open? #t] [idx 0] [size 0] [buff (make-string 4096)])
(lambda (msg . args)
(message-case msg args
[(read-char p)
(unless (input-port? p)
(error 'read-char "~s is not an input port" p))
(if ($fx< idx size)
(let ([c (string-ref buff idx)])
(set! idx ($fxadd1 idx))
c)
(if open?
(let ([bytes
(foreign-call "ikrt_read" fd buff)])
(cond
[($fx> bytes 0)
(set! size bytes)
(set! idx 1)
($string-ref buff 0)]
[($fx= bytes 0)
(eof-object)]
[else
(error 'read-char "Cannot read from ~a"
port-name)]))
(error 'read-char "port ~s is closed" p)))]
[(peek-char p)
(unless (input-port? p)
(error 'peek-char "~s is not an input port" p))
(if ($fx< idx size)
(string-ref buff idx)
(if open?
(let ([bytes
(foreign-call "ikrt_read" fd buff)])
(cond
[(not bytes)
(error 'peek-char
"Cannot read from ~s" port-name)]
[($fx= bytes 0)
(eof-object)]
[else
(set! size bytes)
(string-ref buff 0)]))
(error 'peek-char "port ~s is closed" p)))]
[(unread-char c p)
(unless (input-port? p)
(error 'unread-char "~s is not an input port" p))
(let ([i ($fxsub1 idx)])
(if (and ($fx>= i 0) ($fx< i size))
(set! idx i)
(if open?
(error 'unread-char "port ~s is closed" p)
(error 'unread-char "too many unread-chars"))))]
[(port-name p) port-name]
[(close-port p)
(unless (input-port? p)
(error 'close-input-port "~s is not an input port" p))
(when open?
(set! size 0)
(set! open? #f)
(unless (foreign-call "ikrt_close_file" fd)
(error 'close-input-port "cannot close ~s" port-name)))]
[else
(error 'input-file-handler
"message not handled ~s" (cons msg args))])))))
(define $open-input-file
(lambda (filename)
(close-ports)