[Wisp-cvs] wisp/modules Makefile.am,1.56,1.57 string-port.wim,1.15,1.16 unix.wim,1.43,1.44 block-port.wim,1.14,NONE

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

Update of /cvsroot/wisp/wisp/modules
In directory usw-pr-cvs1:/tmp/cvs-serv2015/modules

Modified Files:
	Makefile.am string-port.wim unix.wim 
Removed Files:
	block-port.wim 
Log Message:
Introduced the new, more polymorphic port mechanism.

Index: Makefile.am
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/Makefile.am,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -d -r1.56 -r1.57
--- Makefile.am	7 Sep 2002 21:52:38 -0000	1.56
+++ Makefile.am	18 Sep 2002 21:16:38 -0000	1.57
@@ -20,12 +20,12 @@
 wisp_DATA = shell.wisp
 
 wim_DATA = \
-    and-let.wim arithmetics.wim balanced.wim baudot.wim block-port.wim \
-    cgi.wim codecoll.wim collectors.wim display.wim encoding.wim \
-    files.wim frer.wim getopt.wim ini.wim keyboard.wim lists.wim \
-    locale.wim mingle.wim morse.wim phases.wim promises.wim qsort.wim \
-    random.wim regex.wim string-port.wim strings.wim tester.wim \
-    time.wim unicode.wim unix.wim url.wim xml.wim wispdoc.wim
+    and-let.wim arithmetics.wim balanced.wim baudot.wim cgi.wim \
+    codecoll.wim collectors.wim display.wim encoding.wim files.wim \
+    frer.wim getopt.wim ini.wim keyboard.wim lists.wim locale.wim \
+    mingle.wim morse.wim phases.wim promises.wim qsort.wim random.wim \
+    regex.wim string-port.wim strings.wim tester.wim time.wim \
+    unicode.wim unix.wim url.wim xml.wim wispdoc.wim
 
 frwim_DATA = $(filter-out arithmetics.frwim,$(wim_DATA:%.wim=%.frwim))
 

Index: string-port.wim
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/string-port.wim,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- string-port.wim	7 Sep 2002 21:56:55 -0000	1.15
+++ string-port.wim	18 Sep 2002 21:16:38 -0000	1.16
@@ -9,17 +9,18 @@
 (module string-port)
 
 (export
-  <string-port> get-output-string open-input-string open-output-string)
+  <output-string-port> <string-port> get-output-string
+  open-input-string open-output-string)
 
-(define-class (<string-port> <port>)
+(define-class (<string-port> <old-port>)
   data pos
   (#f data pos)
   (friend (init-input-string port str)
-    (init-port port raw-string-reader #f raw-string-seeker #f (lambda #f #t))
+    (init-port port raw-string-reader #f #f (lambda #f #t))
     (set! data str)
     (set! pos 0))
   (friend (init-output-string port) ; all string ports are readable
-    (init-port port raw-string-reader raw-string-writer raw-string-seeker #f (lambda #f #t))
+    (init-port port raw-string-reader raw-string-writer #f (lambda #f #t))
     (set! data (string))
     (set! pos 0))
   (friend (raw-string-reader port string start count)
@@ -32,33 +33,37 @@
           (set! count (- (length data) pos)))
         (string-move! string start data pos count)
         (incr! pos count)
-        count)))
-  (friend (raw-string-writer port string start count)
-    (if (negative? count)
-      (raise 'range count))
-    (if (> (+ pos count) (length data))
-      (set! (length data) (+ pos count)))
-    (string-move! data pos string start count)
-    (incr! pos count)
-    count)
-  (friend (raw-string-seeker port whence delta)
-    (set! pos (+ delta (case whence
-                         ((absolute) 0)
-                         ((relative) pos)
-                         ((end) (length data))
-                         (else (raise 'invalid-whence whence)))))
-    pos)
-  (friend (get-output-string port)
-    (string-copy data)))
+        count))))
 
 (define (open-input-string s)
   (my port (make-instance <string-port>)
     (init-input-string port s)
     port))
 
+(bind (<output-string-port> %make-osp %osp-buffer %osp-pointer)
+  (make-record-type 2
+    'new (lambda (<output-string-port> %make-osp
+                                       %osp-buffer %osp-pointer)
+           (lambda ()
+             (%make-osp (new <c16string> 64) 0)))
+    'write-char (lambda (<output-string-port> %make-osp
+                                              %osp-buffer %osp-pointer)
+                  (lambda (port ch)
+                    (if (<= (length (%osp-buffer port))
+                            (%osp-pointer port))
+                      (my new-buffer (new <c16string>
+                                          (* (length (%osp-buffer port))
+                                             2))
+                        (string-move! new-buffer 0 (%osp-buffer port) 0
+                                      (length (%osp-buffer port)))
+                        (set! (%osp-buffer port) new-buffer)))
+                    (set! (%osp-buffer port)[(%osp-pointer port)] ch)
+                    (incr! (%osp-pointer port))))))
+
 (define (open-output-string)
-  (my port (make-instance <string-port>)
-    (init-output-string port)
-    port))
+  (new <output-string-port>))
+
+(define (get-output-string port)
+  (string-copy (%osp-buffer port) 0 (%osp-pointer port)))
 
 ; vim: lispwords+=,define-class,friend

Index: unix.wim
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/unix.wim,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -d -r1.43 -r1.44
--- unix.wim	7 Sep 2002 21:56:27 -0000	1.43
+++ unix.wim	18 Sep 2002 21:16:38 -0000	1.44
@@ -92,7 +92,7 @@
       ; parent
       (begin
         (sys:close (cdr pipe))
-        (my res (make-instance <file>)
+        (my res (make-instance <old-file>)
           (init-input-file res (car pipe) (make-pipe-close-hook child))
           res)))))
 
@@ -109,7 +109,7 @@
       ; parent
       (begin
         (sys:close (car pipe))
-        (my res (make-instance <file>)
+        (my res (make-instance <old-file>)
           (init-output-file res #f (cdr pipe)
                             (make-pipe-close-hook child))
           res)))))

--- block-port.wim DELETED ---