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

* input ports now have a bytevector as buffer

This commit is contained in:
Abdulaziz Ghuloum 2007-05-17 06:27:59 -04:00
parent efd2734075
commit 3148d7f95c
5 changed files with 101 additions and 22 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.

15
src/ikarus.io-ports.ss
View File

@ -10,6 +10,7 @@
(import
(ikarus system $ports)
(ikarus system $strings)
(ikarus system $bytevectors)
(ikarus system $fx)
(except (ikarus) make-input-port make-output-port
make-input/output-port port-handler
@ -52,14 +53,14 @@
;;;
(define $make-input-port
(lambda (handler buffer)
($make-port/input handler buffer 0 (string-length buffer) #f 0 0)))
($make-port/input handler buffer 0 ($bytevector-length buffer) #f 0 0)))
;;;
(define make-input-port
(lambda (handler buffer)
(if (procedure? handler)
(if (string? buffer)
(if (bytevector? buffer)
($make-input-port handler buffer)
(error 'make-input-port "~s is not a string" buffer))
(error 'make-input-port "~s is not a bytevector" buffer))
(error 'make-input-port "~s is not a procedure" handler))))
;;;
(define $make-output-port
@ -77,19 +78,19 @@
(define $make-input/output-port
(lambda (handler input-buffer output-buffer)
($make-port/both handler
input-buffer 0 (string-length input-buffer)
input-buffer 0 ($bytevector-length input-buffer)
output-buffer 0 (string-length output-buffer))))
;;;
(define make-input/output-port
(lambda (handler input-buffer output-buffer)
(if (procedure? handler)
(if (string? input-buffer)
(if (bytevector? input-buffer)
(if (string? output-buffer)
($make-input/output-port handler input-buffer output-buffer)
(error 'make-input/output-port
"~s is not a string"
output-buffer))
(error 'make-input/output-port "~s is not a string" input-buffer))
(error 'make-input/output-port "~s is not a bytevector" input-buffer))
(error 'make-input/output-port "~s is not a procedure" handler))))
;;;
(define port-handler
@ -151,7 +152,7 @@
(if (input-port? p)
(if (fixnum? i)
(if ($fx>= i 0)
(if ($fx<= i (string-length ($port-input-buffer p)))
(if ($fx<= i ($bytevector-length ($port-input-buffer p)))
(begin
($set-port-input-index! p 0)
($set-port-input-size! p i))

28
src/ikarus.io-primitives.unsafe.ss
View File

@ -7,6 +7,8 @@
(ikarus)
(ikarus system $ports)
(ikarus system $strings)
(ikarus system $chars)
(ikarus system $bytevectors)
(ikarus system $fx))
(define $write-char
@ -22,27 +24,35 @@
(lambda (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))
(begin
(($port-handler p) 'read-char p))))))
(let ([b ($bytevector-u8-ref ($port-input-buffer p) idx)])
(cond
[($fx<= b 127)
($set-port-input-index! p ($fxadd1 idx))
($fixnum->char b)]
[else (($port-handler p) 'read-char p)]))
(($port-handler p) 'read-char p)))))
(define $peek-char
(lambda (p)
(let ([idx ($port-input-index p)])
(if ($fx< idx ($port-input-size p))
(string-ref ($port-input-buffer p) idx)
(let ([b ($bytevector-u8-ref ($port-input-buffer p) idx)])
(cond
[($fx<= b 127)
($fixnum->char b)]
[else (($port-handler p) 'peek-char p)]))
(($port-handler p) 'peek-char p)))))
(define $unread-char
(lambda (c p)
(let ([idx ($fxsub1 ($port-input-index p))])
(if (and ($fx>= idx 0)
(let ([idx ($fxsub1 ($port-input-index p))]
[b ($char->fixnum c)])
(if (and ($fx<= b 127)
($fx>= idx 0)
($fx< idx ($port-input-size p)))
(begin
($set-port-input-index! p idx)
(string-set! ($port-input-buffer p) idx c))
($bytevector-set! ($port-input-buffer p) idx b))
(($port-handler p) 'unread-char c p)))))
(define $reset-input-port!

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

@ -7,6 +7,7 @@
(ikarus system $io)
(ikarus system $fx)
(ikarus system $strings)
(ikarus system $bytevectors)
(ikarus system $chars)
(except (ikarus)
open-input-file current-input-port console-input-port
@ -45,7 +46,7 @@
(close-input-port p)
(close-ports))])))
(define make-input-file-handler
(define make-input-file-handler-old
(lambda (fd port-name)
(let ((open? #t))
(lambda (msg . args)
@ -118,6 +119,72 @@
(error 'input-file-handler
"message not handled ~s" (cons msg args))])))))
(define make-input-file-handler
(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)
@ -125,8 +192,8 @@
(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)
($make-bytevector 0))])
;(set-port-input-size! port 0)
(guardian port)
port)
(error 'open-input-file "cannot open ~s: ~a" filename fd/error)))))
@ -185,8 +252,8 @@
(set! *standard-input-port*
(let ([p (make-input-port
(make-input-file-handler 0 '*stdin*)
(make-string 4096))])
(set-port-input-size! p 0)
($make-bytevector 0))])
;(set-port-input-size! p 0)
p))
(set! *current-input-port* *standard-input-port*)
)

3
src/ikarus.io.input-strings.ss
View File

@ -3,6 +3,7 @@
(export open-input-string)
(import
(ikarus system $strings)
(ikarus system $bytevectors)
(ikarus system $fx)
(ikarus system $pairs)
(ikarus system $ports)
@ -72,7 +73,7 @@
(error 'open-input-string "~s is not a string" str))
(let ([port (make-input-port
(make-input-string-handler str)
"")])
($make-bytevector 0))])
port)))
)