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

* input ports now use bytevectors fully.

This commit is contained in:
Abdulaziz Ghuloum 2007-05-17 06:44:51 -04:00
parent 3148d7f95c
commit 52a28f8332
4 changed files with 100 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
bin/ikarus
View File

Binary file not shown.

36
bin/ikarus-runtime.c
View File

@ -783,21 +783,11 @@ ikrt_close_file(ikp fd, ikpcb* pcb){
}
}
static ikp
ikrt_read_to_string(ikp fd, ikp buff, ikpcb* pcb){
int bytes =
read(unfix(fd), string_data(buff), unfix(ref(buff, off_string_length)));
ikp fbytes = fix(bytes);
if (bytes == unfix(fbytes)){
return fbytes;
} else {
fprintf(stderr, "ERR: ikrt_read: too big\n");
ikp ikrt_read(ikp fd, ikp buff, ikpcb* pcb){
if(tagof(buff) != bytevector_tag){
fprintf(stderr, "%p is not a bytevector", buff);
exit(-1);
}
}
static ikp
ikrt_read_to_bytevector(ikp fd, ikp buff, ikpcb* pcb){
int bytes =
read(unfix(fd), buff+off_bytevector_data, unfix(ref(buff, off_bytevector_length)));
ikp fbytes = fix(bytes);
@ -809,26 +799,6 @@ ikrt_read_to_bytevector(ikp fd, ikp buff, ikpcb* pcb){
}
}
ikp ikrt_read(ikp fd, ikp buff, ikpcb* pcb){
if(tagof(buff) == string_tag){
return ikrt_read_to_string(fd,buff,pcb);
} else {
return ikrt_read_to_bytevector(fd,buff,pcb);
}
}
#if 0
if(bytes == -1){
fprintf(stderr, "ERR=%s (%d)\n", strerror(errno), errno);
return false_object;
} else {
return fix(bytes);
}
}
#endif
ikp
ikrt_open_input_file(ikp fname, ikpcb* pcb){

BIN
src/ikarus.boot
View File

Binary file not shown.

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

@ -46,6 +46,98 @@
(close-input-port p)
(close-ports))])))
(define read-multibyte-char
(lambda (p)
(error 'read-multibyte-char "not implemented")))
(define peek-multibyte-char
(lambda (p)
(error 'peek-multibyte-char "not implemented")))
(define unread-multibyte-char
(lambda (c p)
(error 'unread-multibyte-char "not implemented")))
(define make-input-file-handler
(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))
(let ([b ($bytevector-u8-ref ($port-input-buffer p) idx)])
(cond
[($fx< b 128)
($set-port-input-index! p ($fxadd1 idx))
($fixnum->char b)]
[else (read-multibyte-char p)]))
(if open?
(let ([bytes
(foreign-call "ikrt_read"
fd ($port-input-buffer p))])
(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))
(let ([b ($bytevector-u8-ref ($port-input-buffer p) idx)])
(cond
[($fx< b 128) ($fixnum->char b)]
[else (peek-multibyte-char p)]))
(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))]
[b (if (char? c)
($char->fixnum c)
(error 'unread-char "~s is not a char" c))])
(if (and ($fx>= idx 0)
($fx< idx ($port-input-size p)))
(cond
[($fx< b 128)
($set-port-input-index! p idx)]
[else (unread-multibyte-char c p)])
(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-old
(lambda (fd port-name)
(let ((open? #t))
@ -119,7 +211,7 @@
(error 'input-file-handler
"message not handled ~s" (cons msg args))])))))
(define make-input-file-handler
(define make-input-file-handler-trans
(lambda (fd port-name)
(let ([open? #t] [idx 0] [size 0] [buff (make-string 4096)])
(lambda (msg . args)
@ -192,8 +284,8 @@
(if (fixnum? fd/error)
(let ([port (make-input-port
(make-input-file-handler fd/error filename)
($make-bytevector 0))])
;(set-port-input-size! port 0)
($make-bytevector 4096))])
(set-port-input-size! port 0)
(guardian port)
port)
(error 'open-input-file "cannot open ~s: ~a" filename fd/error)))))
@ -252,8 +344,8 @@
(set! *standard-input-port*
(let ([p (make-input-port
(make-input-file-handler 0 '*stdin*)
($make-bytevector 0))])
;(set-port-input-size! p 0)
($make-bytevector 4096))])
(set-port-input-size! p 0)
p))
(set! *current-input-port* *standard-input-port*)
)