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
type t = {
mutable o_s : bytes;
mutable o_max_len : int;
mutable o_len : int;
mutable o_offs : int;
o_init_len : int;
o_make_room : (t -> int -> unit);
mutable o_shared : Bi_share.Wr.tbl;
o_shared_init_len : int;
}
let really_extend b n =
let slen0 = b.o_max_len in
let reqlen = b.o_len + n in
let slen =
let x = max reqlen (2 * slen0) in
if x <= Sys.max_string_length then x
else
if Sys.max_string_length < reqlen then
invalid_arg "Buf.extend: reached Sys.max_string_length"
else
Sys.max_string_length
in
let s = Bytes.create slen in
Bytes.blit b.o_s 0 s 0 b.o_len;
b.o_s <- s;
b.o_max_len <- slen
let flush_to_output abstract_output b n =
abstract_output (Bytes.to_string b.o_s) 0 b.o_len;
b.o_offs <- b.o_offs + b.o_len;
b.o_len <- 0;
if n > b.o_max_len then
really_extend b n
let flush_to_channel oc = flush_to_output (output_substring oc)
let create ?(make_room = really_extend) ?(shrlen = 16) n = {
o_s = Bytes.create n;
o_max_len = n;
o_len = 0;
o_offs = 0;
o_init_len = n;
o_make_room = make_room;
o_shared = Bi_share.Wr.create shrlen;
o_shared_init_len = shrlen;
}
let create_channel_writer ?(len = 4096) ?shrlen oc =
create ~make_room:(flush_to_channel oc) ?shrlen len
let flush_channel_writer b =
b.o_make_room b 0
let create_output_writer ?(len = 4096) ?shrlen out =
create ~make_room:(flush_to_output out#output) ?shrlen len
let flush_output_writer = flush_channel_writer
let extend b n =
if b.o_len + n > b.o_max_len then
b.o_make_room b n
let alloc b n =
extend b n;
let pos = b.o_len in
b.o_len <- pos + n;
pos
let add_sub blit b s pos len =
extend b len;
blit s pos b.o_s b.o_len len;
b.o_len <- b.o_len + len
let add_substring = add_sub String.blit
let add_subbytes = add_sub Bytes.blit
let add_string b s =
add_substring b s 0 (String.length s)
let add_bytes b s =
add_subbytes b s 0 (Bytes.length s)
let add_char b c =
let pos = alloc b 1 in
Bytes.set b.o_s pos c
let unsafe_add_char b c =
let len = b.o_len in
Bytes.set b.o_s len c;
b.o_len <- len + 1
let add_char2 b c1 c2 =
let pos = alloc b 2 in
let s = b.o_s in
Bytes.unsafe_set s pos c1;
Bytes.unsafe_set s (pos+1) c2
let add_char4 b c1 c2 c3 c4 =
let pos = alloc b 4 in
let s = b.o_s in
Bytes.unsafe_set s pos c1;
Bytes.unsafe_set s (pos+1) c2;
Bytes.unsafe_set s (pos+2) c3;
Bytes.unsafe_set s (pos+3) c4
let clear b =
b.o_offs <- 0;
b.o_len <- 0;
Bi_share.Wr.clear b.o_shared
let reset b =
if Bytes.length b.o_s <> b.o_init_len then
b.o_s <- Bytes.create b.o_init_len;
b.o_offs <- 0;
b.o_len <- 0;
b.o_shared <- Bi_share.Wr.create b.o_shared_init_len
let contents b = Bytes.sub_string b.o_s 0 b.o_len