1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
{
Program to test heap functions, timing doesn't work
}
PROGRAM TestHeap;
uses
erroru;
const
{$ifdef cpusparc}
Blocks = 1000;
{$else}
Blocks = 10000;
{$endif}
Procedure InitMSTimer;
begin
end;
{Get MS Timer}
Function MSTimer:longint;
begin
MSTimer:=0;
end;
procedure ShowHeap;
var
hstatus : TFPCHeapstatus;
begin
hstatus:=GetFPCHeapStatus;
WriteLn ('Used: ', hstatus.CurrHeapUsed, ' Free: ', hstatus.CurrHeapFree,' Size: ',hstatus.CurrHeapSize);
end;
VAR Start, LoopTime,LoopTime2: LONGINT;
Delta, TotalTime: LONGINT;
L,Choice,K,T: WORD;
BlkPtr: ARRAY [1..Blocks] OF POINTER;
BlkSize: ARRAY [1..Blocks] OF WORD;
Permutation: ARRAY [1..Blocks] OF WORD;
BEGIN
INitMSTimer;
WriteLn ('Test of TP heap functions');
WriteLn;
TotalTime := 0;
RandSeed := 997;
ShowHeap;
Start :=MSTimer;
FOR L := 1 TO Blocks DO BEGIN
END;
LoopTime := MSTimer-Start;
FOR L := 1 TO Blocks DO BEGIN
BlkSize [L] := Random (512) + 1;
END;
Write ('Allocating ',Blocks,' blocks at the end of the heap: ');
Start := MSTImer;
FOR L := 1 TO Blocks DO BEGIN
GetMem (BlkPtr [L], BlkSize [L]);
END;
Delta := MSTimer-Start-LoopTime;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
Write ('Deallocating same ',Blocks,' blocks in reverse order:');
Start := MSTimer;
FOR L := 1 TO Blocks DO BEGIN
FreeMem (BlkPtr [L], BlkSize [L]);
END;
Delta := MSTimer-Start-LoopTime;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
Write ('Allocating ',Blocks,' blocks at the end of the heap: ');
Start := MSTimer;
FOR L := 1 TO Blocks DO BEGIN
GetMem (BlkPtr [L], BlkSize [L]);
END;
Delta := MSTimer-Start-LoopTime;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
FOR L := 1 TO Blocks DO BEGIN
Permutation [L] := L;
END;
Start := MSTimer;
FOR L := Blocks DOWNTO 1 DO BEGIN
Choice := Random (L)+1;
K := Permutation [Choice];
Permutation [Choice] := Permutation [L];
END;
LoopTime2 := MSTimer - Start;
FOR L := 1 TO Blocks DO BEGIN
Permutation [L] := L;
END;
Write ('Deallocating same ',Blocks,' blocks at random: ');
Start := MSTimer;
FOR L := Blocks DOWNTO 1 DO BEGIN
Choice := Random (L)+1;
K := Permutation [Choice];
Permutation [Choice] := Permutation [L];
FreeMem (BlkPtr [K], BlkSize [K]);
END;
Delta := MSTimer - Start - LoopTime2;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
Write ('Allocating ',Blocks,' blocks at the end of the heap: ');
Start := MSTimer;
FOR L := 1 TO Blocks DO BEGIN
GetMem (BlkPtr [L], BlkSize [L]);
END;
Delta := MSTimer-Start-LoopTime;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
FOR L := 1 TO Blocks DO BEGIN
Permutation [L] := L;
END;
Start := MSTimer;
FOR L := Blocks DOWNTO 1 DO BEGIN
Choice := Random (L)+1;
K := Permutation [Choice];
T:= Permutation [L];
Permutation [L] := Permutation [Choice];
Permutation [Choice] := T;
END;
LoopTime2 := MSTimer - Start;
FOR L := 1 TO Blocks DO BEGIN
Permutation [L] := L;
END;
Write ('Deallocating ',(Blocks div 2 + 1),' blocks at random: ');
Start := MSTimer;
FOR L := Blocks DOWNTO (Blocks div 2 + 1) DO BEGIN
Choice := Random (L)+1;
K := Permutation [Choice];
T:= Permutation [L];
Permutation [L] := Permutation [Choice];
Permutation [Choice] := T;
SYSTEM.FreeMem (BlkPtr [K], BlkSize [K]);
END;
Delta := MSTimer-Start-LoopTime2;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
Write ('Reallocating deallocated ',(Blocks div 2 + 1),' blocks at random: ');
Start := MSTimer;
FOR L := (Blocks div 2+1) TO Blocks DO BEGIN
GetMem (BlkPtr [Permutation [L]], BlkSize [Permutation [L]]);
END;
Delta := MSTimer-Start-LoopTime;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
Write ('Deallocating all ',Blocks,' blocks at random: ');
Start := MSTimer;
FOR L := Blocks DOWNTO 1 DO BEGIN
FreeMem (BlkPtr [L], BlkSize [L]);
END;
Delta := MSTimer-Start-LoopTime;
Inc (TotalTime, Delta);
WriteLn (Delta:5, ' ms');
ShowHeap;
WriteLn;
WriteLn ('Total time for benchmark: ', TotalTime, ' ms');
END.
|
