/usr/share/scsh-0.6/scsh/rw.scm is in scsh-common-0.6 0.6.7-8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 | ;;; Basic read and write
;;; Copyright (c) 1993 by Olin Shivers.
;;; Note: read ops should check to see if their string args are mutable.
(define (bogus-substring-spec? s start end)
(or (< start 0)
(< (string-length s) end)
(< end start)))
;;; Best-effort/forward-progress reading
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (read-string!/partial s . args)
(let-optionals args ((fd/port (current-input-port))
(start 0)
(end (string-length s)))
(if (bogus-substring-spec? s start end)
(error "Bad substring indices" s start end))
(cond ((integer? fd/port)
(let ((port (fdes->inport fd/port)))
(set-port-buffering port bufpol/none)
(read-string!/partial s port start end)))
((open-input-port? fd/port)
(if (= start end)
0
(let* ((needed (if (= 0 (bitwise-and open/non-blocking
(fdes-status fd/port)))
'any
'immediate))
(nread (if (= end (string-length s))
(read-block s start needed fd/port)
;;; READ-BLOCK doesn't allow us to specify a
;;; maximum number of characters to read/partial
;;; but fills the buffer at most to the end.
;;; Therefore we allocate a new buffer here:
(let* ((buf (make-string (- end start)))
(nread-any
(read-block buf 0 needed fd/port)))
(if (not (eof-object? nread-any))
(copy-bytes! buf 0 s start nread-any))
nread-any))))
(if (eof-object? nread)
#f
nread))))
(else
(apply error "Not a fd/port in read-string!/partial" s args)))))
(define (read-string/partial len . maybe-fd/port)
(let* ((fd/port (:optional maybe-fd/port (current-input-port))))
(cond ((integer? fd/port)
(let ((port (fdes->inport fd/port)))
(set-port-buffering port bufpol/none)
(read-string/partial len port)))
((open-input-port? fd/port)
(if (= len 0)
""
(let* ((buffer (make-string len))
(nread (read-string!/partial buffer fd/port)))
(cond ((not nread) #f)
((= nread len) buffer)
(else (substring buffer 0 nread))))))
(else
(error "Not a fd/port in read-string/partial" len fd/port)))))
;;; Persistent reading
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Operation on ports is easy, since we can use read-block
(define (read-string! s . args)
(let-optionals args ((fd/port (current-input-port))
(start 0)
(end (string-length s)))
(if (bogus-substring-spec? s start end)
(error "Bad substring indices" s start end))
(cond ((integer? fd/port)
(let ((port (fdes->inport fd/port)))
(set-port-buffering port bufpol/block (- end start))
(read-string! port start end)))
(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))
(fd/port (:optional maybe-fd/port (current-input-port)))
(nread (read-string! s fd/port 0 len)))
(cond ((not nread) #f) ; EOF
((= nread len) s)
(else (substring s 0 nread)))))
;;; Best-effort/forward-progress writing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Non-blocking output to a buffered port is not defined.
(define (write-string/partial s . args)
(let-optionals args ((fd/port (current-output-port))
(start 0)
(end (string-length s)))
(if (bogus-substring-spec? s start end)
(error "Bad substring indices" s start end))
(cond ((integer? fd/port)
(let ((port (fdes->outport fd/port)))
(set-port-buffering port bufpol/block (- end start))
(write-string/partial s port start end)))
(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 currently dereleased.
See the RELEASE file for details")))))
;;; Persistent writing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (write-string s . args)
(let-optionals args ((fd/port (current-output-port))
(start 0)
(end (string-length s)))
(if (bogus-substring-spec? s start end)
(error "Bad substring indices" s start end))
(cond ((integer? fd/port)
(let ((port (fdes->outport fd/port)))
(set-port-buffering port bufpol/block (- end start))
(write-string s port start end)))
(else (write-block s start (- end start) fd/port)))))
|