1:-lib(ic).
2:-lib(ic_global).
3:-use_module(library(ic_edge_finder)).
4
5:- set_flag(print_depth, 200).
6
7:-dynamic(currentbar/5).
8
9% :-include("../data/data_hand.txt").
10% :-include("../data/data_qemu_hand.txt").
11% :-include("../data/data_qemu.txt").
12% :-include("../data/data_nos3.txt").
13% :-include("../data/data_nos4.txt").
14% :-include("../data/data_nos5.txt").
15% :-include("../data/data_nos6.txt").
16% :-include("../data/data_gruyere.txt").
17% :-include("../data/data_sbrinz1.txt").
18% :-include("../data/data_loner.txt").
19
20
21
22%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
23% main goal to be called from outside
24%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
25
26bridge_programming(Plan, NrElements) :-
27    Granularity is 4096,
28% find all the root bridges
29    findall(root(Addr,Child,mem(LP,HP)),
30            (  rootbridge(Addr,Child,mem(L,H)),
31               LT1 is L / Granularity,
32               ceiling(LT1, LT2),
33               integer(LT2, LP),
34               HT1 is H / Granularity,
35               ceiling(HT1, HT2),
36               integer(HT2, HP)
37            ),Roots),
38% exclude fixed memory from being allocated to devices
39    ( is_predicate(fixed_memory/2) ->
40        findall(range(ResLowP,ResSizeP),
41          (
42            fixed_memory(ResLow,ResHigh), T1 is ResLow / Granularity, floor(T1,T2),
43            integer(T2,ResLowP),
44            T3 is (ResHigh - ResLow) / Granularity,
45            ceiling(T3,T4),
46            integer(T4,ResSizeP)
47          ), ExclRangesFixed);
48        ExclRangesFixed = []
49    ),
50% exclude IOAPIC regions from being allocated to devices
51    ( is_predicate(ioapic/3) ->
52      % according to the spec we need 64Bytes in the Intel case. Reserve a page
53      % anyway, since currently we cannot query the real requested size
54      TSz is (4096 / Granularity),
55      ceiling(TSz, TSz2),
56      integer(TSz2, IOAPIC_MinSize),
57      findall(range(Bs,IOAPIC_MinSize),
58               (
59                ioapic(_,B,_),
60                T1 is B / Granularity,
61                floor(T1, T2),
62                integer(T2, Bs)
63               ),IOAPICs)
64      ;
65      IOAPICs = []
66    ),
67
68%all the regions to avoid
69    append(ExclRangesFixed, IOAPICs, ExclRanges),
70
71% create an assignment for all PCI buses (all root bridges and their children)
72    ( foreach(Root,Roots),
73      foreach(P,Plan),
74      foreach(L,Lengths),
75      param(Granularity),
76      param(ExclRanges)
77      do
78        bridge_assignment(P,Root, Granularity, ExclRanges),
79        length(P,L)
80    ),
81    sum(Lengths,NrElements).
82
83
84%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
85% small tools
86%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
87
88adjust_range(X, buselement(T,A,Sec,B1,H1,S,Tp,PF, PCIe, Bits), buselement(T,A,Sec,B2,H2,S,Tp,PF, PCIe, Bits)) :-
89    B2 is B1 + X,
90    H2 is H1 + X.
91
92back_to_bytes(Granularity, buselement(T,A,Sec,BP,HP,SP,Tp,PF, PCIe, Bits), buselement(T,A,Sec,B,H,S,Tp,PF, PCIe, Bits)) :-
93    B is BP * Granularity,
94    H is HP * Granularity,
95    S is SP * Granularity.
96
97
98%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
99% the main part of the allocation. Called once per root bridge
100%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
101
102bridge_assignment(Plan, Root, Granularity, ExclRanges) :-
103    root(Addr,childbus(MinBus,MaxBus),mem(LMem,HMem)) = Root,
104    X is HMem - LMem,
105    Type = mem,
106
107% prefetchable
108    constrain_bus(Granularity, Type, prefetchable, Addr,MinBus,MaxBus,LMem,HMem,BusElementListP),
109    RBaseP::[LMem..HMem],
110    RHighP::[LMem..HMem],
111    RSizeP::[0..X],
112    devicetree(BusElementListP,buselement(bridge,Addr,secondary(MinBus),RBaseP,RHighP,RSizeP, Type, prefetchable, _, _),TP),
113
114% nonprefetchable
115    constrain_bus(Granularity, Type, nonprefetchable, Addr,MinBus,MaxBus,LMem,HMem,BusElementListNP),
116    RBaseNP::[LMem..HMem],
117    RHighNP::[LMem..HMem],
118    RSizeNP::[0..X],
119    devicetree(BusElementListNP,buselement(bridge,Addr,secondary(MinBus),RBaseNP,RHighNP,RSizeNP, Type, nonprefetchable, _, _),TNP),
120
121% pseudo-root of both trees
122    PseudoBase::[LMem..HMem],
123    PseudoHigh::[LMem..HMem],
124    PseudoSize::[0..X],
125    T = t(buselement(bridge, addr(-1, -1, -1), childbus(-1, -1), PseudoBase, PseudoHigh, PseudoSize, _, _, _, _), [TP, TNP]),
126    setrange(T,_,_,_),
127    nonoverlap(T),
128    naturally_aligned(T, 256, LMem, HMem),
129    tree2list(T,ListaU),
130    sort(6, >=, ListaU, Lista),
131    not_overlap_memory_ranges(Lista, ExclRanges),
132    keep_orig_addr(Lista, 12, 3, _),
133    labelall(Lista),
134    subtract(Lista,[buselement(bridge,Addr,_,_,_,_,_,prefetchable,_,_)],Pl3),
135    subtract(Pl3,[buselement(bridge,Addr,_,_,_,_,_,nonprefetchable,_,_)],Pl2),
136    subtract(Pl2,[buselement(bridge,addr(-1,-1,-1),_,_,_,_,_,_,_,_)],Pl),
137    maplist(adjust_range(0),Pl,PR),
138    maplist(back_to_bytes(Granularity),PR,Plan).
139
140% dot output:
141%    PrBaseBytePref is RBaseP * Granularity,
142%    PrHighBytePref is RHighP * Granularity,
143%    PrBaseByteNonPref is RBaseNP * Granularity,
144%    PrHighByteNonPref is RHighNP * Granularity,
145%    plan_to_dot(Granularity, Plan, Root, PrBaseBytePref, PrHighBytePref, PrBaseByteNonPref, PrHighByteNonPref).
146
147
148%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
149% instantiating the variables
150%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
151
152base(buselement(_,_,_,Base,_,_,_,_,_,_),Base).
153high(buselement(_,_,_,_,High,_,_,_,_,_),High).
154size(buselement(_,_,_,_,_,Size,_,_,_,_),Size).
155
156labelall(BusElementList) :-
157    maplist(base, BusElementList, Base),
158    maplist(high, BusElementList, High),
159    maplist(size, BusElementList, Size),
160    append(Base, High, L1),
161    append(L1, Size, L2),
162    labeling(L2).
163
164
165
166%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
167% create the list of devices and bridges in form of buselements and create the
168% variables.
169% we care about the allocation of memory mapped registers here, therefore we only
170% look at bar located in "mem", not "io"
171%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
172
173constrain_bus(_, _, _, _,Bus,MaxBus,_,_,[]) :- Bus > MaxBus.
174constrain_bus(Granularity, Type, Prefetch, RootAddr,Bus,MaxBus,LMem,HMem,NewBusElementList) :-
175    Bus =< MaxBus,
176    SMax is HMem - LMem,
177    findall(buselement(bridge,addr(Bus,Dev,Fun),secondary(Sec),Base,High,Size,Type,Prefetch, PCIe, 0),
178            ( bridge(PCIe, addr(Bus,Dev,Fun), _, _, _, _, _, secondary(Sec)),
179              not addr(Bus,Dev,Fun) = RootAddr,
180              Base::[LMem..HMem],High::[LMem..HMem],Size::[0..SMax]
181            ),BridgeList),
182    findall(buselement(device,addr(Bus,Dev,Fun),BAR,Base,High,SizeP,Type,Prefetch, PCIe, Bits),
183            ( device(PCIe, addr(Bus,Dev,Fun),_,_,_,_,_,_),
184              bar(addr(Bus,Dev,Fun),BAR,_,Size, Type, Prefetch, Bits),
185              Base::[LMem..HMem],High::[LMem..HMem],
186              ST1 is Size / Granularity,
187              ceiling(ST1, ST2),
188              integer(ST2, SizeP)
189            ),DeviceList),
190    append(BridgeList, DeviceList, BusElementList),
191    NextBus is Bus + 1,
192    constrain_bus(Granularity, Type, Prefetch, RootAddr, NextBus, MaxBus, LMem,HMem,List),
193    append(List,BusElementList,NewBusElementList).
194
195
196%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
197% create the PCI(e) device tree from a list of "buselement" and return it in Tree
198%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
199
200devicetree(List,CurrRoot,Tree) :-
201    buselement(bridge,_,secondary(Sec),_,_,_,_,_,_,_) = CurrRoot,
202    findall(X,(
203               member(Y,List),
204               buselement(_,addr(Sec,_,_),_,_,_,_,_,_,_,_) = Y,
205               devicetree(List, Y, X)),Children
206           ),
207    Tree = t(CurrRoot,Children).
208devicetree(_,CurrRoot,Tree) :-
209    buselement(device,_,_,_,_,_,_,_,_,_) = CurrRoot,
210    Tree = t(CurrRoot, []).
211
212
213%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
214% convert a tree to a list of buselements
215%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
216
217tree2list([],[]).
218tree2list(Tree, List) :-
219    t(Node,Children) = Tree,
220    ( foreach(El,Children),
221      foreach(L1,ChildList)
222      do
223        tree2list(El,L1)
224    ),
225    flatten(ChildList,L2),
226    List = [Node|L2].
227
228
229
230%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
231% store the new values of the BARs
232%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
233replace_current_BAR_values(L) :-
234    delete_current_BAR_values(L),
235    store_current_BAR_values(L).
236
237store_current_BAR_values([]).
238store_current_BAR_values([H|T]) :-
239    ( buselement(device,Addr,BAR,Base,High,Size,_,_,_,_) = H ->
240         assert(currentbar(Addr,BAR,Base,High,Size));
241        true
242    ),
243    store_current_BAR_values(T).
244
245
246delete_current_BAR_values([]).
247delete_current_BAR_values([H|T]) :-
248    ( buselement(device,Addr,BAR,_,_,_,_,_,_,_) = H ->
249        ( currentbar(Addr,BAR,_,_,_) ->
250            retract(currentbar(Addr,BAR,_,_,_));
251            true
252        );
253        true
254    ),
255    delete_current_BAR_values(T).
256
257
258
259
260%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
261% add constraints to the tree
262%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
263
264% make sure that the bridge has a range which includes all the children
265setrange(Tree,SubTreeSize,SubTreeMin,SubTreeMax) :-
266    t(Node,Children) = Tree,
267    ( foreach(El,Children),
268      foreach(Sz,SizeList),
269      foreach(Mi,MinList),
270      foreach(Ma,MaxList)
271      do
272        setrange(El,Sz,Mi,Ma)
273    ),
274    ic_global:sumlist(SizeList,Size),
275    buselement(_,_,_,Base,High,ElemSize,_,_,_,_) = Node,
276    ElemSize $>= Size,
277    ( not MinList=[] ->
278        ic:minlist(MinList,Min),
279        ic:maxlist(MaxList,Max),
280        Min $>= Base,
281        Max $=< High;
282        true
283    ),
284    High $= Base + ElemSize,
285    SubTreeSize $= ElemSize,
286    SubTreeMin $= Base,
287    SubTreeMax $= High.
288setrange([],0,_,_).
289
290
291% make sure that the children do not overlap
292child(t(C,_),C).
293nonoverlap(Tree) :-
294    t(_ ,Children) = Tree,
295    maplist(child,Children,ChildList),
296    ( not ChildList=[] ->
297        maplist(base,ChildList,Base),
298        maplist(size,ChildList,Size),
299        disjunctive(Base,Size);
300        true
301    ),
302    ( foreach(El, Children)
303      do
304        nonoverlap(El)
305    ).
306
307
308naturally_aligned(Tree, BridgeAlignment, LMem, HMem) :-
309    t(Node,Children) = Tree,
310    ( buselement(device,_,_,Base,High,Size,_,_,_,_) = Node ->
311      Divisor is Size
312      ;
313      buselement(bridge,_,_,Base,High,_,_,_,_,_) = Node ->
314      Divisor is BridgeAlignment
315    ),
316
317    suspend(mod(Base, Divisor, 0), 3, Base->inst),
318    ( foreach(El, Children),
319      param(BridgeAlignment),
320      param(LMem),
321      param(HMem)
322      do
323        naturally_aligned(El, BridgeAlignment, LMem, HMem)
324    ).
325
326
327% do not overlap with the given list of memory ranges
328not_overlap_memory_ranges([], _).
329not_overlap_memory_ranges([buselement(bridge,_,_,_,_,_,_,_,_,_)|PCIList], MemoryRanges) :-
330    not_overlap_memory_ranges(PCIList, MemoryRanges).
331not_overlap_memory_ranges([H|PCIList], MemoryRanges) :-
332    ( foreach(range(RBase,RSize),MemoryRanges),
333      param(H)
334      do
335      buselement(device,_,_,Base,_,Size,_,_,_,_) = H,
336      append([Base],[RBase],Bases),
337      append([Size],[RSize],Sizes),
338      disjunctive(Bases,Sizes)
339    ),
340    not_overlap_memory_ranges(PCIList, MemoryRanges).
341
342
343keep_orig_addr([], _, _, _).
344keep_orig_addr([H|Buselements], Class, SubClass, ProgIf) :-
345    ( buselement(device,Addr,BAR,Base,_,_,_,_,_,_) = H,device(_,Addr,_,_,Class, SubClass, ProgIf,_),bar(Addr,BAR,OrigBase,_,_,_,_) ->
346       T1 is OrigBase / 4096,
347       floor(T1,T2),
348       integer(T2,KeepBase),
349        Base $= KeepBase;
350        true
351    ),
352    keep_orig_addr(Buselements, Class, SubClass, ProgIf).
353
354