-
Notifications
You must be signed in to change notification settings - Fork 10
/
Copy pathio.ss
186 lines (158 loc) · 7.8 KB
/
io.ss
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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
;;; Copyright (C) 2023-2025 by Massimiliano Ghilardi
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
(library (schemesh posix io (0 8 1))
(export
make-utf8b-input-port make-utf8b-input/output-port make-utf8b-output-port
open-fd-redir-binary-input-port open-fd-redir-binary-input/output-port open-fd-redir-binary-output-port
open-fd-redir-utf8b-input-port open-fd-redir-utf8b-input/output-port open-fd-redir-utf8b-output-port
open-file-binary-input-port open-file-utf8b-input-port)
(import
(rnrs)
(only (chezscheme) enum-set? fx1+ include port-name
make-custom-binary-input-port make-custom-binary-input/output-port make-custom-binary-output-port
make-custom-textual-input-port make-custom-textual-input/output-port make-custom-textual-output-port
set-binary-port-input-buffer! set-binary-port-input-index! set-binary-port-input-size!
set-binary-port-output-buffer! set-binary-port-output-index! set-binary-port-output-size!
set-textual-port-input-buffer! set-textual-port-input-index! set-textual-port-input-size!
set-textual-port-output-buffer! set-textual-port-output-index! set-textual-port-output-size!)
(only (schemesh bootstrap) assert*)
(schemesh containers bytespan)
(only (schemesh containers utf8b) utf8b->string utf8b->string-copy!)
(only (schemesh containers utf8b utils) bytespan-insert-right/string!)
(only (schemesh posix fd) fd-close fd-read fd-write-all open-file-fd))
(define (%set-buffer-mode! port b-mode)
(let ((buffer-size (case b-mode
((none) 1) ; Chez Scheme streams do not support zero buffer-size
((line) 128)
(else 8192))))
(when (textual-port? port)
(when (input-port? port)
(set-textual-port-input-buffer! port (make-string buffer-size))
(set-textual-port-input-size! port 0)
(set-textual-port-input-index! port 0))
(when (output-port? port)
(set-textual-port-output-buffer! port (make-string buffer-size))
(set-textual-port-output-size! port 0)
(set-textual-port-output-index! port 0)))
(when (binary-port? port)
(when (input-port? port)
(set-binary-port-input-buffer! port (make-bytevector buffer-size))
(set-binary-port-input-size! port 0)
(set-binary-port-input-index! port 0))
(when (output-port? port)
(set-binary-port-output-buffer! port (make-bytevector buffer-size))
(set-binary-port-output-size! port 0)
(set-binary-port-output-index! port 0))))
port)
;; binary input and/or output port reading from/writing to a file descriptor returned by a closure.
(define-record-type bport
(fields
(immutable proc) ; fd-proc
(mutable pos)) ; position
(nongenerative #{bport n9keti0sj3bih8de7dh3r7n4y-0}))
(define (bport-read p bv start n)
(if (and (bytevector? bv) (fixnum? start) (fixnum? n)
(< -1 start (+ start n) (fx1+ (bytevector-length bv))))
(let ((ret (fd-read ((bport-proc p)) bv start (fx+ start n))))
(cond
((and (integer? ret) (> ret 0))
(bport-pos-set! p (+ ret (bport-pos p)))
ret)
(else 0)))
0))
(define (bport-write p bv start n)
(if (and (bytevector? bv) (fixnum? start) (fixnum? n)
(< -1 start (+ start n) (fx1+ (bytevector-length bv))))
(begin
(fd-write-all ((bport-proc p)) bv start (fx+ start n))
(bport-pos-set! p (fx+ n (bport-pos p)))
n)
0))
;; create and return a binary input port that redirectably reads from a file descriptor.
;;
;; fd-proc must be a no-argument procedure that returns an integer file descriptor;
;; the returned file descriptor *may* change from one call to the next.
(define open-fd-redir-binary-input-port
(case-lambda
((name fd-proc b-mode proc-on-close)
(assert* 'open-fd-redir-binary-input-port (procedure? fd-proc))
(assert* 'open-fd-redir-binary-input-port (buffer-mode? b-mode))
(let* ((bport (make-bport fd-proc 0))
(ret (make-custom-binary-input-port
name
(lambda (bv start n) (bport-read bport bv start n))
(lambda () (bport-pos bport))
#f ; no pos-set!
proc-on-close)))
(%set-buffer-mode! ret b-mode)))
((name fd-proc b-mode)
(open-fd-redir-binary-input-port name fd-proc b-mode #f))
((name fd-proc)
(open-fd-redir-binary-input-port name fd-proc (buffer-mode block) #f))))
;; create and return a binary input/output port that redirectably reads from/writes to a file descriptor.
;;
;; fd-proc must be no-argument procedures that return an integer file descriptor;
;; the returned file descriptor *may* change from one call to the next.
(define open-fd-redir-binary-input/output-port
(case-lambda
((name fd-proc b-mode proc-on-close)
(assert* 'open-fd-redir-binary-input/output-port (procedure? fd-proc))
(assert* 'open-fd-redir-binary-input/output-port (buffer-mode? b-mode))
(let* ((bport (make-bport fd-proc 0))
(ret (make-custom-binary-input/output-port
name
(lambda (bv start n) (bport-read bport bv start n))
(lambda (bv start n) (bport-write bport bv start n))
#f ; no pos: there is no "single" position, in/out file descriptors may differ and may be non-seekable
#f ; no pos-set!
proc-on-close)))
(%set-buffer-mode! ret b-mode)))
((name fd-proc b-mode)
(open-fd-redir-binary-input/output-port name fd-proc b-mode #f))
((name fd-proc)
(open-fd-redir-binary-input/output-port name fd-proc (buffer-mode block) #f))))
;; create and return a binary output port that redirectably writes to a file descriptor.
;;
;; fd-proc must be a no-argument procedure that returns an integer file descriptor;
;; the returned file descriptor *may* change from one call to the next.
(define open-fd-redir-binary-output-port
(case-lambda
((name fd-proc b-mode proc-on-close)
(assert* 'open-fd-redir-binary-output-port (procedure? fd-proc))
(assert* 'open-fd-redir-binary-output-port (buffer-mode? b-mode))
(let* ((bport (make-bport fd-proc 0))
(ret (make-custom-binary-output-port
name
(lambda (bv start n) (bport-write bport bv start n))
(lambda () (bport-pos bport))
#f ; no pos-set!
proc-on-close)))
(%set-buffer-mode! ret b-mode)))
((name fd-proc b-mode)
(open-fd-redir-binary-output-port name fd-proc b-mode #f))
((name fd-proc)
(open-fd-redir-binary-output-port name fd-proc (buffer-mode block) #f))))
;; create and return a binary input port that reads
;; bytes from specified file path.
;;
;; path must be a string or bytevector.
(define open-file-binary-input-port
(case-lambda
((path f-options b-mode)
(assert* 'open-file-binary-input-port (enum-set? f-options))
(assert* 'open-file-binary-input-port (buffer-mode? b-mode))
(let ((name (if (string? path) path (utf8b->string path)))
(fd (open-file-fd path 'read)))
(open-fd-redir-binary-input-port
name
(lambda () fd)
b-mode
(lambda () (fd-close fd)))))
((path)
(open-file-binary-input-port path (file-options) (buffer-mode block)))))
(include "posix/io-utf8b.ss")
) ; close library