diff --git a/lib/.vimview/~=+Work=+ikarus-scheme=+lib=+libchezio.ss= b/lib/.vimview/~=+Work=+ikarus-scheme=+lib=+libchezio.ss=
index c4bd301..dff02e1 100644
--- a/lib/.vimview/~=+Work=+ikarus-scheme=+lib=+libchezio.ss=
+++ b/lib/.vimview/~=+Work=+ikarus-scheme=+lib=+libchezio.ss=
@@ -94,12 +94,12 @@ setlocal nowinfixwidth
 setlocal wrap
 setlocal wrapmargin=0
 silent! normal! zE
-let s:l = 678 - ((19 * winheight(0) + 17) / 34)
+let s:l = 3 - ((2 * winheight(0) + 15) / 31)
 if s:l < 1 | let s:l = 1 | endif
 exe s:l
 normal! zt
-678
-normal! 011l
+3
+normal! 0
 let &so = s:so_save | let &siso = s:siso_save
 doautoall SessionLoadPost
 " vim: set ft=vim :
diff --git a/lib/.vimview/~=+Work=+ikarus-scheme=+lib=+makefile.ss= b/lib/.vimview/~=+Work=+ikarus-scheme=+lib=+makefile.ss=
index 7469512..2ab4f57 100644
--- a/lib/.vimview/~=+Work=+ikarus-scheme=+lib=+makefile.ss=
+++ b/lib/.vimview/~=+Work=+ikarus-scheme=+lib=+makefile.ss=
@@ -94,12 +94,12 @@ setlocal nowinfixwidth
 setlocal wrap
 setlocal wrapmargin=0
 silent! normal! zE
-let s:l = 120 - ((0 * winheight(0) + 17) / 35)
+let s:l = 28 - ((15 * winheight(0) + 17) / 34)
 if s:l < 1 | let s:l = 1 | endif
 exe s:l
 normal! zt
-120
-normal! 0
+28
+normal! 034l
 let &so = s:so_save | let &siso = s:siso_save
 doautoall SessionLoadPost
 " vim: set ft=vim :
diff --git a/lib/ikarus.boot b/lib/ikarus.boot
index 3a9d686..3ad923b 100644
Binary files a/lib/ikarus.boot and b/lib/ikarus.boot differ
diff --git a/lib/libchezio.ss b/lib/libchezio.ss
index 454beea..5665376 100644
--- a/lib/libchezio.ss
+++ b/lib/libchezio.ss
@@ -1,733 +1,745 @@
-
-
 (let ()
-  ;;;
-  ;;; GENERIC PORTS: BASIC PRIMITIVES
-  ;;;
-  ;;; Exports: 
-  ;;; * Constructors:
-  ;;;   (make-input-port handler input-buffer)
-  ;;;   (make-output-port handler output-buffer)
-  ;;;   (make-input/output-port handler input-buffer output-buffer)
-  ;;;
-  ;;; * Predicates:
-  ;;;   (port? x)
-  ;;;   (input-port? x)
-  ;;;   (output-port? x)
-  ;;;
-  ;;; * Accessors:
-  ;;;   (port-handler port)
-  ;;;   (port-input-buffer port)
-  ;;;   (port-input-index port)
-  ;;;   (port-input-size port)
-  ;;;   (port-output-buffer port)
-  ;;;   (port-output-index port)
-  ;;;   (port-output-size port)
-  ;;;
-  ;;; * Mutators:
-  ;;;   (set-port-handler! port proc)
-  ;;;   (set-port-input-buffer! port string)
-  ;;;   (set-port-input-index! port fixnum)
-  ;;;   (set-port-input-size! port fixnum)
-  ;;;   (set-port-output-buffer! port string)
-  ;;;   (set-port-output-index! port fixnum)
-  ;;;   (set-port-output-size! port fixnum)
-  ;;;
-  (primitive-set! 'port?
-    (lambda (x) (port? x)))
-  ;;;
-  (primitive-set! 'input-port?
-    (lambda (x) (input-port? x)))
-  ;;;
-  (primitive-set! 'output-port?
-    (lambda (x) (output-port? x)))
-  ;;;
-  (primitive-set! '$make-input-port
-    (lambda (handler buffer)
-      ($make-port/input handler buffer 0 ($string-length buffer) #f 0 0)))
-  ;;;
-  (primitive-set! 'make-input-port
-    (lambda (handler buffer)
-      (if (procedure? handler)
-          (if (string? buffer)
-              ($make-input-port handler buffer)
-              (error 'make-input-port "~s is not a string" buffer))
-          (error 'make-input-port "~s is not a procedure" handler))))
-  ;;;
-  (primitive-set! '$make-output-port
-    (lambda (handler buffer)
-      ($make-port/output handler #f 0 0 buffer 0 ($string-length buffer))))
-  ;;;
-  (primitive-set! 'make-output-port
-    (lambda (handler buffer)
-      (if (procedure? handler)
-          (if (string? buffer)
-              ($make-output-port handler buffer)
-              (error 'make-output-port "~s is not a string" buffer))
-          (error 'make-output-port "~s is not a procedure" handler))))
-  ;;;
-  (primitive-set! '$make-input/output-port
-    (lambda (handler input-buffer output-buffer)
-       ($make-port/both handler
-                  input-buffer 0 ($string-length input-buffer)
-                  output-buffer 0 ($string-length output-buffer))))
-  (primitive-set! 'make-input/output-port
-    (lambda (handler input-buffer output-buffer)
-      (if (procedure? handler)
-          (if (string? 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 procedure" handler))))
-  ;;;
-  (primitive-set! '$port-handler
-    (lambda (x) ($port-handler x)))
-  ;;;
-  (primitive-set! 'port-handler
-    (lambda (x)
-      (if (port? x)
-          ($port-handler x)
-          (error 'port-handler "~s is not a port" x))))
-  ;;;
-  (primitive-set! '$port-input-buffer
-    (lambda (x) ($port-input-buffer x)))
-  ;;;
-  (primitive-set! 'port-input-buffer
-    (lambda (x)
-      (if (input-port? x)
-          ($port-input-buffer x)
-          (error 'port-input-buffer "~s is not an input-port" x))))
-  ;;;
-  (primitive-set! '$port-input-index
-    (lambda (x) ($port-input-index x)))
-  ;;;
-  (primitive-set! 'port-input-index
-    (lambda (x)
-      (if (input-port? x)
-          ($port-input-index x)
-          (error 'port-input-index "~s is not an input-port" x))))
-  ;;;
-  (primitive-set! '$port-input-size
-    (lambda (x) ($port-input-size x)))
-  ;;;
-  (primitive-set! 'port-input-size
-    (lambda (x)
-      (if (input-port? x)
-          ($port-input-size x)
-          (error 'port-input-size "~s is not an input-port" x))))
-  ;;;
-  (primitive-set! '$port-output-buffer
-    (lambda (x) ($port-output-buffer x)))
-  ;;;
-  (primitive-set! 'port-output-buffer
-    (lambda (x)
-      (if (output-port? x)
-          ($port-output-buffer x)
-          (error 'port-output-buffer "~s is not an output-port" x))))
-  ;;;
-  (primitive-set! '$port-output-index
-    (lambda (x) ($port-output-index x)))
-  ;;;
-  (primitive-set! 'port-output-index
-    (lambda (x)
-      (if (output-port? x)
-          ($port-output-index x)
-          (error 'port-output-index "~s is not an output-port" x))))
-  ;;;
-  (primitive-set! '$port-output-size
-    (lambda (x) ($port-output-size x)))
-  ;;;
-  (primitive-set! 'port-output-size
-    (lambda (x)
-      (if (output-port? x)
-          ($port-output-size x)
-          (error 'port-output-size "~s is not an output-port" x))))
-  ;;;
-  (primitive-set! '$set-port-input-index!
-    (lambda (p i) ($set-port-input-index! p i)))
-  ;;;
-  (primitive-set! 'set-port-input-index!
-    (lambda (p i)
-      (if (input-port? p)
-          (if (fixnum? i)
-              (if ($fx>= i 0)
-                  (if ($fx<= i ($port-input-size p))
-                      ($set-port-input-index! p i)
-                      (error 'set-port-input-index! "index ~s is too big" i))
-                  (error 'set-port-input-index! "index ~s is negative" i))
-              (error 'set-port-input-index! "~s is not a valid index" i))
-          (error 'set-port-input-index! "~s is not an input-port" p))))
-  ;;;
-  (primitive-set! '$set-port-input-size!
-    (lambda (p i) 
-      ($set-port-input-index! p 0)
-      ($set-port-input-size! p i)))
-  ;;;
-  (primitive-set! 'set-port-input-size!
-    (lambda (p i)
-      (if (input-port? p)
-          (if (fixnum? i)
-              (if ($fx>= i 0)
-                  (if ($fx<= i ($string-length ($port-input-buffer p)))
-                      (begin
-                        ($set-port-input-index! p 0)
-                        ($set-port-input-size! p i))
-                      (error 'set-port-input-size! "size ~s is too big" i))
-                  (error 'set-port-input-size! "size ~s is negative" i))
-              (error 'set-port-input-size! "~s is not a valid size" i))
-          (error 'set-port-input-size! "~s is not an input-port" p))))
-  ;;;
-  (primitive-set! '$set-port-output-index!
-    (lambda (p i) ($set-port-output-index! p i)))
-  ;;;
-  (primitive-set! 'set-port-output-index!
-    (lambda (p i)
-      (if (output-port? p)
-          (if (fixnum? i)
-              (if ($fx>= i 0)
-                  (if ($fx<= i ($port-output-size p))
-                      ($set-port-output-index! p i)
-                      (error 'set-port-output-index! "index ~s is too big" i))
-                  (error 'set-port-output-index! "index ~s is negative" i))
-              (error 'set-port-output-index! "~s is not a valid index" i))
-          (error 'set-port-output-index! "~s is not an output-port" p))))
-  ;;;
-  (primitive-set! '$set-port-output-size!
-    (lambda (p i) 
-      ($set-port-output-index! p 0)
-      ($set-port-output-size! p i)))
-  ;;;
-  (primitive-set! 'set-port-output-size!
-    (lambda (p i)
-      (if (output-port? p)
-          (if (fixnum? i)
-              (if ($fx>= i 0)
-                  (if ($fx<= i ($string-length ($port-output-buffer p)))
-                      (begin
-                        ($set-port-output-index! p 0)
-                        ($set-port-output-size! p i))
-                      (error 'set-port-output-size! "size ~s is too big" i))
-                  (error 'set-port-output-size! "size ~s is negative" i))
-              (error 'set-port-output-size! "~s is not a valid size" i))
-          (error 'set-port-output-size! "~s is not an output-port" p)))))
-
-
-(let ()
-  ;;; IO PRIMITIVES
-  ;;;
-  (primitive-set! '$write-char
-    (lambda (c p)
-      (let ([idx (port-output-index p)])
-        (if ($fx< idx ($port-output-size p))
-            (begin
-              ($string-set! ($port-output-buffer p) idx c)
-              ($set-port-output-index! p ($fxadd1 idx)))
-            (($port-handler p) 'write-char c p)))))
-  ;;;
-  (primitive-set! 'write-char
-    (case-lambda
-      [(c)
-       (if (char? c)
-           ($write-char c (current-output-port))
-           (error 'write-char "~s is not a character" c))]
-      [(c p)
-       (if (char? c)
-           (if (output-port? p)
-               ($write-char c p)
-               (error 'write-char "~s is not an output-port" p))
-           (error 'write-char "~s is not a character" c))]))
-  ;;;
-  (primitive-set! 'newline
-    (case-lambda
-      [() 
-       ($write-char #\newline (current-output-port))
-       ($flush-output-port (current-output-port))]
-      [(p) 
-       (if (output-port? p)
-           (begin
-             ($write-char #\newline p)
-             ($flush-output-port p))
-           (error 'newline "~s is not an output port" p))]))
-  ;;;
-  (primitive-set! 'port-name
-    (lambda (p)
-      (if (port? p) 
-          (($port-handler p) 'port-name p)
-          (error 'port-name "~s is not a port" p))))
-  (primitive-set! 'input-port-name port-name)
-  (primitive-set! 'output-port-name port-name)
-  (primitive-set! '$read-char
-    (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))))))
-  ;;;
-  (primitive-set! 'read-char
-    (case-lambda
-      [() ($read-char *current-input-port*)]
-      [(p)
-       (if (input-port? p)
-           ($read-char p)
-           (error 'read-char "~s is not an input-port" p))]))
-  ;;;
-  (primitive-set! '$unread-char
-    (lambda (c 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))
-            (($port-handler p) 'unread-char c p)))))
-  ;;;
-  (primitive-set! 'unread-char
-    (case-lambda
-      [(c) (if (char? c)
-               ($unread-char c (current-input-port))
-               (error 'unread-char "~s is not a character" c))]
-      [(c p)
-       (if (input-port? p)
-           (if (char? c)
-               ($unread-char c p)
-               (error 'unread-char "~s is not a character" c))
-           (error 'unread-char "~s is not an input-port" p))]))
-  ;;;
-  (primitive-set! '$peek-char
-    (lambda (p)
-      (let ([idx ($port-input-index p)])
-        (if ($fx< idx ($port-input-size p))
-            ($string-ref ($port-input-buffer p) idx)
-            (($port-handler p) 'peek-char p)))))
-  ;;;
-  (primitive-set! 'peek-char
-    (case-lambda
-      [() ($peek-char (current-input-port))]
-      [(p)
-       (if (input-port? p)
-           ($peek-char p)
-           (error 'peek-char "~s is not an input-port" p))]))
-  ;;;
-  (primitive-set! '$unread-char
-    (lambda (c 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))
-            (($port-handler p) 'unread-char c p)))))
-  ;;;
-  (primitive-set! '$reset-input-port!
-    (lambda (p)
-      ($set-port-input-size! p 0)))
-  ;;;
-  (primitive-set! 'reset-input-port!
-    (case-lambda
-      [() ($reset-input-port! (current-input-port))]
-      [(p)
-       (if (input-port? p)
-           ($reset-input-port! p)
-           (error 'reset-input-port! "~s is not an input-port" p))]))
-  ;;;
-  (primitive-set! '$close-input-port
-    (lambda (p)
-      (($port-handler p) 'close-port p)))
-  ;;;
-  (primitive-set! 'close-input-port
-    (case-lambda
-      [() ($close-input-port (current-input-port))]
-      [(p)
-       (if (input-port? p)
-           ($close-input-port p)
-           (error 'close-input-port! "~s is not an input-port" p))]))
-  ;;;
-  (primitive-set! '$close-output-port
-    (lambda (p)
-      (($port-handler p) 'close-port p)))
-  ;;;
-  (primitive-set! 'close-output-port
-    (case-lambda
-      [() ($close-output-port (current-output-port))]
-      [(p)
-       (if (output-port? p)
-           ($close-output-port p)
-           (error 'close-output-port "~s is not an output-port" p))]))
-  ;;;
-  (primitive-set! '$flush-output-port
-    (lambda (p)
-      (($port-handler p) 'flush-output-port p)))
-  ;;;
-  (primitive-set! 'flush-output-port
-    (case-lambda
-      [() ($flush-output-port (current-output-port))]
-      [(p)
-       (if (output-port? p)
-           ($flush-output-port p)
-           (error 'flush-output-port "~s is not an output-port" p))])))
-
-(let ()
-  ;;; INPUT FILES
-  (include "message-case.ss")
-  (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))
-                   (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))])
-                         (cond
-                           [(not bytes)
-                            (error 'read-char "Cannot read from ~s" port-name)]
-                           [($fx= bytes 0)
-                            (eof-object)]
-                           [else
-                            ($set-port-input-size! p bytes)
-                            ($read-char p)]))
-                       (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 open-input-file
-    (lambda (filename)
-      (let ([fd/error (foreign-call "ikrt_open_input_file" filename)])
-        (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)
-              port)
-            (error 'open-input-file "cannot open ~s: ~a" filename fd/error)))))
-  (primitive-set! '*standard-input-port* 
-    (let ([p (make-input-port 
-               (make-input-file-handler 0 '*stdin*)
-               (make-string 4096))])
-      (set-port-input-size! p 0)
-      p))
-  (primitive-set! 'console-input-port (lambda () *standard-input-port*))
-  (primitive-set! '*current-input-port* *standard-input-port*)
-  (primitive-set! 'current-input-port 
-    (case-lambda
-      [() *current-input-port*]
-      [(p) 
-       (if (input-port? p)
-           (primitive-set! '*current-input-port* p)
-           (error 'current-input-port "~s is not an input-port" p))]))
-  (primitive-set! 'open-input-file
-    (lambda (filename)
-       (if (string? filename)
-           (open-input-file filename)
-           (error 'open-input-file "~s is not a string" filename)))))
-
-
-(let ()
-  ;;; OUTPUT FILES
-  (include "message-case.ss")
-  (define do-write-buffer
-    (lambda (fd port-name p caller)
-      (let ([bytes (foreign-call "ikrt_write_file" 
-                                 fd
-                                 (port-output-buffer p)
-                                 (port-output-index p))])
-        (if (fixnum? bytes)
-            (set-port-output-index! p 0)
-            (error caller "cannot write to file ~s: ~a" port-name bytes)))))
-  (define make-output-file-handler
-    (lambda (fd port-name)
-      (define open? #t)
-      (define output-file-handler
-        (lambda (msg . args)
-          (message-case msg args
-            [(write-char c p)
-             (if (char? c)
-                 (if (output-port? p)
-                     (let ([idx ($port-output-index p)])
-                        (if ($fx< idx ($port-output-size p))
-                            (begin
-                              ($string-set! ($port-output-buffer p) idx c)
-                              ($set-port-output-index! p ($fxadd1 idx)))
-                            (if open?
-                              (begin
-                                (do-write-buffer fd port-name p 'write-char)
-                                ($write-char c p))
-                              (error 'write-char "port ~s is closed" p))))
-                     (error 'write-char "~s is not an output-port" p))
-                 (error 'write-char "~s is not a character" c))]
-            [(flush-output-port p)
-             (if (output-port? p)
-                 (if open?
-                     (do-write-buffer fd port-name p 'flush-output-port)
-                     (error 'flush-output-port "port ~s is closed" p))
-                 (error 'flush-output-port "~s is not an output-port" p))]
-            [(close-port p)
-             (when open?
-               (flush-output-port p)
-               ($set-port-output-size! p 0)
-               (set! open? #f)
-               (unless (foreign-call "ikrt_close_file" fd)
-                 (error 'close-output-port "cannot close ~s" port-name)))]
-            [(port-name p) port-name]
-            [else (error 'output-file-handler 
-                         "unhandled message ~s" (cons msg args))])))
-      output-file-handler))
-  (define (option-id x)
-    (case x
-      [(error)    0]
-      [(replace)  1]
-      [(truncate) 2]
-      [(append)   3]
-      [else (error 'open-output-file "~s is not a valid mode" x)]))
-  (define open-output-file
-    (lambda (filename options)
-      (let ([fd/error 
-             (foreign-call "ikrt_open_output_file" 
-                           filename 
-                           (option-id options))])
-        (if (fixnum? fd/error)
-            (make-output-port
-              (make-output-file-handler fd/error filename)
-              (make-string 4096))
-            (error 'open-output-file "cannot open ~s: ~a" filename fd/error)))))
-  (primitive-set! '*standard-output-port* 
-    (make-output-port
-      (make-output-file-handler 1 '*stdout*)
-      (make-string 4096)))
-  (primitive-set! '*current-output-port* *standard-output-port*)
-  (primitive-set! '*standard-error-port* 
-    (make-output-port
-      (make-output-file-handler 2 '*stderr*)
-      (make-string 4096)))
-  (primitive-set! 'standard-output-port 
-     (lambda () *standard-output-port*))
-  (primitive-set! 'standard-error-port
-     (lambda () *standard-error-port*))
-  (primitive-set! 'console-output-port 
-     (lambda () *standard-output-port*))
-  (primitive-set! 'current-output-port 
-     (case-lambda
-       [() *current-output-port*]
-       [(p)
+  (define-syntax message-case
+    (syntax-rules  (else)
+      [(_ msg args 
+          [(msg-name msg-arg* ...) b b* ...] ... 
+          [else else1 else2 ...])
+       (let ([tmsg msg] [targs args])
+         (define-syntax match-and-bind
+           (syntax-rules ()
+             [(__ y () body)
+              (if (null? y) 
+                  body
+                  (error 'message-case "unmatched ~s" (cons tmsg targs)))]
+             [(__ y (a a* (... ...)) body)
+              (if (pair? y)
+                  (let ([a (car y)] [d (cdr y)])
+                    (match-and-bind d (a* (... ...)) body))
+                  (error 'message-case "unmatched ~s" (cons tmsg targs)))]))
+         (case tmsg
+           [(msg-name) 
+            (match-and-bind targs (msg-arg* ...) (begin b b* ...))] ...
+           [else else1 else2 ...]))]))
+  
+  (let () ;;; GENERIC PORTS: BASIC PRIMITIVES
+    ;;;
+    ;;; Exports: 
+    ;;; * Constructors:
+    ;;;   (make-input-port handler input-buffer)
+    ;;;   (make-output-port handler output-buffer)
+    ;;;   (make-input/output-port handler input-buffer output-buffer)
+    ;;;
+    ;;; * Predicates:
+    ;;;   (port? x)
+    ;;;   (input-port? x)
+    ;;;   (output-port? x)
+    ;;;
+    ;;; * Accessors:
+    ;;;   (port-handler port)
+    ;;;   (port-input-buffer port)
+    ;;;   (port-input-index port)
+    ;;;   (port-input-size port)
+    ;;;   (port-output-buffer port)
+    ;;;   (port-output-index port)
+    ;;;   (port-output-size port)
+    ;;;
+    ;;; * Mutators:
+    ;;;   (set-port-handler! port proc)
+    ;;;   (set-port-input-buffer! port string)
+    ;;;   (set-port-input-index! port fixnum)
+    ;;;   (set-port-input-size! port fixnum)
+    ;;;   (set-port-output-buffer! port string)
+    ;;;   (set-port-output-index! port fixnum)
+    ;;;   (set-port-output-size! port fixnum)
+    ;;;
+    (primitive-set! 'port?
+      (lambda (x) (port? x)))
+    ;;;
+    (primitive-set! 'input-port?
+      (lambda (x) (input-port? x)))
+    ;;;
+    (primitive-set! 'output-port?
+      (lambda (x) (output-port? x)))
+    ;;;
+    (primitive-set! '$make-input-port
+      (lambda (handler buffer)
+        ($make-port/input handler buffer 0 ($string-length buffer) #f 0 0)))
+    ;;;
+    (primitive-set! 'make-input-port
+      (lambda (handler buffer)
+        (if (procedure? handler)
+            (if (string? buffer)
+                ($make-input-port handler buffer)
+                (error 'make-input-port "~s is not a string" buffer))
+            (error 'make-input-port "~s is not a procedure" handler))))
+    ;;;
+    (primitive-set! '$make-output-port
+      (lambda (handler buffer)
+        ($make-port/output handler #f 0 0 buffer 0 ($string-length buffer))))
+    ;;;
+    (primitive-set! 'make-output-port
+      (lambda (handler buffer)
+        (if (procedure? handler)
+            (if (string? buffer)
+                ($make-output-port handler buffer)
+                (error 'make-output-port "~s is not a string" buffer))
+            (error 'make-output-port "~s is not a procedure" handler))))
+    ;;;
+    (primitive-set! '$make-input/output-port
+      (lambda (handler input-buffer output-buffer)
+         ($make-port/both handler
+                    input-buffer 0 ($string-length input-buffer)
+                    output-buffer 0 ($string-length output-buffer))))
+    (primitive-set! 'make-input/output-port
+      (lambda (handler input-buffer output-buffer)
+        (if (procedure? handler)
+            (if (string? 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 procedure" handler))))
+    ;;;
+    (primitive-set! '$port-handler
+      (lambda (x) ($port-handler x)))
+    ;;;
+    (primitive-set! 'port-handler
+      (lambda (x)
+        (if (port? x)
+            ($port-handler x)
+            (error 'port-handler "~s is not a port" x))))
+    ;;;
+    (primitive-set! '$port-input-buffer
+      (lambda (x) ($port-input-buffer x)))
+    ;;;
+    (primitive-set! 'port-input-buffer
+      (lambda (x)
+        (if (input-port? x)
+            ($port-input-buffer x)
+            (error 'port-input-buffer "~s is not an input-port" x))))
+    ;;;
+    (primitive-set! '$port-input-index
+      (lambda (x) ($port-input-index x)))
+    ;;;
+    (primitive-set! 'port-input-index
+      (lambda (x)
+        (if (input-port? x)
+            ($port-input-index x)
+            (error 'port-input-index "~s is not an input-port" x))))
+    ;;;
+    (primitive-set! '$port-input-size
+      (lambda (x) ($port-input-size x)))
+    ;;;
+    (primitive-set! 'port-input-size
+      (lambda (x)
+        (if (input-port? x)
+            ($port-input-size x)
+            (error 'port-input-size "~s is not an input-port" x))))
+    ;;;
+    (primitive-set! '$port-output-buffer
+      (lambda (x) ($port-output-buffer x)))
+    ;;;
+    (primitive-set! 'port-output-buffer
+      (lambda (x)
+        (if (output-port? x)
+            ($port-output-buffer x)
+            (error 'port-output-buffer "~s is not an output-port" x))))
+    ;;;
+    (primitive-set! '$port-output-index
+      (lambda (x) ($port-output-index x)))
+    ;;;
+    (primitive-set! 'port-output-index
+      (lambda (x)
+        (if (output-port? x)
+            ($port-output-index x)
+            (error 'port-output-index "~s is not an output-port" x))))
+    ;;;
+    (primitive-set! '$port-output-size
+      (lambda (x) ($port-output-size x)))
+    ;;;
+    (primitive-set! 'port-output-size
+      (lambda (x)
+        (if (output-port? x)
+            ($port-output-size x)
+            (error 'port-output-size "~s is not an output-port" x))))
+    ;;;
+    (primitive-set! '$set-port-input-index!
+      (lambda (p i) ($set-port-input-index! p i)))
+    ;;;
+    (primitive-set! 'set-port-input-index!
+      (lambda (p i)
+        (if (input-port? p)
+            (if (fixnum? i)
+                (if ($fx>= i 0)
+                    (if ($fx<= i ($port-input-size p))
+                        ($set-port-input-index! p i)
+                        (error 'set-port-input-index! "index ~s is too big" i))
+                    (error 'set-port-input-index! "index ~s is negative" i))
+                (error 'set-port-input-index! "~s is not a valid index" i))
+            (error 'set-port-input-index! "~s is not an input-port" p))))
+    ;;;
+    (primitive-set! '$set-port-input-size!
+      (lambda (p i) 
+        ($set-port-input-index! p 0)
+        ($set-port-input-size! p i)))
+    ;;;
+    (primitive-set! 'set-port-input-size!
+      (lambda (p i)
+        (if (input-port? p)
+            (if (fixnum? i)
+                (if ($fx>= i 0)
+                    (if ($fx<= i ($string-length ($port-input-buffer p)))
+                        (begin
+                          ($set-port-input-index! p 0)
+                          ($set-port-input-size! p i))
+                        (error 'set-port-input-size! "size ~s is too big" i))
+                    (error 'set-port-input-size! "size ~s is negative" i))
+                (error 'set-port-input-size! "~s is not a valid size" i))
+            (error 'set-port-input-size! "~s is not an input-port" p))))
+    ;;;
+    (primitive-set! '$set-port-output-index!
+      (lambda (p i) ($set-port-output-index! p i)))
+    ;;;
+    (primitive-set! 'set-port-output-index!
+      (lambda (p i)
         (if (output-port? p)
-            (primitive-set! '*current-output-port* p)
-            (error 'current-output-port "~s is not an output port" p))]))
-  (primitive-set! 'open-output-file 
-    (case-lambda
-      [(filename)
-       (if (string? filename)
-           (open-output-file filename 'error)
-           (error 'open-output-file "~s is not a string" filename))]
-      [(filename options)
-       (if (string? filename)
-           (open-output-file filename options)
-           (error 'open-output-file "~s is not a string" filename))])))
-
-
-(let ()
-  (include "message-case.ss")
-  ;;; OUTPUT STRINGS
-  (define string-copy 
-    (lambda (s)
-      (substring s 0 (string-length s))))
-  (define concat 
-    (lambda (str i ls)
-      (let ([n (sum i ls)])
-        (let ([outstr ($make-string n)])
-          (let f ([n (copy outstr str i n)] [ls ls])
-            (if (null? ls)
-                outstr
-                (let ([a ($car ls)])
-                  (f (copy outstr a ($string-length a) n) ($cdr ls)))))))))
-  (define sum 
-    (lambda (ac ls)
-      (cond
-        [(null? ls) ac]
-        [else (sum ($fx+ ac ($string-length ($car ls))) ($cdr ls))])))
-  (define copy
-    (lambda (dst src n end)
-      (let f ([di end]
-              [si n])
-        (cond
-          [($fx= si 0) di]
-          [else
-           (let ([di ($fxsub1 di)] [si ($fxsub1 si)])
-             ($string-set! dst di ($string-ref src si))
-             (f di si))]))))
-  (define make-output-string-handler
-    (lambda ()
-      (define buffer-list '())
-      (define open? #t)
-      (define output-handler
-        (lambda (msg . args)
-          (message-case msg args
-            [(write-char c p)
+            (if (fixnum? i)
+                (if ($fx>= i 0)
+                    (if ($fx<= i ($port-output-size p))
+                        ($set-port-output-index! p i)
+                        (error 'set-port-output-index! "index ~s is too big" i))
+                    (error 'set-port-output-index! "index ~s is negative" i))
+                (error 'set-port-output-index! "~s is not a valid index" i))
+            (error 'set-port-output-index! "~s is not an output-port" p))))
+    ;;;
+    (primitive-set! '$set-port-output-size!
+      (lambda (p i) 
+        ($set-port-output-index! p 0)
+        ($set-port-output-size! p i)))
+    ;;;
+    (primitive-set! 'set-port-output-size!
+      (lambda (p i)
+        (if (output-port? p)
+            (if (fixnum? i)
+                (if ($fx>= i 0)
+                    (if ($fx<= i ($string-length ($port-output-buffer p)))
+                        (begin
+                          ($set-port-output-index! p 0)
+                          ($set-port-output-size! p i))
+                        (error 'set-port-output-size! "size ~s is too big" i))
+                    (error 'set-port-output-size! "size ~s is negative" i))
+                (error 'set-port-output-size! "~s is not a valid size" i))
+            (error 'set-port-output-size! "~s is not an output-port" p)))))
+  
+  (let () ;;; IO PRIMITIVES
+    ;;;
+    (primitive-set! '$write-char
+      (lambda (c p)
+        (let ([idx (port-output-index p)])
+          (if ($fx< idx ($port-output-size p))
+              (begin
+                ($string-set! ($port-output-buffer p) idx c)
+                ($set-port-output-index! p ($fxadd1 idx)))
+              (($port-handler p) 'write-char c p)))))
+    ;;;
+    (primitive-set! 'write-char
+      (case-lambda
+        [(c)
+         (if (char? c)
+             ($write-char c (current-output-port))
+             (error 'write-char "~s is not a character" c))]
+        [(c p)
+         (if (char? c)
+             (if (output-port? p)
+                 ($write-char c p)
+                 (error 'write-char "~s is not an output-port" p))
+             (error 'write-char "~s is not a character" c))]))
+    ;;;
+    (primitive-set! 'newline
+      (case-lambda
+        [() 
+         ($write-char #\newline (current-output-port))
+         ($flush-output-port (current-output-port))]
+        [(p) 
+         (if (output-port? p)
+             (begin
+               ($write-char #\newline p)
+               ($flush-output-port p))
+             (error 'newline "~s is not an output port" p))]))
+    ;;;
+    (primitive-set! 'port-name
+      (lambda (p)
+        (if (port? p) 
+            (($port-handler p) 'port-name p)
+            (error 'port-name "~s is not a port" p))))
+    (primitive-set! 'input-port-name port-name)
+    (primitive-set! 'output-port-name port-name)
+    (primitive-set! '$read-char
+      (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))))))
+    ;;;
+    (primitive-set! 'read-char
+      (case-lambda
+        [() ($read-char *current-input-port*)]
+        [(p)
+         (if (input-port? p)
+             ($read-char p)
+             (error 'read-char "~s is not an input-port" p))]))
+    ;;;
+    (primitive-set! '$unread-char
+      (lambda (c 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))
+              (($port-handler p) 'unread-char c p)))))
+    ;;;
+    (primitive-set! 'unread-char
+      (case-lambda
+        [(c) (if (char? c)
+                 ($unread-char c (current-input-port))
+                 (error 'unread-char "~s is not a character" c))]
+        [(c p)
+         (if (input-port? p)
              (if (char? c)
-                 (if (output-port? p)
-                     (let ([idx ($port-output-index p)])
-                        (if ($fx< idx ($port-output-size p))
-                            (begin
-                              ($string-set! ($port-output-buffer p) idx c)
-                              ($set-port-output-index! p ($fxadd1 idx)))
-                            (if open?
+                 ($unread-char c p)
+                 (error 'unread-char "~s is not a character" c))
+             (error 'unread-char "~s is not an input-port" p))]))
+    ;;;
+    (primitive-set! '$peek-char
+      (lambda (p)
+        (let ([idx ($port-input-index p)])
+          (if ($fx< idx ($port-input-size p))
+              ($string-ref ($port-input-buffer p) idx)
+              (($port-handler p) 'peek-char p)))))
+    ;;;
+    (primitive-set! 'peek-char
+      (case-lambda
+        [() ($peek-char (current-input-port))]
+        [(p)
+         (if (input-port? p)
+             ($peek-char p)
+             (error 'peek-char "~s is not an input-port" p))]))
+    ;;;
+    (primitive-set! '$unread-char
+      (lambda (c 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))
+              (($port-handler p) 'unread-char c p)))))
+    ;;;
+    (primitive-set! '$reset-input-port!
+      (lambda (p)
+        ($set-port-input-size! p 0)))
+    ;;;
+    (primitive-set! 'reset-input-port!
+      (case-lambda
+        [() ($reset-input-port! (current-input-port))]
+        [(p)
+         (if (input-port? p)
+             ($reset-input-port! p)
+             (error 'reset-input-port! "~s is not an input-port" p))]))
+    ;;;
+    (primitive-set! '$close-input-port
+      (lambda (p)
+        (($port-handler p) 'close-port p)))
+    ;;;
+    (primitive-set! 'close-input-port
+      (case-lambda
+        [() ($close-input-port (current-input-port))]
+        [(p)
+         (if (input-port? p)
+             ($close-input-port p)
+             (error 'close-input-port! "~s is not an input-port" p))]))
+    ;;;
+    (primitive-set! '$close-output-port
+      (lambda (p)
+        (($port-handler p) 'close-port p)))
+    ;;;
+    (primitive-set! 'close-output-port
+      (case-lambda
+        [() ($close-output-port (current-output-port))]
+        [(p)
+         (if (output-port? p)
+             ($close-output-port p)
+             (error 'close-output-port "~s is not an output-port" p))]))
+    ;;;
+    (primitive-set! '$flush-output-port
+      (lambda (p)
+        (($port-handler p) 'flush-output-port p)))
+    ;;;
+    (primitive-set! 'flush-output-port
+      (case-lambda
+        [() ($flush-output-port (current-output-port))]
+        [(p)
+         (if (output-port? p)
+             ($flush-output-port p)
+             (error 'flush-output-port "~s is not an output-port" p))])))
+  
+  (let () ;;; INPUT FILES
+    ;;;
+    (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))
+                     (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))])
+                           (cond
+                             [(not bytes)
+                              (error 'read-char "Cannot read from ~s" port-name)]
+                             [($fx= bytes 0)
+                              (eof-object)]
+                             [else
+                              ($set-port-input-size! p bytes)
+                              ($read-char p)]))
+                         (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 open-input-file
+      (lambda (filename)
+        (let ([fd/error (foreign-call "ikrt_open_input_file" filename)])
+          (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)
+                port)
+              (error 'open-input-file "cannot open ~s: ~a" filename fd/error)))))
+    (primitive-set! '*standard-input-port* 
+      (let ([p (make-input-port 
+                 (make-input-file-handler 0 '*stdin*)
+                 (make-string 4096))])
+        (set-port-input-size! p 0)
+        p))
+    (primitive-set! 'console-input-port (lambda () *standard-input-port*))
+    (primitive-set! '*current-input-port* *standard-input-port*)
+    (primitive-set! 'current-input-port 
+      (case-lambda
+        [() *current-input-port*]
+        [(p) 
+         (if (input-port? p)
+             (primitive-set! '*current-input-port* p)
+             (error 'current-input-port "~s is not an input-port" p))]))
+    (primitive-set! 'open-input-file
+      (lambda (filename)
+         (if (string? filename)
+             (open-input-file filename)
+             (error 'open-input-file "~s is not a string" filename)))))
+  
+  (let () ;;; OUTPUT FILES
+    ;;;
+    (define do-write-buffer
+      (lambda (fd port-name p caller)
+        (let ([bytes (foreign-call "ikrt_write_file" 
+                                   fd
+                                   (port-output-buffer p)
+                                   (port-output-index p))])
+          (if (fixnum? bytes)
+              (set-port-output-index! p 0)
+              (error caller "cannot write to file ~s: ~a" port-name bytes)))))
+    (define make-output-file-handler
+      (lambda (fd port-name)
+        (define open? #t)
+        (define output-file-handler
+          (lambda (msg . args)
+            (message-case msg args
+              [(write-char c p)
+               (if (char? c)
+                   (if (output-port? p)
+                       (let ([idx ($port-output-index p)])
+                          (if ($fx< idx ($port-output-size p))
                               (begin
-                                (set! buffer-list
-                                  (cons (string-copy (port-output-buffer p))
-                                        buffer-list))
-                                ($set-port-output-size! p 
-                                  ($string-length ($port-output-buffer p)))
-                                ($write-char c p))
-                              (error 'write-char "port ~s is closed" p))))
-                     (error 'write-char "~s is not an output-port" p))
-                 (error 'write-char "~s is not a character" c))]
-            [(flush-output-port p)
-             (void)]
-            [(close-port p)
-             (set! open? #f)]
-            [(port-name p) 'string-port]
-            [(get-output-string p) 
-             (concat ($port-output-buffer p)
-                     ($port-output-index p)
-                     buffer-list)]
-            [else (error 'output-handler 
-                         "unhandled message ~s" (cons msg args))])))
-      output-handler))
-  (primitive-set! 'open-output-string 
-    (lambda ()
-      (make-output-port 
-        (make-output-string-handler)
-        (make-string 10))))
-  (primitive-set! 'get-output-string
-    (lambda (p)
-      (if (output-port? p)
-          (($port-handler p) 'get-output-string p)
-          (error 'get-output-string "~s is not an output port" p))))
-)
-
-(primitive-set! 'with-output-to-file
-   (lambda (name proc . args)
-     (unless (string? name) 
-       (error 'with-output-to-file "~s is not a string" name))
-     (unless (procedure? proc)
-       (error 'with-output-to-file "~s is not a procedure" proc))
-     (let ([p (apply open-output-file name args)]
-           [shot #f])
-       (parameterize ([current-output-port p])
+                                ($string-set! ($port-output-buffer p) idx c)
+                                ($set-port-output-index! p ($fxadd1 idx)))
+                              (if open?
+                                (begin
+                                  (do-write-buffer fd port-name p 'write-char)
+                                  ($write-char c p))
+                                (error 'write-char "port ~s is closed" p))))
+                       (error 'write-char "~s is not an output-port" p))
+                   (error 'write-char "~s is not a character" c))]
+              [(flush-output-port p)
+               (if (output-port? p)
+                   (if open?
+                       (do-write-buffer fd port-name p 'flush-output-port)
+                       (error 'flush-output-port "port ~s is closed" p))
+                   (error 'flush-output-port "~s is not an output-port" p))]
+              [(close-port p)
+               (when open?
+                 (flush-output-port p)
+                 ($set-port-output-size! p 0)
+                 (set! open? #f)
+                 (unless (foreign-call "ikrt_close_file" fd)
+                   (error 'close-output-port "cannot close ~s" port-name)))]
+              [(port-name p) port-name]
+              [else (error 'output-file-handler 
+                           "unhandled message ~s" (cons msg args))])))
+        output-file-handler))
+    (define (option-id x)
+      (case x
+        [(error)    0]
+        [(replace)  1]
+        [(truncate) 2]
+        [(append)   3]
+        [else (error 'open-output-file "~s is not a valid mode" x)]))
+    (define open-output-file
+      (lambda (filename options)
+        (let ([fd/error 
+               (foreign-call "ikrt_open_output_file" 
+                             filename 
+                             (option-id options))])
+          (if (fixnum? fd/error)
+              (make-output-port
+                (make-output-file-handler fd/error filename)
+                (make-string 4096))
+              (error 'open-output-file "cannot open ~s: ~a" filename fd/error)))))
+    (primitive-set! '*standard-output-port* 
+      (make-output-port
+        (make-output-file-handler 1 '*stdout*)
+        (make-string 4096)))
+    (primitive-set! '*current-output-port* *standard-output-port*)
+    (primitive-set! '*standard-error-port* 
+      (make-output-port
+        (make-output-file-handler 2 '*stderr*)
+        (make-string 4096)))
+    (primitive-set! 'standard-output-port 
+       (lambda () *standard-output-port*))
+    (primitive-set! 'standard-error-port
+       (lambda () *standard-error-port*))
+    (primitive-set! 'console-output-port 
+       (lambda () *standard-output-port*))
+    (primitive-set! 'current-output-port 
+       (case-lambda
+         [() *current-output-port*]
+         [(p)
+          (if (output-port? p)
+              (primitive-set! '*current-output-port* p)
+              (error 'current-output-port "~s is not an output port" p))]))
+    (primitive-set! 'open-output-file 
+      (case-lambda
+        [(filename)
+         (if (string? filename)
+             (open-output-file filename 'error)
+             (error 'open-output-file "~s is not a string" filename))]
+        [(filename options)
+         (if (string? filename)
+             (open-output-file filename options)
+             (error 'open-output-file "~s is not a string" filename))])))
+  
+  (let () ;;; OUTPUT STRINGS
+    ;;;
+    (define string-copy 
+      (lambda (s)
+        (substring s 0 (string-length s))))
+    (define concat 
+      (lambda (str i ls)
+        (let ([n (sum i ls)])
+          (let ([outstr ($make-string n)])
+            (let f ([n (copy outstr str i n)] [ls ls])
+              (if (null? ls)
+                  outstr
+                  (let ([a ($car ls)])
+                    (f (copy outstr a ($string-length a) n) ($cdr ls)))))))))
+    (define sum 
+      (lambda (ac ls)
+        (cond
+          [(null? ls) ac]
+          [else (sum ($fx+ ac ($string-length ($car ls))) ($cdr ls))])))
+    (define copy
+      (lambda (dst src n end)
+        (let f ([di end]
+                [si n])
+          (cond
+            [($fx= si 0) di]
+            [else
+             (let ([di ($fxsub1 di)] [si ($fxsub1 si)])
+               ($string-set! dst di ($string-ref src si))
+               (f di si))]))))
+    (define make-output-string-handler
+      (lambda ()
+        (define buffer-list '())
+        (define open? #t)
+        (define output-handler
+          (lambda (msg . args)
+            (message-case msg args
+              [(write-char c p)
+               (if (char? c)
+                   (if (output-port? p)
+                       (let ([idx ($port-output-index p)])
+                          (if ($fx< idx ($port-output-size p))
+                              (begin
+                                ($string-set! ($port-output-buffer p) idx c)
+                                ($set-port-output-index! p ($fxadd1 idx)))
+                              (if open?
+                                (begin
+                                  (set! buffer-list
+                                    (cons (string-copy (port-output-buffer p))
+                                          buffer-list))
+                                  ($set-port-output-size! p 
+                                    ($string-length ($port-output-buffer p)))
+                                  ($write-char c p))
+                                (error 'write-char "port ~s is closed" p))))
+                       (error 'write-char "~s is not an output-port" p))
+                   (error 'write-char "~s is not a character" c))]
+              [(flush-output-port p)
+               (void)]
+              [(close-port p)
+               (set! open? #f)]
+              [(port-name p) 'string-port]
+              [(get-output-string p) 
+               (concat ($port-output-buffer p)
+                       ($port-output-index p)
+                       buffer-list)]
+              [else (error 'output-handler 
+                           "unhandled message ~s" (cons msg args))])))
+        output-handler))
+    (primitive-set! 'open-output-string 
+      (lambda ()
+        (make-output-port 
+          (make-output-string-handler)
+          (make-string 10))))
+    (primitive-set! 'get-output-string
+      (lambda (p)
+        (if (output-port? p)
+            (($port-handler p) 'get-output-string p)
+            (error 'get-output-string "~s is not an output port" p))))
+  )
+  
+  (primitive-set! 'with-output-to-file
+     (lambda (name proc . args)
+       (unless (string? name) 
+         (error 'with-output-to-file "~s is not a string" name))
+       (unless (procedure? proc)
+         (error 'with-output-to-file "~s is not a procedure" proc))
+       (let ([p (apply open-output-file name args)]
+             [shot #f])
+         (parameterize ([current-output-port p])
+           (dynamic-wind 
+             (lambda () 
+               (when shot
+                 (error 'with-output-to-file 
+                        "cannot reenter")))
+             proc
+             (lambda () 
+               (close-output-port p)
+               (set! shot #t)))))))
+  
+  (primitive-set! 'call-with-output-file
+     (lambda (name proc . args)
+       (unless (string? name) 
+         (error 'call-with-output-file "~s is not a string" name))
+       (unless (procedure? proc)
+         (error 'call-with-output-file "~s is not a procedure" proc))
+       (let ([p (apply open-output-file name args)]
+             [shot #f])
          (dynamic-wind 
            (lambda () 
              (when shot
-               (error 'with-output-to-file 
-                      "cannot reenter")))
-           proc
+               (error 'call-with-output-file "cannot reenter")))
+           (lambda () (proc p))
            (lambda () 
              (close-output-port p)
-             (set! shot #t)))))))
-
-(primitive-set! 'call-with-output-file
-   (lambda (name proc . args)
-     (unless (string? name) 
-       (error 'call-with-output-file "~s is not a string" name))
-     (unless (procedure? proc)
-       (error 'call-with-output-file "~s is not a procedure" proc))
-     (let ([p (apply open-output-file name args)]
-           [shot #f])
-       (dynamic-wind 
-         (lambda () 
-           (when shot
-             (error 'call-with-output-file "cannot reenter")))
-         (lambda () (proc p))
-         (lambda () 
-           (close-output-port p)
-           (set! shot #t))))))
-
-(primitive-set! 'with-input-from-file
-   (lambda (name proc)
-     (unless (string? name) 
-       (error 'with-input-from-file "~s is not a string" name))
-     (unless (procedure? proc)
-       (error 'with-input-from-file "~s is not a procedure" proc))
-     (let ([p (open-input-file name)]
-           [shot #f])
-       (parameterize ([current-input-port p])
+             (set! shot #t))))))
+  
+  (primitive-set! 'with-input-from-file
+     (lambda (name proc)
+       (unless (string? name) 
+         (error 'with-input-from-file "~s is not a string" name))
+       (unless (procedure? proc)
+         (error 'with-input-from-file "~s is not a procedure" proc))
+       (let ([p (open-input-file name)]
+             [shot #f])
+         (parameterize ([current-input-port p])
+           (dynamic-wind 
+             (lambda () 
+               (when shot
+                 (error 'with-input-from-file 
+                        "cannot reenter")))
+             proc
+             (lambda () 
+               (close-input-port p)
+               (set! shot #t)))))))
+  
+  (primitive-set! 'call-with-input-file
+     (lambda (name proc)
+       (unless (string? name) 
+         (error 'call-with-input-file "~s is not a string" name))
+       (unless (procedure? proc)
+         (error 'call-with-input-file "~s is not a procedure" proc))
+       (let ([p (open-input-file name)]
+             [shot #f])
          (dynamic-wind 
            (lambda () 
              (when shot
-               (error 'with-input-from-file 
-                      "cannot reenter")))
-           proc
+               (error 'call-with-input-file "cannot reenter")))
+           (lambda () (proc p))
            (lambda () 
              (close-input-port p)
-             (set! shot #t)))))))
-
-(primitive-set! 'call-with-input-file
-   (lambda (name proc)
-     (unless (string? name) 
-       (error 'call-with-input-file "~s is not a string" name))
-     (unless (procedure? proc)
-       (error 'call-with-input-file "~s is not a procedure" proc))
-     (let ([p (open-input-file name)]
-           [shot #f])
-       (dynamic-wind 
-         (lambda () 
-           (when shot
-             (error 'call-with-input-file "cannot reenter")))
-         (lambda () (proc p))
-         (lambda () 
-           (close-input-port p)
-           (set! shot #t))))))
-
+             (set! shot #t))))))
+)
diff --git a/lib/message-case.ss b/lib/message-case.ss
deleted file mode 100644
index 4831666..0000000
--- a/lib/message-case.ss
+++ /dev/null
@@ -1,24 +0,0 @@
-
-
-(define-syntax message-case
-  (syntax-rules  (else)
-    [(_ msg args 
-        [(msg-name msg-arg* ...) b b* ...] ... 
-        [else else1 else2 ...])
-     (let ([tmsg msg] [targs args])
-       (define-syntax match-and-bind
-         (syntax-rules ()
-           [(__ y () body)
-            (if (null? y) 
-                body
-                (error 'message-case "unmatched ~s" (cons tmsg targs)))]
-           [(__ y (a a* (... ...)) body)
-            (if (pair? y)
-                (let ([a (car y)] [d (cdr y)])
-                  (match-and-bind d (a* (... ...)) body))
-                (error 'message-case "unmatched ~s" (cons tmsg targs)))]))
-       (case tmsg
-         [(msg-name) 
-          (match-and-bind targs (msg-arg* ...) (begin b b* ...))] ...
-         [else else1 else2 ...]))]))
-