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% the PCI tree is constructed by adding child devices to the bridge. all the
11% children are sorted by the requesting size of the children in descending order.
12% on the next level children (which include subordinate bridges) are sorted by
13% the sum of all  children below the bridge.
14% the bridges Sz variable contains therefore the sum of the requesting sizes of
15% all children. like this, we can allocate resources
16% for the biggest requesting bridge and all its children first.
17
18
19%:-dynamic(bridge/8).
20%:-dynamic(bar/7).
21
22% :-include("../data/data_nos6.txt").
23% :-include("../data/data_qemu_hand.txt").
24% :-include("../data/data_qemu.txt").
25% :-include("../data/data_nos4.txt").
26% :-include("../data/data_nos5.txt").
27% :-include("../data/data_hand.txt").
28
29% asq: important: this entry _has_ to be here all the time!!
30%bridge(pcie, addr(0,0,0),0,0,6,4,0,secondary(0)).
31bar(addr(0,0,0),0,0,5,mem, nonprefetchable,0).
32bar(addr(0,0,0),0,0,5,mem, prefetchable,0).
33
34:- set_flag(print_depth, 200).
35
36
37%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
38% main goal to be called from outside
39%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
40
41bridge_programming(Plan, NrElements) :-
42
43    Granularity is 4096,
44    FixedAddresses=[fixed(12,3,_)],
45    reserve_fixed_addresses(FixedAddresses),
46
47    findall(root(Addr,Child,mem(LP,HP)),
48            (  rootbridge(Addr,Child,mem(L,H)),
49               LT1 is L / Granularity,
50               ceiling(LT1, LT2),
51               integer(LT2, LP),
52               HT1 is H / Granularity,
53               ceiling(HT1, HT2),
54               integer(HT2, HP)
55            ),Roots),
56    ( is_predicate(fixed_memory/2) ->
57        findall(range(ResLowP,ResSizeP),
58          (
59            fixed_memory(ResLow,ResHigh), T1 is ResLow / Granularity, floor(T1,T2),
60            integer(T2,ResLowP),
61            T3 is (ResHigh - ResLow) / Granularity,
62            ceiling(T3,T4),
63            integer(T4,ResSizeP)
64          ), ExclRanges);
65        ExclRanges = []
66    ),
67    ( foreach(Root,Roots),
68      foreach(P,Plan),
69      foreach(L,Lengths),
70      param(Granularity),
71      param(ExclRanges),
72      param(FixedAddresses)
73      do
74        bridge_assignment(P,Root, Granularity, ExclRanges, FixedAddresses),
75        length(P,L)
76    ),
77    sum(Lengths,NrElements).
78
79
80
81
82
83
84%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
85% construct a tree and do the assignment
86%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
87
88bridge_assignment(Plan, Root, Granularity, ExclRanges, FixedAddresses) :-
89    root(Addr,childbus(MinBus,MaxBus),mem(LMem,HMem)) = Root,
90    X is HMem - LMem,
91    Type = mem,
92
93% prefetchable and nonprefetchable
94    constrain_bus(Granularity, Type, _, Addr,MinBus,MaxBus,LMem,HMem,BusElementListP),
95    devicetree(BusElementListP,buselement(bridge,Addr,secondary(MinBus),RBaseP,RHighP,RSizeP, Type, _, _, _),T),
96
97% prefetchable
98%    constrain_bus(Granularity, Type, prefetchable, Addr,MinBus,MaxBus,LMem,HMem,BusElementListP),
99%    devicetree(BusElementListP,buselement(bridge,Addr,secondary(MinBus),RBaseP,RHighP,RSizeP, Type, prefetchable, _, _),TP),
100
101%% nonprefetchable
102%    constrain_bus(Granularity, Type, nonprefetchable, Addr,MinBus,MaxBus,LMem,HMem,BusElementListNP),
103%    devicetree(BusElementListNP,buselement(bridge,Addr,secondary(MinBus),RBaseNP,RHighNP,RSizeNP, Type, nonprefetchable, _, _),TNP),
104
105%% pseudo-root of both trees
106%% sorted
107%    T = t(buselement(bridge, addr(-1, -1, -1), childbus(-1, -1), PseudoBase, PseudoHigh, PseudoSize, _, _, _, _), Sz, [TP, TNP]),
108%
109%% unsorted
110%%    T = t(buselement(bridge, addr(-1, -1, -1), childbus(-1, -1), PseudoBase, PseudoHigh, PseudoSize, _, _, _, _), [TP, TNP]),
111
112    nl,nl,nl,writeln(tree),nl,writeln(T),nl,nl,nl,
113    pci_postorder(T, LMem, High, Granularity),
114
115% XXX
116%    High =< HMem,
117
118    tree2list(T,Lista),
119
120    subtract(Lista,[buselement(bridge,Addr,_,_,_,_,_,_,_,_)],Pl),
121    compute_bridge_size(Pl),
122    maplist(adjust_range(0),Pl,PR),
123    maplist(back_to_bytes(Granularity),PR,Plan).
124
125%    subtract(Lista,[buselement(bridge,Addr,_,_,_,_,_,prefetchable,_,_)],Pl3),
126%    subtract(Pl3,[buselement(bridge,Addr,_,_,_,_,_,nonprefetchable,_,_)],Pl2),
127%    subtract(Pl2,[buselement(bridge,addr(-1,-1,-1),_,_,_,_,_,_,_,_)],Pl),
128%    maplist(adjust_range(0),Pl,PR),
129%    maplist(back_to_bytes(Granularity),PR,Plan).
130
131
132%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
133% create the list of devices and bridges in form of buselements and create the
134% variables.
135% we care about the allocation of memory mapped registers here, therefore we only
136% look at bar located in "mem", not "io"
137%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
138
139constrain_bus(_, _, _, _,Bus,MaxBus,_,_,[]) :- Bus > MaxBus.
140constrain_bus(Granularity, Type, Prefetch, RootAddr,Bus,MaxBus,LMem,HMem,NewBusElementList) :-
141    Bus =< MaxBus,
142    SMax is HMem - LMem,
143    findall(buselement(bridge,addr(Bus,Dev,Fun),secondary(Sec),Base,High,Size,Type,Prefetch, PCIe, 0),
144            ( bridge(PCIe, addr(Bus,Dev,Fun), _, _, _, _, _, secondary(Sec)),
145              not addr(Bus,Dev,Fun) = RootAddr
146            ),BridgeList),
147    findall(buselement(device,addr(Bus,Dev,Fun),BAR,Base,High,SizeP,Type,Prefetch, PCIe, Bits),
148            ( device(PCIe, addr(Bus,Dev,Fun),_,_,_,_,_,_),
149              bar(addr(Bus,Dev,Fun),BAR,_,Size, Type, Prefetch, Bits),
150              ST1 is Size / Granularity,
151              ceiling(ST1, ST2),
152              integer(ST2, SizeP)
153            ),DeviceList),
154    append(BridgeList, DeviceList, BusElementList),
155    NextBus is Bus + 1,
156    constrain_bus(Granularity, Type, Prefetch, RootAddr, NextBus, MaxBus, LMem,HMem,List),
157    append(List,BusElementList,NewBusElementList).
158
159
160
161
162%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
163% create the PCI(e) device tree from a list of "buselement" and return it in Tree
164%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
165
166% sorted
167
168getchildsize(t(_,Sz,_),Sz).
169
170devicetree(List,CurrRoot,Tree) :-
171    buselement(bridge,_,secondary(Sec),_,_,_,_,_,_,_) = CurrRoot,
172    findall(X,(
173               member(Y,List),
174               buselement(_,addr(Sec,_,_),_,_,_,_,_,_,_,_) = Y,
175               devicetree(List, Y, X)),Children
176           ),
177    sort(2, =<, Children, ChildrenSorted),
178    maplist(getchildsize, ChildrenSorted, ChildrenSizes),
179    writeln(ChildrenSorted),
180    sum(ChildrenSizes, BridgeSize),
181    Tree = t(CurrRoot,BridgeSize,ChildrenSorted).
182devicetree(_,CurrRoot,Tree) :-
183    buselement(device,_,_,_,_,Size,_,_,_,_) = CurrRoot,
184    Tree = t(CurrRoot, Size, []).
185
186
187
188% unsorted
189%
190%devicetree(List,CurrRoot,Tree) :-
191%    buselement(bridge,_,secondary(Sec),_,_,_,_,_,_,_) = CurrRoot,
192%    findall(X,(
193%               member(Y,List),
194%               buselement(_,addr(Sec,_,_),_,_,_,_,_,_,_,_) = Y,
195%               devicetree(List, Y, X)),Children
196%           ),
197%    Tree = t(CurrRoot,Children).
198%devicetree(_,CurrRoot,Tree) :-
199%    buselement(device,_,_,_,_,_,_,_,_,_) = CurrRoot,
200%    Tree = t(CurrRoot, []).
201
202
203%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
204% convert a tree to a list of buselements
205%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
206
207% sorted
208tree2list([],[]).
209tree2list(Tree, List) :-
210    t(Node,_,Children) = Tree,
211    ( foreach(El,Children),
212      foreach(L1,ChildList)
213      do
214        tree2list(El,L1)
215    ),
216    flatten(ChildList,L2),
217    List = [Node|L2].
218
219% unsorted
220%tree2list([],[]).
221%tree2list(Tree, List) :-
222%    t(Node,Children) = Tree,
223%    ( foreach(El,Children),
224%      foreach(L1,ChildList)
225%      do
226%        tree2list(El,L1)
227%    ),
228%    flatten(ChildList,L2),
229%    List = [Node|L2].
230
231
232%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
233% Traverse tree in postoder mode and assign addresses to the devices
234%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
235
236pci_postorder([], StartAddr, StartAddr, _) :- writeln([]).
237pci_postorder(T, StartAddr, NextAddr, Granularity) :-
238    t(Node, _, Children) = T,
239    buselement(Type,_,_,Base,High,Size,_,_,_,_) = Node,
240    MBF is ((1024 * 1024) / Granularity),
241    integer(MBF, MB),
242
243% adjust the start address in case it is a device to avoid resource conflicts
244    adjust_start_address(Type, StartAddr, Size, Granularity, AllocationStartAddr),
245
246    ( Type = device ->
247      mod(AllocationStartAddr, Size, Remainder),
248      ( Remainder > 0 ->
249          Base is AllocationStartAddr + Size - Remainder;
250          Base is AllocationStartAddr
251      );
252      mod(AllocationStartAddr, MB, Remainder2),
253      ( Remainder2 > 0 ->
254          Base is AllocationStartAddr + MB - Remainder2;
255          Base is AllocationStartAddr
256      )
257   ),
258
259    pci_postorder_children(Children, Base, NextChildAddr, Granularity),
260
261    ( Type = device ->
262        NextAddr is NextChildAddr + Size;
263        mod(NextChildAddr, MB, Remainder3),
264        ( Remainder3 > 0 ->
265            NextAddr is NextChildAddr + MB - Remainder3;
266            NextAddr is NextChildAddr
267        )
268    ),
269    High = NextAddr,
270    writeln(Node),
271    writeln(NextChildAddr),
272    writeln(NextAddr).
273
274pci_postorder_children([], StartAddr, StartAddr, _).
275pci_postorder_children([H|T], StartAddr, NextAddr, Granularity) :-
276    pci_postorder(H, StartAddr, Next, Granularity),
277    pci_postorder_children(T, Next, NextAddr, Granularity).
278
279
280
281reserve_fixed_addresses([]).
282reserve_fixed_addresses([fixed(Class,SubClass,ProgIf)|T]) :-
283    findall(m(B,H), (
284                      device(_,Addr,_,_,Class, SubClass, ProgIf,_),bar(Addr,BAR,B,H,_,_,_)
285                    ),
286            FixedList),
287    ( foreach(m(B,H),FixedList)
288      do
289        assert(fixed_memory(B,H))
290    ),
291    reserve_fixed_addresses(T).
292
293
294
295
296
297
298%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
299% adjust startaddress: leave reserved regions and fixed addresses of devices out
300%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
301adjust_start_address(bridge, StartAddr, _, _, StartAddr).
302
303adjust_start_address(device, StartAddr, Size, Granularity, AllocStartAddr) :-
304    EndAddr is StartAddr + Size,
305    ( is_predicate(fixed_memory/2) ->
306        findall(r(B,H), (
307            fixed_memory(ResLow,ResHigh),
308            T1 is ResLow / Granularity,
309            floor(T1,T2),
310            integer(T2,B),
311            T3 is ResHigh / Granularity,
312            ceiling(T3, T4),
313            integer(T4, H)
314                        ),
315                        ReservedList)
316    ;
317    ReservedList=[]
318    ),
319
320    IOAPIC_SizeT1 is (4096 / Granularity),
321    ceiling(IOAPIC_SizeT1, IOAPIC_SizeT2),
322    integer(IOAPIC_SizeT2, IOAPIC_Size),
323    findall(r(IOB,IOH),(
324                ioapic(_,B,_),
325                T1 is B / Granularity,
326                floor(T1, T2),
327                integer(T2, IOB),
328                IOH is IOB + IOAPIC_Size
329               ),IOAPIC_reserved),
330    append(ReservedList, IOAPIC_reserved, ResList),
331    ( foreach(r(B,H), ResList),
332      foreach(A, ConflictList),
333      param(StartAddr),
334      param(EndAddr)
335      do
336          ( StartAddr >= B, StartAddr =< H ->
337                A = H;
338            EndAddr >= B, EndAddr =< H ->
339                A = H;
340            StartAddr =< B, EndAddr >= H ->
341                A = H;
342                A = 0
343          )
344    ),
345    max(ConflictList,Max),
346    max([Max,StartAddr], AllocStartAddrAdjusted),
347
348    mod(AllocStartAddrAdjusted, Size, Remainder),
349    ( Remainder > 0 ->
350        AllocStartAddr is AllocStartAddrAdjusted + Size - Remainder;
351        AllocStartAddr is AllocStartAddrAdjusted
352    ).
353
354
355
356
357
358
359
360
361
362%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
363% tools
364%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
365
366adjust_range(X, buselement(T,A,Sec,B1,H1,S,Tp,PF, PCIe, Bits), buselement(T,A,Sec,B2,H2,S,Tp,PF, PCIe, Bits)) :-
367    B2 is B1 + X,
368    H2 is H1 + X.
369
370back_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)) :-
371    B is BP * Granularity,
372    H is HP * Granularity,
373    S is SP * Granularity.
374
375base(buselement(_,_,_,Base,_,_,_,_,_,_),Base).
376high(buselement(_,_,_,_,High,_,_,_,_,_),High).
377size(buselement(_,_,_,_,_,Size,_,_,_,_),Size).
378
379
380compute_bridge_size([]).
381compute_bridge_size([buselement(device,_,_,_,_,_,_,_,_,_)|T]) :-
382    compute_bridge_size(T).
383compute_bridge_size([buselement(bridge,_,_,Base,High,Size,_,_,_,_)|T]) :-
384    Size is High - Base,
385    compute_bridge_size(T).
386
387
388%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
389% store the new values of the BARs
390%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
391replace_current_BAR_values(L) :-
392    delete_current_BAR_values(L),
393    store_current_BAR_values(L).
394
395store_current_BAR_values([]).
396store_current_BAR_values([H|T]) :-
397    ( buselement(device,Addr,BAR,Base,High,Size,_,_,_,_) = H ->
398         assert(currentbar(Addr,BAR,Base,High,Size));
399        true
400    ),
401    store_current_BAR_values(T).
402
403
404delete_current_BAR_values([]).
405delete_current_BAR_values([H|T]) :-
406    ( buselement(device,Addr,BAR,_,_,_,_,_,_,_) = H ->
407        ( currentbar(Addr,BAR,_,_,_) ->
408            retract(currentbar(Addr,BAR,_,_,_));
409            true
410        );
411        true
412    ),
413    delete_current_BAR_values(T).
414
415
416
417