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?
|
