1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2017. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(prim_buffer).
21
22-export([on_load/0]).
23
24%% This is a mutable binary buffer that helps break out buffering logic from
25%% NIFs/drivers, which is often the only thing that prevents the C code from
26%% being reduced to bare system call wrappers.
27%%
28%% All operations in this file are thread-unsafe and risk crashing the emulator
29%% if you're not careful.
30
31-export([new/0, size/1, wipe/1, read/2, read_iovec/2, write/2, skip/2]).
32
33-export([find_byte_index/2]).
34
35-export([try_lock/1, unlock/1]).
36
37-type prim_buffer() :: term().
38
39%% Controls when to copy rather than extract sub-binaries from the buffer,
40%% reducing the risk of small reads keeping a large binary alive.
41-define(COPYING_READ_LIMIT, 512).
42
43%% Reads that fit into heap binaries are always copied since the cost of
44%% peeking binaries that short is largely equivalent to copying.
45-define(ERL_ONHEAP_BIN_LIMIT, 64).
46
47on_load() ->
48    case erlang:load_nif(atom_to_list(?MODULE), 0) of
49        ok -> ok
50    end.
51
52-spec new() -> prim_buffer().
53new() ->
54    erlang:nif_error(undef).
55
56-spec size(Buffer :: prim_buffer()) -> non_neg_integer().
57size(_Buffer) ->
58    erlang:nif_error(undef).
59
60%% Reads data as a binary from the front of the buffer. This will almost always
61%% result in copying so it should be avoided unless you absolutely must have a
62%% binary.
63-spec read(Buffer :: prim_buffer(), Size :: non_neg_integer()) -> binary().
64read(Buffer, Size) when Size =< ?ERL_ONHEAP_BIN_LIMIT ->
65    copying_read(Buffer, Size);
66read(Buffer, Size) when Size > ?ERL_ONHEAP_BIN_LIMIT ->
67    iolist_to_binary(read_iovec(Buffer, Size)).
68
69%% Reads data as an erlang:iovec() binary from the front of the buffer,
70%% avoiding copying if reasonable.
71-spec read_iovec(Buffer, Size) -> IOVec when
72      Buffer :: prim_buffer(),
73      Size :: non_neg_integer(),
74      IOVec :: erlang:iovec().
75read_iovec(Buffer, Size) when Size =< ?ERL_ONHEAP_BIN_LIMIT ->
76    [copying_read(Buffer, Size)];
77read_iovec(Buffer, Size) when Size > ?ERL_ONHEAP_BIN_LIMIT ->
78    Head = peek_head(Buffer),
79    HeadSize = byte_size(Head),
80    if
81        (HeadSize - Size) > ?COPYING_READ_LIMIT, Size =< ?COPYING_READ_LIMIT ->
82            [copying_read(Buffer, Size)];
83        HeadSize > Size ->
84            skip(Buffer, Size),
85            {First, _Rest} = split_binary(Head, Size),
86            [First];
87        HeadSize < Size ->
88            skip(Buffer, HeadSize),
89            [Head | read_iovec(Buffer, Size - HeadSize)];
90        HeadSize =:= Size ->
91            skip(Buffer, Size),
92            [Head]
93    end.
94
95%% Writes an erlang:iovec() to the back of the buffer.
96-spec write(Buffer :: prim_buffer(), IOVec :: erlang:iovec()) -> ok.
97write(_Buffer, _IOVec) ->
98    erlang:nif_error(undef).
99
100%% Removes data from the front of the buffer without reading it.
101-spec skip(Buffer :: prim_buffer(), Size :: non_neg_integer()) -> ok.
102skip(_Buffer, _Size) ->
103    erlang:nif_error(undef).
104
105-spec wipe(Buffer :: prim_buffer()) -> ok.
106wipe(Buffer) ->
107    skip(Buffer, prim_buffer:size(Buffer)).
108
109%% Finds the start-index of the first occurence of Needle, for implementing
110%% read_line and similar.
111-spec find_byte_index(Buffer, Needle) -> Result when
112      Buffer :: prim_buffer(),
113      Needle :: non_neg_integer(),
114      Result :: {ok, non_neg_integer()} |
115                not_found.
116find_byte_index(_Buffer, _Needle) ->
117    erlang:nif_error(undef).
118
119%% Attempts to take a unique lock on the buffer. Failure handling is left to
120%% the user.
121-spec try_lock(Buffer :: prim_buffer()) -> acquired | busy.
122try_lock(_Buffer) ->
123    erlang:nif_error(undef).
124
125-spec unlock(Buffer :: prim_buffer()) -> ok.
126unlock(_Buffer) ->
127    erlang:nif_error(undef).
128
129%% Unexported helper functions:
130
131%% Reads data from the front of the buffer, returning a copy of the data to
132%% avoid holding references.
133-spec copying_read(Buffer :: prim_buffer(), Size :: non_neg_integer()) -> binary().
134copying_read(_Buffer, _Size) ->
135    erlang:nif_error(undef).
136
137%% Returns the binary at the front of the buffer without modifying the buffer.
138-spec peek_head(Buffer :: prim_buffer()) -> binary().
139peek_head(_Buffer) ->
140    erlang:nif_error(undef).
141