diff --git a/bin/ikarus b/bin/ikarus index 9cbe757..eaf427f 100755 Binary files a/bin/ikarus and b/bin/ikarus differ diff --git a/bin/ikarus-runtime.c b/bin/ikarus-runtime.c index 1bdeda7..f5cb3d2 100644 --- a/bin/ikarus-runtime.c +++ b/bin/ikarus-runtime.c @@ -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){ diff --git a/src/ikarus.boot b/src/ikarus.boot index 9bfe9bb..e176b31 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.io.input-files.ss b/src/ikarus.io.input-files.ss index 27c0870..e5f198b 100644 --- a/src/ikarus.io.input-files.ss +++ b/src/ikarus.io.input-files.ss @@ -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*) )