1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2% Copyright (c) 2009, 2011, ETH Zurich.
3% All rights reserved.
4%
5% This file is distributed under the terms in the attached LICENSE file.
6% If you do not find this file, copies can be found by writing to:
7% ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group.
8%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
9
10:-lib(ic).
11:-use_module(library(ic_edge_finder)).
12
13:-dynamic(bridge/4).
14:-dynamic(bar/5).
15
16% :-include("../data/data_nos6.txt").
17% :-include("../data/data_qemu_hand.txt").
18% :-include("../data/data_qemu.txt").
19% :-include("../data/data_nos4.txt").
20% :-include("../data/data_nos5.txt").
21% :-include("../data/data_hand.txt").
22
23% asq: important: this entry _has_ to be here all the time!!
24bridge(addr(0,0,0),0,0,secondary(0)).
25bar(addr(0,0,0),0,0,5,mem).
26
27
28%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
29% main goal to be called from outside
30%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
31
32bridge_programming(Plan) :-
33%    findall(memory_region(Base,Bits,Size,Type,Data),(
34%                   memory_region(Base,Bits,Size,Type,Data),
35%                   mem_region_type(Type,phyaddr)),
36%            PhysList),
37%    sort(2, >=, PhysList, PhysListSorted),
38%    writeln(PhysListSorted),
39    findall(root(Addr,Child,Mem),rootbridge(Addr,Child,Mem),Roots),
40    ( foreach(Root,Roots),
41      foreach(P,Plan)
42      do
43        bridge_assignment(P,Root)
44    ).
45
46adjust_range(X, buselement(T,A,Sec,B1,H1,S), buselement(T,A,Sec,B2,H2,S)) :-
47    B2 is B1 + X,
48    H2 is H1 + X.
49
50bridge_assignment(Plan, Root) :-
51    root(Addr,childbus(MinBus,MaxBus),mem(LMem,HMem)) = Root,
52    X is HMem - LMem,
53    constrain_bus(Addr,MinBus,MaxBus,0,X,BusElementList),
54    RBase::[0..X],
55    RHigh::[0..X],
56    RSize::[0..X],
57    devicetree(BusElementList,buselement(bridge,Addr,secondary(MinBus),RBase,RHigh,RSize),T),
58    writeln(tree),
59    writeln(T),
60    setrange(T,_,_,_),
61    nonoverlap(T),
62%    naturally_aligned(T,LMem),
63%    naturally_aligned_range(T, LMem, 0, X),
64    naturally_aligned_mul(T, LMem, LMem, HMem),
65    bridge_min_size(T, 100),
66    tree2list(T,Lista),
67%    not_overlap_ioapic(Lista, LMem),
68%    keep_orig_address(Lista,[addr(0,9,0)],LMem),
69    labelall(Lista),
70    subtract(Lista,[buselement(bridge,Addr,_,_,_,_)],Pl),
71    maplist(adjust_range(LMem),Pl,Plan).
72
73
74
75%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
76% instantiating the variables
77%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
78
79base(buselement(_,_,_,Base,_,_),Base).
80high(buselement(_,_,_,_,High,_),High).
81size(buselement(_,_,_,_,_,Size),Size).
82
83labelall(BusElementList) :-
84    maplist(base, BusElementList, Base),
85    maplist(high, BusElementList, High),
86    maplist(size, BusElementList, Size),
87    append(Base, High, L1),
88    append(L1, Size, L2),
89    labeling(L2).
90
91
92
93%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
94% create the list of devices and bridges in form of buselements and create the
95% variables.
96% we care about the allocation of memory mapped registers here, therefore we only
97% look at bar located in "mem", not "io"
98%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
99
100constrain_bus(_,Bus,MaxBus,_,_,[]) :- Bus > MaxBus.
101constrain_bus(RootAddr,Bus,MaxBus,LMem,HMem,NewBusElementList) :-
102    Bus =< MaxBus,
103    findall(buselement(bridge,addr(Bus,Dev,Fun),secondary(Sec),Base,High,Size),
104            ( bridge(addr(Bus,Dev,Fun), _, _, secondary(Sec)),
105              not addr(Bus,Dev,Fun) = RootAddr,
106              SMax is HMem - LMem,
107              Base::[LMem..HMem],High::[LMem..HMem],Size::[0..SMax]
108            ),BridgeList),
109    findall(buselement(device,addr(Bus,Dev,Fun),BAR,Base,High,Size),
110            ( device(_, addr(Bus,Dev,Fun),_,_,_,_,_,_),
111              bar(addr(Bus,Dev,Fun),BAR,_,Size, mem),
112              Base::[LMem..HMem],High::[LMem..HMem]
113            ),DeviceList),
114    append(BridgeList, DeviceList, BusElementList),
115    NextBus is Bus + 1,
116    constrain_bus(RootAddr, NextBus, MaxBus, LMem,HMem,List),
117    append(List,BusElementList,NewBusElementList).
118
119
120%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
121% create the PCI(e) device tree from a list of "buselement" and return it in Tree
122%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
123
124devicetree(List,CurrRoot,Tree) :-
125    buselement(bridge,_,secondary(Sec),_,_,_) = CurrRoot,
126    findall(X,(
127               member(Y,List),
128               buselement(_,addr(Sec,_,_),_,_,_,_) = Y,
129               devicetree(List, Y, X)),Children
130           ),
131    Tree = t(CurrRoot,Children).
132devicetree(_,CurrRoot,Tree) :-
133    buselement(device,_,_,_,_,_) = CurrRoot,
134    Tree = t(CurrRoot, []).
135
136
137%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
138% convert a tree to a list of buselements
139%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
140
141tree2list([],[]).
142tree2list(Tree, List) :-
143    t(Node,Children) = Tree,
144    ( foreach(El,Children),
145      foreach(L1,ChildList)
146      do
147        tree2list(El,L1)
148    ),
149    flatten(ChildList,L2),
150    List = [Node|L2].
151
152
153%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
154% add constraints to the tree
155%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
156
157% make sure that the bridge has a range which includes all the children
158setrange(Tree,SubTreeSize,SubTreeMin,SubTreeMax) :-
159    t(Node,Children) = Tree,
160    writeln(Node),
161    ( foreach(El,Children),
162      foreach(Sz,SizeList),
163      foreach(Mi,MinList),
164      foreach(Ma,MaxList)
165      do
166        setrange(El,Sz,Mi,Ma)
167    ),
168    writeln(a),
169    ic_global:sumlist(SizeList,Size),
170    writeln(b),
171    buselement(_,_,_,Base,High,ElemSize) = Node,
172    write(elemsize),write(ElemSize),write(size),write(Size),
173    writeln(c),
174    ElemSize $>= Size,
175    writeln(d),
176    ( not MinList=[] ->
177        writeln(e),
178        ic:minlist(MinList,Min),
179        writeln(f),
180        ic:maxlist(MaxList,Max),
181        writeln(g),
182        Min $>= Base,
183        writeln(h),
184        Max $=< High;
185        writeln(i),
186        true
187    ),
188    writeln(j),
189    High $= Base + ElemSize,
190    writeln(k),
191    SubTreeSize $= ElemSize,
192    writeln(l),
193    SubTreeMin $= Base,
194    writeln(m),
195    SubTreeMax $= High,
196    writeln(n).
197setrange([],0,_,_).
198
199
200% make sure that the children do not overlap
201child(t(C,_),C).
202nonoverlap(Tree) :-
203    t(_ ,Children) = Tree,
204    maplist(child,Children,ChildList),
205    ( not ChildList=[] ->
206        maplist(base,ChildList,Base),
207        maplist(size,ChildList,Size),
208        disjunctive(Base,Size);
209        true
210    ),
211    ( foreach(El, Children)
212      do
213        nonoverlap(El)
214    ).
215
216
217% make sure that device bases are naturally aligned
218naturally_aligned(Tree,Shift) :-
219    t(Node,Children) = Tree,
220    ( buselement(device,_,_,Base,_,Size) = Node ->
221      B1 $= Base + Shift,
222      suspend(mod(B1,Size,0),3,B1->inst)
223      ;
224      ( foreach(El, Children),
225        param(Shift)
226        do
227          naturally_aligned(El,Shift)
228      )
229    ).
230
231
232naturally_aligned_range(Tree, Shift, Min, Max) :-
233    t(Node, Children) = Tree,
234    ( buselement(device,_,_,Base,_,Size) = Node ->
235      ( for(I,Min,Max,Size),
236        foreach(B1,Bases),
237        param(Shift)
238        do
239          B1 is I - Shift
240      ),
241      Base::Bases
242      ;
243      ( foreach(El, Children),
244        param(Shift),
245        param(Min),
246        param(Max)
247        do
248          naturally_aligned_range(El, Shift, Min, Max)
249      )
250   ).
251
252
253% N::[0..262000],Size=4096,Shift=1000000000,Base::[0..40000000],Base $= N*Size - Shift,labeling([Base]).
254% make sure that device bases are naturally aligned
255naturally_aligned_mul(Tree,Shift, Low, High) :-
256    t(Node,Children) = Tree,
257    ( buselement(device,_,_,Base,_,Size) = Node ->
258      T1 is (High - Low) / Size,
259      ceiling(T1, T2),
260      integer(T2, Nr),
261      N::[0..Nr],
262      mod(Low,Size,Remainder),
263      Corr is Size - Remainder,
264      Base $= N*Size + Low + Corr - Shift
265      ;
266      ( foreach(El, Children),
267        param(Shift),
268        param(Low),
269        param(High)
270        do
271          naturally_aligned_mul(El,Shift, Low, High)
272      )
273    ).
274
275
276
277% a bridge decodes at least a certain amount of memory (due to the granularity
278% in the decoder register
279bridge_min_size(Tree, MinAmount) :-
280    t(Node,Children) = Tree,
281    ( buselement(bridge,_,_,_,_,Size) = Node ->
282      Size $>= MinAmount,
283      ( foreach(El, Children),
284        param(MinAmount)
285        do
286          bridge_min_size(El, MinAmount)
287      )
288      ;
289      true
290    ).
291
292% do not overlap with IOAPIC addresses
293not_overlap_ioapic(List, LMem) :-
294    findall(Bs,(ioapic(_,B,_), Bs is B - LMem),IOAPIC_Bases),
295    ( foreach(_,IOAPIC_Bases),
296      foreach(S,IOAPIC_Sizes)
297        do
298          S $= 100
299    ),
300    ( foreach(El,List),
301      param(IOAPIC_Bases),
302      param(IOAPIC_Sizes)
303      do
304      buselement(_,_,_,Base,_,Size) = El,
305      append([Base],IOAPIC_Bases,Bases),
306      append([Size],IOAPIC_Sizes,Sizes),
307      disjunctive(Bases,Sizes)
308    ).
309
310% some devices we do not want to move, like the VGA device, because otherwise we
311% loose our console temporarly
312keep_orig_addr(Device,DeviceAddresses,Offset) :-
313    ( foreach(Addr, DeviceAddresses),
314      param(Device),
315      param(Offset)
316      do
317        ( (bar(Addr,_,Base,_,_),
318           buselement(_,Addr,_,B,_,_) = Device) ->
319           B $= (Base - Offset)
320           ;
321           true
322        )
323    ).
324keep_orig_address(List,DeviceAddresses,Offset) :-
325    ( foreach(D,List),
326      param(DeviceAddresses),
327      param(Offset)
328      do
329        keep_orig_addr(D,DeviceAddresses,Offset)
330    ).
331
332