read/write-string via the port procedures from the RTS.
write-string/partial is no longer supported.
This commit is contained in:
parent
d0b3f61ccd
commit
b2130fc267
55
scsh/rw.scm
55
scsh/rw.scm
|
@ -33,15 +33,17 @@
|
||||||
(cond ((integer? fd/port)
|
(cond ((integer? fd/port)
|
||||||
(generic-read-string!/partial s start end
|
(generic-read-string!/partial s start end
|
||||||
read-fdes-substring!/errno fd/port))
|
read-fdes-substring!/errno fd/port))
|
||||||
((fdport? fd/port)
|
(else ; no differnce between fd/ports and s48 ports
|
||||||
(generic-read-string!/partial s start end
|
(let* ((buffer (make-string (- end start)))
|
||||||
read-fdes-substring!/errno
|
(needed (if (> (byte-vector-length (port-buffer fd/port)) 1)
|
||||||
(fdport-data:fd (port-data fd/port))))
|
'any 'immediate)) ;bufpol/none may return with 0
|
||||||
(else ; Hack it for base S48 ports
|
(len (read-block buffer 0 needed fd/port)))
|
||||||
(generic-read-string!/partial s start end
|
(if (eof-object? len)
|
||||||
read-fdes-substring!/errno
|
#f
|
||||||
(channel-os-index
|
(begin
|
||||||
(port-data fd/port)))))))
|
(copy-bytes! buffer 0 s start len)
|
||||||
|
len)))))))
|
||||||
|
|
||||||
|
|
||||||
(define (read-string/partial len . maybe-fd/port)
|
(define (read-string/partial len . maybe-fd/port)
|
||||||
(let* ((s (make-string len))
|
(let* ((s (make-string len))
|
||||||
|
@ -54,6 +56,8 @@
|
||||||
|
|
||||||
;;; Persistent reading
|
;;; Persistent reading
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;
|
||||||
|
;;; Operation on ports is easy, since we can use read-block
|
||||||
|
|
||||||
(define (generic-read-string! s start end reader source)
|
(define (generic-read-string! s start end reader source)
|
||||||
(if (bogus-substring-spec? s start end)
|
(if (bogus-substring-spec? s start end)
|
||||||
|
@ -81,16 +85,11 @@
|
||||||
(generic-read-string! s start end
|
(generic-read-string! s start end
|
||||||
read-fdes-substring!/errno fd/port))
|
read-fdes-substring!/errno fd/port))
|
||||||
|
|
||||||
((fdport? fd/port)
|
(else ; no differnce between fd/port and s48 ports
|
||||||
(generic-read-string! s start end
|
(let ((nbytes/eof (read-block s start (- end start) fd/port)))
|
||||||
read-fdes-substring!/errno
|
(if (eof-object? nbytes/eof)
|
||||||
(fdport-data:fd (port-data fd/port))))
|
#f
|
||||||
|
nbytes/eof))))))
|
||||||
;; Hack it
|
|
||||||
(else
|
|
||||||
(generic-read-string! s start end
|
|
||||||
read-fdes-substring!/errno
|
|
||||||
(channel-os-index (port-data fd/port)))))))
|
|
||||||
|
|
||||||
(define (read-string len . maybe-fd/port)
|
(define (read-string len . maybe-fd/port)
|
||||||
(let* ((s (make-string len))
|
(let* ((s (make-string len))
|
||||||
|
@ -125,12 +124,11 @@
|
||||||
(cond ((integer? fd/port)
|
(cond ((integer? fd/port)
|
||||||
(generic-write-string/partial s start end
|
(generic-write-string/partial s start end
|
||||||
write-fdes-substring/errno fd/port))
|
write-fdes-substring/errno fd/port))
|
||||||
((fdport? fd/port)
|
(else
|
||||||
(generic-write-string/partial s start end
|
;; the only way to implement this, would be to use
|
||||||
write-fdes-substring/errno
|
;; channel-maybe-write. But this is an VM-instruction which is not
|
||||||
(fdport-data:fd
|
;; exported. Since we now have threads this shouldn;t matter.
|
||||||
(port-data fd/port))))
|
(error "write-string/parital is no longer supported on ports")))))
|
||||||
(else (display (substring s start end) fd/port))))) ; hack
|
|
||||||
|
|
||||||
|
|
||||||
;;; Persistent writing
|
;;; Persistent writing
|
||||||
|
@ -155,9 +153,4 @@
|
||||||
(cond ((integer? fd/port)
|
(cond ((integer? fd/port)
|
||||||
(generic-write-string s start end
|
(generic-write-string s start end
|
||||||
write-fdes-substring/errno fd/port))
|
write-fdes-substring/errno fd/port))
|
||||||
((fdport? fd/port)
|
(else (write-block s start (- end start) fd/port)))))
|
||||||
(generic-write-string s start end
|
|
||||||
write-fdes-substring/errno
|
|
||||||
(fdport-data:fd (port-data fd/port))))
|
|
||||||
|
|
||||||
(else (display (substring s start end) fd/port))))) ; hack
|
|
||||||
|
|
Loading…
Reference in New Issue