1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2016. 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(sys_sp2).
21-export([start_link/1]).
22-export([alloc/0, free/1]).
23-export([init/1]).
24-export([system_continue/3, system_terminate/4,
25         write_debug/3]).
26
27%% Implements the ch4 example from the Design Principles doc.  Same as
28%% sys_sp1 except this module does not export system_get_state/1 or
29%% system_replace_state/2
30
31start_link(NumCh) ->
32    proc_lib:start_link(?MODULE, init, [[self(),NumCh]]).
33
34alloc() ->
35    ?MODULE ! {self(), alloc},
36    receive
37        {?MODULE, Res} ->
38            Res
39    end.
40
41free(Ch) ->
42    ?MODULE ! {free, Ch},
43    ok.
44
45init([Parent,NumCh]) ->
46    register(?MODULE, self()),
47    Chs = channels(NumCh),
48    Deb = sys:debug_options([]),
49    proc_lib:init_ack(Parent, {ok, self()}),
50    loop(Chs, Parent, Deb).
51
52loop(Chs, Parent, Deb) ->
53    receive
54        {From, alloc} ->
55            Deb2 = sys:handle_debug(Deb, fun write_debug/3,
56                                    ?MODULE, {in, alloc, From}),
57            {Ch, Chs2} = alloc(Chs),
58            From ! {?MODULE, Ch},
59            Deb3 = sys:handle_debug(Deb2, fun write_debug/3,
60                                    ?MODULE, {out, {?MODULE, Ch}, From}),
61            loop(Chs2, Parent, Deb3);
62        {free, Ch} ->
63            Deb2 = sys:handle_debug(Deb, fun write_debug/3,
64                                    ?MODULE, {in, {free, Ch}}),
65            Chs2 = free(Ch, Chs),
66            loop(Chs2, Parent, Deb2);
67        {system, From, Request} ->
68            sys:handle_system_msg(Request, From, Parent,
69                                  ?MODULE, Deb, Chs)
70    end.
71
72system_continue(Parent, Deb, Chs) ->
73    loop(Chs, Parent, Deb).
74
75system_terminate(Reason, _Parent, _Deb, _Chs) ->
76    exit(Reason).
77
78write_debug(Dev, Event, Name) ->
79    io:format(Dev, "~p event = ~p~n", [Name, Event]).
80
81channels(NumCh) ->
82    {_Allocated=[], _Free=lists:seq(1,NumCh)}.
83
84alloc({_, []}) ->
85    {error, "no channels available"};
86alloc({Allocated, [H|T]}) ->
87    {H, {[H|Allocated], T}}.
88
89free(Ch, {Alloc, Free}=Channels) ->
90    case lists:member(Ch, Alloc) of
91        true ->
92            {lists:delete(Ch, Alloc), [Ch|Free]};
93        false ->
94            Channels
95    end.
96