scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

read/write-string via the port procedures from the RTS. 

write-string/partial is no longer supported.
This commit is contained in:
marting 2000-05-18 14:03:44 +00:00
parent d0b3f61ccd
commit b2130fc267
1 changed files with 24 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
scsh/rw.scm
View File

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