* input ports now use bytevectors fully.

bin/ikarus-runtime.c

@@ -783,21 +783,11 @@ ikrt_close_file(ikp fd, ikpcb* pcb){
   }
 }
 
-static ikp
+ikp ikrt_read(ikp fd, ikp buff, ikpcb* pcb){
-ikrt_read_to_string(ikp fd, ikp buff, ikpcb* pcb){
+  if(tagof(buff) != bytevector_tag){
-  int bytes =
+    fprintf(stderr, "%p is not a bytevector", buff);
-    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");
     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){

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))])
+                          ($make-bytevector 4096))])
-              ;(set-port-input-size! port 0)
+              (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))])
+               ($make-bytevector 4096))])
-      ;(set-port-input-size! p 0)
+      (set-port-input-size! p 0)
       p))
   (set! *current-input-port* *standard-input-port*)
   )