[Wisp-cvs] wisp/src/builtin filing.wisp,1.111,1.112 records.wisp,1.10,1.11 stdenv.wisp,1.372,1.373

[<di...@us...>]

Update of /cvsroot/wisp/wisp/src/builtin
In directory usw-pr-cvs1:/tmp/cvs-serv3689/builtin

Modified Files:
	filing.wisp records.wisp stdenv.wisp 
Log Message:
Implemented char-based output-buffered ports.

Index: filing.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/filing.wisp,v
retrieving revision 1.111
retrieving revision 1.112
diff -u -d -r1.111 -r1.112
--- filing.wisp	18 Sep 2002 21:18:04 -0000	1.111
+++ filing.wisp	19 Sep 2002 02:43:39 -0000	1.112
@@ -233,13 +233,16 @@
   (define (file-descriptor file)
     (if (instance? file)
       (%file-descriptor file)
-      (%file-fd file))))
+      (%file-fd (%port-host file)))))
 
 (my (%<output-buffered-port> %make-obp %obp-host %obp-buffer %obp-bufptr)
   (make-record-type 3
     'new (lambda (%<obp> %make-obp %obp-host %obp-buffer %obp-bufptr)
            (lambda (host buffer-type buffer-size)
-             (%make-obp host (new buffer-type buffer-size) 0)))
+             (%make-obp host (if (eq? buffer-type 'c8string)
+                               (make-c8string buffer-size)
+                               (new buffer-type buffer-size))
+                        0)))
     'confess (lambda (%<obp> %make-obp %obp-host %obp-buffer %obp-bufptr)
                (lambda (port . rest)
                  (apply
@@ -267,7 +270,23 @@
     'read-string (lambda (%<obp> %make-obp %obp-host %obp-buffer %obp-bufptr)
                    (lambda (port amount)
                      (aux port 'flush)
-                     (read-string (%obp-host port) amount)))))
+                     (read-string (%obp-host port) amount)))
+    'write-char (lambda (%<obp> %make-obp %obp-host %obp-buffer %obp-bufptr)
+                  (lambda (port ch)
+                    (set! (ref (%obp-buffer port) (%obp-bufptr port)) ch)
+                    (incr! (%obp-bufptr port))
+                    (if (>= (%obp-bufptr port) (length (%obp-buffer port)))
+                      (aux port 'flush))))
+    'close-port (lambda (%<obp> %make-obp %obp-host %obp-buffer %obp-bufptr)
+                  (lambda (port direction)
+                    (aux port 'flush)
+                    (case direction
+                      ((#t) (close-port (%obp-host port)))
+                      ((read) (close-input-port (%obp-host port)))
+                      ((write) (close-output-port (%obp-host port))))
+                    (begin))))
+
+  (define <output-buffered-port> %<output-buffered-port>))
 
 (define (construct-filename dir base)
   (cond

Index: records.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/records.wisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- records.wisp	18 Sep 2002 21:18:04 -0000	1.10
+++ records.wisp	19 Sep 2002 02:43:39 -0000	1.11
@@ -109,11 +109,13 @@
 ; the Wisp and objects while |aux| is for public communication between
 ; objects and their clients.
 (define (aux obj . args)
-  (and (type-of obj) -> t => record-type?
-       ((asm NN_pr_record_type_aux_slot) t)
-       => (cut apply <> obj args)))
+  (and (type-of obj) -> t
+       (record-type? t)
+       ((asm NN_pr_record_type_aux_slot) t) -> a
+       (apply a obj args)))
 
 (define (%confess obj . args)
-  (and (type-of obj) -> t => record-type?
-       ((asm NN_pr_record_type_confess_slot) t)
-       => (cut apply <> obj args)))
+  (and (type-of obj) -> t
+       (record-type? t)
+       ((asm NN_pr_record_type_confess_slot) t) -> c
+       (apply c obj args)))

Index: stdenv.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/stdenv.wisp,v
retrieving revision 1.372
retrieving revision 1.373
diff -u -d -r1.372 -r1.373
--- stdenv.wisp	18 Sep 2002 21:18:04 -0000	1.372
+++ stdenv.wisp	19 Sep 2002 02:43:39 -0000	1.373
@@ -12,7 +12,8 @@
        (cons 'list
          (map (lambda (x) `(cons ',x ,x))
            '(* + - / /= < << <= <box> <c16string> <class> <macro>
-             <old-file> <old-port> <record-type> <u8vector> <vector> =
+             <old-file> <old-port> <output-buffered-port>
+             <record-type> <u8vector> <vector> =
              > >= >> abs acons! address-of alist->dict alist-copy
              analyse and append append-reverse apply assert
              assert-object-type assoc assq assv atom? aux big-integer?