~rdoering/ubuntu/intrepid/erlang/fix-535090

« back to all changes in this revision

Viewing changes to lib/stdlib/src/eval_bits.erl

  • Committer: Bazaar Package Importer
  • Author(s): Soren Hansen
  • Date: 2007-05-01 16:57:10 UTC
  • mfrom: (1.1.9 upstream)
  • Revision ID: james.westby@ubuntu.com-20070501165710-2sapk0hp2gf3o0ip
Tags: 1:11.b.4-2ubuntu1
* Merge with Debian Unstable. Remaining changes:
  - Add -fno-stack-protector to fix broken crypto_drv.
* DebianMaintainerField update.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
%% -*- erlang-indent-level: 4 -*-
 
2
%% ``The contents of this file are subject to the Erlang Public License,
 
3
%% Version 1.1, (the "License"); you may not use this file except in
 
4
%% compliance with the License. You should have received a copy of the
 
5
%% Erlang Public License along with this software. If not, it can be
 
6
%% retrieved via the world wide web at http://www.erlang.org/.
 
7
%% 
 
8
%% Software distributed under the License is distributed on an "AS IS"
 
9
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 
10
%% the License for the specific language governing rights and limitations
 
11
%% under the License.
 
12
%% 
 
13
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
 
14
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
 
15
%% AB. All Rights Reserved.''
 
16
%% 
 
17
%%     $Id $
 
18
%%
1
19
-module(eval_bits).
2
20
 
3
 
-export([expr_grp/5,match_bits/7]).
4
 
 
5
 
-import(lists, [member/2,foldl/3]).
6
 
 
7
 
%%% BITS help functions.
8
 
 
9
 
%%% The primary point here is not efficiency, but clarity.
10
 
%%% Bit sequences are represented as lists of 0 or 1.
11
 
%%% In matching we convert to bit lists only as much as we
12
 
%%% need, and keep the tail as a binary.
13
 
 
14
 
%%% expr_grp/5 returns {value, Binary, New_bindings} or exits with
15
 
%%% {Reason,[{erl_eval,expr,3}]} (any other reply is a bug).
16
 
%%% match_bits/6 returns either {match, New_bindings} or throws one of
17
 
%%% 'nomatch' or 'invalid' (the latter if a pattern is illegal - this 
18
 
%%% can only happen if lint hasn't been run).
19
 
%%% Their last argument should be 'true' if type defaulting should be
20
 
%%% done, 'false' otherwise (e.g., if sys_pre_expand has already done it).
21
 
%%% However, it works to always use 'true' for the last argument, so 
22
 
%%% this argument is could actually be removed.
23
 
 
24
 
%% error(Reason) -> exception thrown
25
 
%%  Throw a nice-looking exception, similar to exceptions from erl_eval.
26
 
error(Reason) ->
27
 
    exit({Reason,[{erl_eval,expr,3}]}).
 
21
-export([expr_grp/3,expr_grp/5,match_bits/6, 
 
22
         match_bits/7,bin_gen/6]).
 
23
 
 
24
%% EXPERIMENTAL.
 
25
-export([bitlevel_binaries_enabled/0]).
 
26
 
 
27
%% EXPERIMENTAL feature used here: Don't use in applications!
 
28
-compile(bitlevel_binaries).
 
29
-compile(binary_comprehension).
 
30
 
 
31
%% Only to be used during development of bitlevel binaries to selectively
 
32
%% skip test suites. Will be removed in the future.
 
33
 
 
34
bitlevel_binaries_enabled() ->
 
35
    %% For testing and future development of the EXPERIMENTAL feature
 
36
    %% bitlevel binaries, the following line can be changed to true.
 
37
    false.
 
38
 
 
39
%% Types used in this module:
 
40
%% @type bindings(). An abstract structure for bindings between
 
41
%% variables and values (the environment)
 
42
%%
 
43
%% @type evalfun(). A closure which evaluates an expression given an
 
44
%% environment
 
45
%%
 
46
%% @type matchfun(). A closure which performs a match given a value, a
 
47
%% pattern and an environment
 
48
%%
 
49
%% @type field() represents a field in a "bin"
28
50
 
29
51
%%% Part 1: expression evaluation (binary construction)
30
52
 
31
 
expr_grp([], Bs0, _Lf, Bits0, _Call_maketype) ->
32
 
    Bits = lists:reverse(Bits0),
33
 
    Bits2 = lists:flatten(Bits),
34
 
    %% bits_to_bytes crashes if not multiple of 8.
35
 
    Bin = list_to_binary(bits_to_bytes(Bits2)),
36
 
    {value, Bin, Bs0};
37
 
expr_grp([Field | Fs], Bs0, Lf, Bits0, Call_maketype) ->
38
 
    {Bitl, Bs1} = expr_bit(Field, Bs0, Lf, Call_maketype),
39
 
    expr_grp(Fs, Bs1, Lf, [Bitl | Bits0], Call_maketype).
40
 
 
41
 
binary_to_bits(Bin, Size) ->
42
 
    sublist(binary_to_bits(Bin), Size).
43
 
 
44
 
binary_to_bits(Bin) ->
45
 
    bytes_to_bits(binary_to_list(Bin)).
46
 
 
47
 
-define(GET_BIT(Byte, Bit), (if
48
 
                                 Byte band Bit =:= 0 -> 0;
49
 
                                 true -> 1
50
 
                             end)).
51
 
 
52
 
bytes_to_bits(L) ->
53
 
    bytes_to_bits(lists:reverse(L), []).
54
 
 
55
 
bytes_to_bits([], Acc) -> Acc;
56
 
bytes_to_bits([H|T], Acc0) ->
57
 
    Acc = [?GET_BIT(H, 128),?GET_BIT(H, 64),?GET_BIT(H, 32),?GET_BIT(H, 16),
58
 
           ?GET_BIT(H, 8),?GET_BIT(H, 4),?GET_BIT(H, 2),?GET_BIT(H, 1)|Acc0],
59
 
    bytes_to_bits(T, Acc).
60
 
                                     
61
 
maketype(Size0, Options0, true) ->
62
 
    make_bit_type(0, Size0, Options0);
63
 
maketype(Size0, Options0, false) ->
64
 
    {Size0, Options0}.
65
 
 
66
 
expr_bit({bin_element, _, {string, _, S}, default, default}, Bs0, _Fun,
67
 
         _Call_maketype) ->
68
 
    {bytes_to_bits(S), Bs0};
69
 
expr_bit({bin_element, _Line, E, Size0, Options0}, Bs0, Fun, Call_maketype) ->
70
 
    %%format("bit expr ~w~n", [{bin_element, _Line, E, Size0, Options0}]),
 
53
%% @spec expr_grp(Fields::[field()], Bindings::bindings(), 
 
54
%%                EvalFun::evalfun()) -> 
 
55
%%                  {value, binary(), bindings()}
 
56
%%
 
57
%% @doc Returns a tuple with {value,Bin,Bs} where Bin is the binary
 
58
%% constructed from form the Fields under the current Bindings. Bs
 
59
%% contains the present bindings. This function can also throw an
 
60
%% exception if the construction fails.
 
61
 
 
62
expr_grp(Fields, Bindings, EvalFun, [], _) ->
 
63
    expr_grp(Fields, Bindings, EvalFun, <<>>);
 
64
expr_grp(Fields, Bindings, EvalFun, ListOfBits, _) ->
 
65
    Bin = convert_list(ListOfBits),
 
66
    expr_grp(Fields, Bindings, EvalFun, Bin).
 
67
 
 
68
convert_list(List) ->
 
69
  << <<X:1>> || X <- List >>.
 
70
 
 
71
expr_grp(Fields, Bindings, EvalFun) ->
 
72
    catch expr_grp(Fields, Bindings, EvalFun, <<>>).
 
73
 
 
74
expr_grp([Field | FS], Bs0, Lf, Acc) ->
 
75
    {Bin,Bs} = eval_field(Field, Bs0, Lf),
 
76
    expr_grp(FS, Bs, Lf, <<Acc/binary-unit:1,Bin/binary-unit:1>>);
 
77
expr_grp([], Bs0, _Lf, Acc) ->
 
78
    case bitlevel_binaries_enabled() of
 
79
        true -> ok;
 
80
        false ->
 
81
            case erlang:bitsize(Acc) rem 8 of
 
82
                0 -> ok;
 
83
                _ -> error(badarg)
 
84
            end
 
85
    end,
 
86
    {value,Acc,Bs0}.
 
87
 
 
88
eval_field({bin_element, _, {string, _, S}, default, default}, Bs0, _Fun) ->
 
89
    {list_to_binary(S),Bs0};
 
90
eval_field({bin_element,Line,E,Size0,Options0}, Bs0, Fun) ->
71
91
    {value, V, Bs1} = Fun(E, Bs0),
72
 
    {Size1, Options} = maketype(Size0, Options0, Call_maketype),
 
92
    {Size1, [Type,{unit,Unit},Sign,Endian]} = 
 
93
        make_bit_type(Line, Size0, Options0),
73
94
    {value, Size, Bs} = Fun(Size1, Bs1),
74
 
    %%format("bit expr ~w~n", [{bin_element, x, V, Size, Options}]),
75
 
    Bitl = to_binary(V, Size, Options),
76
 
    %%format("bit list ~w~n", [Bitl]),
77
 
    {Bitl, Bs}.
78
 
 
79
 
size_or_all(all, All) -> All;
80
 
size_or_all(N, _All) when N >= 0 -> N;
81
 
size_or_all(_N, _All) -> error(badarg).
82
 
 
83
 
to_binary(B0, Size0, [binary,{unit,Unit}|_]) when is_binary(B0) ->
84
 
    Size1 = size_or_all(Size0, size(B0)),
85
 
    binary_to_bits(B0, Size1*Unit);
86
 
to_binary(I, Size0, [integer,{unit,Unit}|Opts]) when is_integer(Size0),
87
 
                                                     Size0 >= 0,
88
 
                                                     is_integer(I) ->
89
 
    Size = Size0*Unit,
90
 
    L = i_to_bytes(I, Size),
91
 
    Bits = binary_to_bits(list_to_binary(L), Size),
92
 
    to_little_endian(Bits, Opts);
93
 
to_binary(F, Size0, [float,{unit,Unit}|Opts]) when is_integer(Size0),
94
 
                                                   Size0 >= 0,
95
 
                                                   is_float(F) or 
96
 
                                                       is_integer(F) ->
97
 
    Size = Size0*Unit,
98
 
    Bits = float_to_ieee(F, Size),
99
 
    to_little_endian(Bits, Opts);
100
 
to_binary(_, _Size0, _Options) ->
101
 
    error(badarg).
102
 
 
103
 
type_and_unit([Type,{unit,Unit}|_]) -> {Type,Unit}.
104
 
 
105
 
mod(N, M) ->
106
 
    case N rem M of
107
 
        X when X < 0 ->
108
 
            X+M;
109
 
        X ->
110
 
            X
111
 
    end.
112
 
 
113
 
pick_bits(_I, 0, L) -> L;
114
 
pick_bits(I, Size, L) ->
115
 
    pick_bits(I bsr 1, Size-1, [I band 1 | L]).
116
 
 
117
 
i_to_bytes(I, Size) ->
118
 
    L = pick_bits(I, Size, lists:duplicate(mod(-Size, 8), 0)),
119
 
    bits_to_bytes(L).
120
 
 
121
 
bits_to_bytes(L) ->
122
 
    bits_to_bytes(L, []).
123
 
 
124
 
bits_to_bytes([B7,B6,B5,B4,B3,B2,B1,B0|T], Acc) ->
125
 
    Byte = (B7 bsl 7) bor (B6 bsl 6) bor
126
 
        (B5 bsl 5) bor (B4 bsl 4) bor (B3 bsl 3) bor
127
 
        (B2 bsl 2) bor (B1 bsl 1) bor B0,
128
 
    bits_to_bytes(T, [Byte|Acc]);
129
 
bits_to_bytes([], Acc) -> lists:reverse(Acc);
130
 
bits_to_bytes(_, _) -> error(badarg).
131
 
 
132
 
%%% Big-endian serves as our native format here (regardless of what
133
 
%%% the endianness of the machine is). This is convenient, since the
134
 
%%% bit order within a byte is big-endian always.
135
 
%%% When a bit sequence consists of a number of 8-bit bytes, and a rest
136
 
%%% with less than 8 bits, the rest is at the start of the sequence for
137
 
%%% big-endian, at the end for little-endian.
138
 
 
139
 
to_little_endian(B, Opts) ->
140
 
    case is_little_endian(Opts) of
141
 
        false -> B;
142
 
        true ->
143
 
            %% an incomplete byte is at the start in the input
144
 
            L = length(B),
145
 
            P = L rem 8,
146
 
            {Piece, Rest} = split_list(P, B),
147
 
            R_big = bits_to_bytes(Rest),
148
 
            R_little = lists:reverse(R_big),
149
 
            bytes_to_bits(R_little) ++ Piece
150
 
    end.
151
 
 
152
 
from_little_endian(B, Opts) ->
153
 
    case is_little_endian(Opts) of
154
 
        false -> B;
155
 
        true ->
156
 
            %% an incomplete byte is at the end in the input
157
 
            L = length(B),
158
 
            P = L rem 8,
159
 
            {Rest, Piece} = split_list(L-P, B),
160
 
            R_little = bits_to_bytes(Rest),
161
 
            R_big = lists:reverse(R_little),
162
 
            Piece ++ bytes_to_bits(R_big)
163
 
    end.
164
 
 
165
 
is_little_endian(Opts) ->
166
 
    member(little, Opts) orelse (erlang:system_info(endian) == little andalso
167
 
                                 member(native, Opts)).
168
 
 
169
 
float_to_ieee(F, Size) ->
170
 
    Bin = case catch <<F:Size/float>> of
171
 
              {'EXIT',{badarg,_}} -> error(badarg);
172
 
              {'EXIT',_}=Bad -> exit(Bad);
173
 
              Other -> Other
174
 
          end,
175
 
    binary_to_bits(Bin).
 
95
    {eval_exp_field1(V, Size, Unit, Type, Endian, Sign),Bs}.
 
96
 
 
97
eval_exp_field1(V, Size, Unit, Type, Endian, Sign) ->
 
98
    case catch eval_exp_field(V, Size, Unit, Type, Endian, Sign) of
 
99
        <<Val/bitstr>> -> Val;
 
100
        _ -> error(badarg)
 
101
    end.
 
102
 
 
103
eval_exp_field(Val, Size, Unit, integer, little, signed) ->
 
104
    <<Val:(Size*Unit)/little-signed>>;
 
105
eval_exp_field(Val, Size, Unit, integer, little, unsigned) ->
 
106
    <<Val:(Size*Unit)/little>>;
 
107
eval_exp_field(Val, Size, Unit, integer, native, signed) ->
 
108
    <<Val:(Size*Unit)/native-signed>>;
 
109
eval_exp_field(Val, Size, Unit, integer, native, unsigned) ->
 
110
    <<Val:(Size*Unit)/native>>;
 
111
eval_exp_field(Val, Size, Unit, integer, big, signed) ->
 
112
    <<Val:(Size*Unit)/signed>>;
 
113
eval_exp_field(Val, Size, Unit, integer, big, unsigned) ->
 
114
    <<Val:(Size*Unit)>>;
 
115
eval_exp_field(Val, Size, Unit, float, little, _) ->
 
116
    <<Val:(Size*Unit)/float-little>>;
 
117
eval_exp_field(Val, Size, Unit, float, native, _) ->
 
118
    <<Val:(Size*Unit)/float-native>>;
 
119
eval_exp_field(Val, Size, Unit, float, big, _) ->
 
120
    <<Val:(Size*Unit)/float>>;
 
121
eval_exp_field(Val, all, _Unit, binary, _, _) ->
 
122
    Size = erlang:bitsize(Val),
 
123
    <<Val:Size/binary-unit:1>>;
 
124
eval_exp_field(Val, Size, Unit, binary, _, _) ->
 
125
    <<Val:(Size*Unit)/binary-unit:1>>.
 
126
 
 
127
%%% Part 2: matching in binary comprehensions
 
128
%% @spec bin_gen(BinPattern::{bin,integer(),[field()]}, Bin::binary(),
 
129
%%               GlobalEnv::bindings(), LocalEnv::bindings(),  
 
130
%%               MatchFun::matchfun(), EvalFun::evalfun()) -> 
 
131
%%                 {match, binary(), bindings()} | {nomatch, binary()} | done
 
132
%%
 
133
%% @doc Used to perform matching in a comprehension. If the match
 
134
%% succeeds a new environment and what remains of the binary is
 
135
%% returned. If the match fails what remains of the binary is returned.
 
136
%% If nothing remains of the binary the atom 'done' is returned.
 
137
 
 
138
bin_gen({bin,_,Fs}, Bin, Bs0, BBs0, Mfun, Efun) ->
 
139
    bin_gen(Fs, Bin, Bs0, BBs0, Mfun, Efun, true).
 
140
 
 
141
bin_gen([F|Fs], Bin, Bs0, BBs0, Mfun, Efun, Flag) ->
 
142
    case bin_gen_field(F, Bin, Bs0, BBs0, Mfun, Efun) of
 
143
        {match,Bs,BBs,Rest} ->
 
144
            bin_gen(Fs, Rest, Bs, BBs, Mfun, Efun, Flag);
 
145
        {nomatch,Rest} ->
 
146
            bin_gen(Fs, Rest, Bs0, BBs0, Mfun, Efun, false);
 
147
        done ->
 
148
            done
 
149
    end;
 
150
bin_gen([], Bin, Bs0, _BBs0, _Mfun, _Efun, true) ->
 
151
    {match, Bin, Bs0};
 
152
bin_gen([], Bin, _Bs0, _BBs0, _Mfun, _Efun, false) ->
 
153
    {nomatch, Bin}.
 
154
  
 
155
bin_gen_field({bin_element,_,{string,_,S},default,default},
 
156
              Bin, Bs, BBs, _Mfun, _Efun) ->
 
157
    Bits = list_to_binary(S),
 
158
    Size = size(Bits),
 
159
    case Bin of
 
160
        <<Bits:Size/binary,Rest/bitstr>> ->
 
161
            {match,Bs,BBs,Rest};
 
162
        <<_:Size/binary,Rest/bitstr>> ->
 
163
            {nomatch,Rest};
 
164
        _ ->
 
165
            done
 
166
    end;
 
167
bin_gen_field({bin_element,Line,VE,Size0,Options0}, 
 
168
              Bin, Bs0, BBs0, Mfun, Efun) ->
 
169
    {Size1, [Type,{unit,Unit},Sign,Endian]} = 
 
170
        make_bit_type(Line, Size0, Options0),
 
171
    V = erl_eval:partial_eval(VE),
 
172
    match_check_size(Size1, BBs0),
 
173
    {value, Size, _BBs} = Efun(Size1, BBs0),
 
174
    case catch get_value(Bin, Type, Size, Unit, Sign, Endian) of
 
175
        {Val,Rest} when is_binary(Rest) ->
 
176
            NewV = coerce_to_float(V, Type),
 
177
            case catch Mfun(NewV, Val, Bs0) of
 
178
                {match,Bs} ->
 
179
                    BBs = add_bin_binding(NewV, Bs, BBs0),
 
180
                    {match,Bs,BBs,Rest};
 
181
                _ ->
 
182
                    {nomatch,Rest}
 
183
            end;
 
184
        _ ->
 
185
            done
 
186
    end.
 
187
 
 
188
%%% Part 3: binary pattern matching 
 
189
%% @spec match_bits(Fields::[field()], Bin::binary()
 
190
%%                  GlobalEnv::bindings(), LocalEnv::bindings(),  
 
191
%%                  MatchFun::matchfun(),EvalFun::evalfun()) -> 
 
192
%%                  {match, bindings()} 
 
193
%% @doc Used to perform matching. If the match succeeds a new
 
194
%% environment is returned. If the match have some syntactic or
 
195
%% semantic problem which would have been caught at compile time this
 
196
%% function throws 'invalid', if the matching fails for other reasons
 
197
%% the function throws 'nomatch'
 
198
 
 
199
match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun, _) ->
 
200
    match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun).
 
201
 
 
202
match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun) ->
 
203
    case catch match_bits_1(Fs, Bin, Bs0, BBs, Mfun, Efun) of
 
204
        {match,Bs} -> {match,Bs};
 
205
        invalid -> throw(invalid);
 
206
        _Error -> throw(nomatch)
 
207
    end.
 
208
 
 
209
match_bits_1([], <<>>,  Bs, _BBs, _Mfun, _Efun) -> 
 
210
    {match,Bs};
 
211
match_bits_1([F|Fs], Bits0, Bs0, BBs0, Mfun, Efun) ->
 
212
    {Bs,BBs,Bits} = match_field_1(F, Bits0, Bs0, BBs0, Mfun, Efun),
 
213
    match_bits_1(Fs, Bits, Bs, BBs, Mfun, Efun).
 
214
 
 
215
match_field_1({bin_element,_,{string,_,S},default,default},
 
216
              Bin, Bs, BBs, _Mfun, _Efun) ->
 
217
    Bits = list_to_binary(S),
 
218
    Size = size(Bits),
 
219
    <<Bits:Size/binary,Rest/binary-unit:1>> = Bin,
 
220
    {Bs,BBs,Rest};
 
221
match_field_1({bin_element,Line,VE,Size0,Options0}, 
 
222
              Bin, Bs0, BBs0, Mfun, Efun) ->
 
223
    {Size1, [Type,{unit,Unit},Sign,Endian]} = 
 
224
        make_bit_type(Line, Size0, Options0),
 
225
    V = erl_eval:partial_eval(VE),
 
226
    match_check_size(Size1,BBs0),
 
227
    {value, Size, _BBs} = Efun(Size1, BBs0),
 
228
    {Val,Rest} = get_value(Bin, Type, Size, Unit, Sign, Endian),
 
229
    NewV = coerce_to_float(V, Type),
 
230
    {match,Bs} = Mfun(NewV, Val, Bs0),
 
231
    BBs = add_bin_binding(NewV, Bs, BBs0),
 
232
    {Bs,BBs,Rest}.
 
233
 
 
234
%% Almost identical to the one in sys_pre_expand.
 
235
coerce_to_float({integer,L,I}=E, float) ->
 
236
    try
 
237
        {float,L,float(I)}
 
238
    catch
 
239
        error:badarg -> E;
 
240
        error:badarith -> E
 
241
    end;
 
242
coerce_to_float(E, _Type) -> 
 
243
    E.
 
244
 
 
245
add_bin_binding({var,_,'_'}, _Bs, BBs) ->
 
246
    BBs;
 
247
add_bin_binding({var,_,Name}, Bs, BBs) ->
 
248
    {value,Value} = erl_eval:binding(Name, Bs),
 
249
    erl_eval:add_binding(Name, Value, BBs);
 
250
add_bin_binding(_, _Bs, BBs) ->
 
251
    BBs.
 
252
 
 
253
get_value(Bin, integer, Size, Unit, Sign, Endian) ->
 
254
    get_integer(Bin, Size*Unit, Sign, Endian);
 
255
get_value(Bin, float, Size, Unit, _Sign, Endian) ->
 
256
    get_float(Bin, Size*Unit, Endian);
 
257
get_value(Bin, binary, all, Unit, _Sign, _Endian) ->
 
258
    0 = (erlang:bitsize(Bin) rem Unit),
 
259
    maybe_disallow_bitlevel_binary(Bin),
 
260
    {Bin,<<>>};
 
261
get_value(Bin, binary, Size, Unit, _Sign, _Endian) ->
 
262
    TotSize = Size*Unit,
 
263
    <<Val:TotSize/bitstr,Rest/bitstr>> = Bin,
 
264
    maybe_disallow_bitlevel_binary(Val),
 
265
    {Val,Rest}.
 
266
 
 
267
maybe_disallow_bitlevel_binary(Bin) ->
 
268
    case bitlevel_binaries_enabled() of
 
269
        false ->
 
270
            0 = erlang:bitsize(Bin) rem 8;
 
271
        true ->
 
272
            ok
 
273
    end.
 
274
 
 
275
get_integer(Bin, Size, signed, little) ->
 
276
    <<Val:Size/little-signed,Rest/binary-unit:1>> = Bin,
 
277
    {Val,Rest};
 
278
get_integer(Bin, Size, unsigned, little) ->
 
279
    <<Val:Size/little,Rest/binary-unit:1>> = Bin,
 
280
    {Val,Rest};
 
281
get_integer(Bin, Size, signed, native) ->
 
282
    <<Val:Size/native-signed,Rest/binary-unit:1>> = Bin,
 
283
    {Val,Rest};
 
284
get_integer(Bin, Size, unsigned, native) ->
 
285
    <<Val:Size/native,Rest/binary-unit:1>> = Bin,
 
286
    {Val,Rest};
 
287
get_integer(Bin, Size, signed, big) ->
 
288
    <<Val:Size/signed,Rest/binary-unit:1>> = Bin,
 
289
    {Val,Rest};
 
290
get_integer(Bin, Size, unsigned, big) ->
 
291
    <<Val:Size,Rest/binary-unit:1>> = Bin,
 
292
    {Val,Rest}.
 
293
 
 
294
get_float(Bin, Size, little) -> 
 
295
    <<Val:Size/float-little,Rest/binary-unit:1>> = Bin,
 
296
    {Val,Rest};
 
297
get_float(Bin, Size, native) -> 
 
298
    <<Val:Size/float-native,Rest/binary-unit:1>> = Bin,
 
299
    {Val,Rest};
 
300
get_float(Bin, Size, big) -> 
 
301
    <<Val:Size/float,Rest/binary-unit:1>> = Bin,
 
302
    {Val,Rest}.
176
303
 
177
304
%% Identical to the one in sys_pre_expand.
178
305
make_bit_type(Line, default, Type0) ->
179
306
    case erl_bits:set_bit_type(default, Type0) of
180
 
        {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)};
181
 
        {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)};
 
307
        {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)};
 
308
        {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)};
182
309
        {error,Reason} -> error(Reason)
183
310
    end;
184
311
make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all'
187
314
        {error,Reason} -> error(Reason)
188
315
    end.
189
316
 
190
 
%%% Part 2: matching
191
 
 
192
 
match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun, Call_maketype) ->
193
 
    case catch match_bits1(Fs, Bin, Bs0, BBs, Mfun, Efun, Call_maketype) of
194
 
        {match,Bs} -> {match,Bs};
195
 
        invalid -> throw(invalid);
196
 
        _Error -> throw(nomatch)
197
 
    end.
198
 
 
199
 
match_bits1([], <<>>, Bs, _BBs, _Mfun, _Efun, _Call_maketype) -> {match,Bs};
200
 
match_bits1([F|Fs], Bits0, Bs0, BBs0, Mfun, Efun, Call_maketype) ->
201
 
    %%format("matching ~w ~w~n", [F, Bits0]),
202
 
    {Bs,BBs,Bits} = match_field(F, Bits0, Bs0, BBs0, Mfun, Efun, Call_maketype),
203
 
    %%format("left ~w~n", [Bits]),
204
 
    match_bits1(Fs, Bits, Bs, BBs, Mfun, Efun, Call_maketype).
205
 
 
206
 
bits_to_int([1|_]=Bits, true) -> bits_to_int2(Bits, -1);
207
 
bits_to_int(Bits, _) -> bits_to_int2(Bits, 0).
208
 
 
209
 
bits_to_int2([], Acc) -> Acc;
210
 
bits_to_int2([Bit|Rest], Acc) ->
211
 
    bits_to_int2(Rest, Acc+Acc+Bit).
212
 
 
213
 
match_field({bin_element,_,{string,_,S},default,default},
214
 
            Bin, Bs, BBs, _Mfun, _Efun, _Call_maketype) ->
215
 
    Tail = foldl(fun(C, <<C:8,Tail/binary>>) -> Tail;
216
 
                    (C, Bits0) ->
217
 
                         {Bits,Tail} = get_bits(Bits0, 8),
218
 
                         [C] = bits_to_bytes(Bits),
219
 
                         Tail
220
 
                 end, Bin, S),
221
 
    {Bs,BBs,Tail};
222
 
match_field({bin_element,L,E,default,[binary|_]=Opts}, Bin, Bs0, BBs, 
223
 
            Mfun, Efun, Call_maketype) ->
224
 
     match_field({bin_element,L,E,{atom,L,all},Opts}, Bin, Bs0, BBs, Mfun,
225
 
                 Efun, Call_maketype);
226
 
match_field({bin_element, _,E0,Size0,Options0}, Bin, Bs0, BBs, Mfun, Efun,
227
 
            Call_maketype) ->
228
 
    {Size1,Options} = maketype(Size0, Options0, Call_maketype),
229
 
    E = coerce_to_float(E0,Options),
230
 
    match_check_size(Size1, BBs),
231
 
    case Efun(Size1, BBs) of
232
 
        {value,all,_} when binary(Bin) ->
233
 
            {match,Bs} = Mfun(E, Bin, Bs0),
234
 
            Val = <<>>,
235
 
            {Bs,add_bin_binding(E, Val, BBs),Val};
236
 
        {value,Size,_} when Size >= 0 ->
237
 
            {Type,Unit} = type_and_unit(Options),
238
 
            {Val,Tail} = match_thing(Type, Options, Size*Unit, Bin),
239
 
            {match,Bs} = Mfun(E, Val, Bs0),
240
 
            {Bs,add_bin_binding(E, Val, BBs),Tail}
241
 
    end.
242
 
 
243
 
%% Identical to the one in sys_pre_expand.
244
 
coerce_to_float({integer,L,I}=E, [float|_]) ->
245
 
    try
246
 
        {float,L,float(I)}
247
 
    catch
248
 
        error:badarg -> E;
249
 
        error:badarith -> E
250
 
    end;
251
 
coerce_to_float(E, _) -> E.
252
 
    
253
 
add_bin_binding({var,_,Var}, Val, BBs) ->
254
 
    erl_eval:add_binding(Var, Val, BBs);
255
 
add_bin_binding(_, _, BBs) -> BBs.
256
 
 
257
 
match_thing(binary, _Opts, Size, Bin) when Size rem 8 =:= 0, binary(Bin) ->
258
 
    split_binary(Bin, Size div 8);
259
 
match_thing(binary, _Opts, Size, Bin) ->
260
 
    {Bits,Tail} = get_bits(Bin, Size),
261
 
    {list_to_binary(bits_to_bytes(Bits)),Tail};
262
 
match_thing(integer, Opts, Size, Bin) ->
263
 
    {Bits0,Tail} = get_bits(Bin, Size),
264
 
    Bits1 = from_little_endian(Bits0, Opts),
265
 
    {bits_to_int(Bits1, member(signed, Opts)),Tail};
266
 
match_thing(float, Opts, Size, Bin) ->
267
 
    {Bits0,Tail} = get_bits(Bin, Size),
268
 
    Bits1 = from_little_endian(Bits0, Opts),
269
 
    <<Float:Size/float>> = list_to_binary(bits_to_bytes(Bits1)),
270
 
    {Float,Tail};
271
 
match_thing(_Type, _Opts, _Size, _Bin) ->
272
 
    %%erlang:display({_Type,_Opts,_Size,_Bin}), "cannot happen"
273
 
    error(badarg).
274
 
 
275
317
match_check_size({var,_,V}, Bs) -> 
276
318
    case erl_eval:binding(V, Bs) of
277
319
        {value,_} -> ok;
278
320
        unbound -> throw(invalid) % or, rather, error({unbound,V})
279
321
    end;
280
 
match_check_size({atom,_,all}, _Bs) -> ok;
281
 
match_check_size({integer,_,_}, _Bs) -> ok;
282
 
match_check_size({value,_,_}, _Bs) -> ok;       %From the debugger.
283
 
match_check_size(_, _Bs) -> throw(invalid).
284
 
 
285
 
get_bits(Bin0, N) when binary(Bin0), N rem 8 =:= 0 ->
286
 
    <<Bin:N/binary-unit:1,Tail/binary>> = Bin0,
287
 
    {bytes_to_bits(binary_to_list(Bin)),Tail};
288
 
get_bits(Bin, N) when binary(Bin) ->
289
 
    get_bits({[],0,Bin}, N);
290
 
get_bits({Bits,N,Bin}, N) -> {Bits,Bin};
291
 
get_bits({Bits,N,Bin}, Need) when Need < N ->
292
 
    {sublist(Bits, Need),{lists:nthtail(Need, Bits),N-Need,Bin}};
293
 
get_bits({Bits0,N,Bin0}, Need) ->
294
 
    BytesNeeded = (Need-N+7) div 8,
295
 
    <<Bin:BytesNeeded/binary,Tail/binary>> = Bin0,
296
 
    Bits = Bits0 ++ bytes_to_bits(binary_to_list(Bin)),
297
 
    case 8*size(Bin)+N of
298
 
        Need ->
299
 
            {Bits,Tail};
300
 
        Have ->
301
 
            {sublist(Bits, Need),{lists:nthtail(Need, Bits),Have-Need,Tail}}
302
 
    end.
303
 
 
304
 
split_list(N, List) ->
305
 
    {sublist(List, N), lists:nthtail(N, List)}.
306
 
 
307
 
%% sublist that doesn't allow longer N than the list.
308
 
sublist([E|Rest], N) when integer(N), N > 0 ->
309
 
    [E | sublist(Rest, N-1)];
310
 
sublist([], 0) ->
311
 
    [];
312
 
sublist([_|_], 0) ->
313
 
    [];
314
 
sublist(_, _) ->
315
 
    error(badarg).
316
 
 
317
 
-ifdef(debug).
318
 
%%% Trace output.
319
 
format(_Fmt, _Args) ->
320
 
    io:format(_Fmt, _Args),
321
 
    ok.
322
 
-endif.
 
322
match_check_size({atom,_,all}, _Bs) ->
 
323
    ok;
 
324
match_check_size({integer,_,_}, _Bs) ->
 
325
    ok;
 
326
match_check_size({value,_,_}, _Bs) ->
 
327
    ok; %From the debugger.
 
328
match_check_size(_, _Bs) -> 
 
329
    throw(invalid).
 
330
 
 
331
%% error(Reason) -> exception thrown
 
332
%%  Throw a nice-looking exception, similar to exceptions from erl_eval.
 
333
error(Reason) ->
 
334
    erlang:raise(error, Reason, [{erl_eval,expr,3}]).
 
335