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
|
-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
-- Public License for more details. You should have received a copy of the GNU
-- General Public License distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================
separate (DAG)
package body LoopContext is
procedure Initialize (S : out T) is
begin
S.CurrentLoopNumber := 0;
CStacks.CreateStack (S.LoopStack);
end Initialize;
---------------------------------------------------------------------
procedure EnterLoop
(Scope : in Dictionary.Scopes;
S : in out T;
VCGHeap : in out Cells.Heap_Record;
LoopScope : out Dictionary.Scopes)
is
LoopSym : Dictionary.Symbol;
LoopCell : Cells.Cell;
begin
S.CurrentLoopNumber := S.CurrentLoopNumber + 1;
LoopSym := Dictionary.GetLoop (Dictionary.GetRegion (Scope), S.CurrentLoopNumber);
Cells.Create_Cell (VCGHeap, LoopCell);
Cells.Set_Symbol_Value (VCGHeap, LoopCell, LoopSym);
CStacks.Push (VCGHeap, LoopCell, S.LoopStack);
LoopScope := Dictionary.Set_Visibility (The_Visibility => Dictionary.Local,
The_Unit => LoopSym);
--# accept F, 601, Statistics.TableUsage, Dictionary.Dict, "False coupling expected" &
--# F, 601, Statistics.TableUsage, Scope, "False coupling expected" &
--# F, 601, Statistics.TableUsage, S.CurrentLoopNumber, "False coupling expected";
end EnterLoop;
-----------------------------------------------------------------------
procedure ExitLoop (S : in out T;
VCGHeap : in out Cells.Heap_Record;
LoopScope : in out Dictionary.Scopes) is
begin
CStacks.Pop (VCGHeap, S.LoopStack);
LoopScope := Dictionary.GetEnclosingScope (LoopScope);
end ExitLoop;
----------------------------------------------------------------------
function CurrentLoopSym (S : T;
VCGHeap : Cells.Heap_Record) return Dictionary.Symbol is
begin
return Cells.Get_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, S.LoopStack));
end CurrentLoopSym;
----------------------------------------------------------------------
function EnclosingLoopSym
(S : T;
VCGHeap : Cells.Heap_Record;
CurrentLoop : Dictionary.Symbol)
return Dictionary.Symbol
is
LocalStack : CStacks.Stack;
Result : Dictionary.Symbol;
begin
-- start by looping down stack to find CurrentLoop
LocalStack := S.LoopStack; -- start at top of stack
loop
-- we want to find the current loop symbol on top of our ever-reducing stack
exit when Cells.Get_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, LocalStack)) = CurrentLoop;
-- not found, so move down (or shrink) stack
LocalStack := CStacks.NonDestructivePop (VCGHeap, LocalStack);
-- error trap for case where we search for a non-existing loop symbol
exit when CStacks.IsEmpty (LocalStack); -- run out of stack
end loop;
-- At this point we either have a stack whose top item is the current loop or (gross error
-- condition) an empty stack
-- We want the next loop entry which we can find by shrnking the stack one more time.
-- We can do this safely, even in the error case, because the A_Ptr of Null is Null
LocalStack := CStacks.NonDestructivePop (VCGHeap, LocalStack);
if CStacks.IsEmpty (LocalStack) then
-- no enclosing loops
Result := Dictionary.NullSymbol;
else
-- there is an enclosing loop
Result := Cells.Get_Symbol_Value (VCGHeap, CStacks.Top (VCGHeap, LocalStack));
end if;
return Result;
end EnclosingLoopSym;
----------------------------------------------------------------------
function CurrentLoopParameterSym (S : T;
VCGHeap : Cells.Heap_Record) return Dictionary.Symbol is
begin
return Dictionary.GetLoopParameter (CurrentLoopSym (S, VCGHeap));
end CurrentLoopParameterSym;
----------------------------------------------------------------------
function CurrentLoopMovesInReverse (S : T;
VCGHeap : Cells.Heap_Record) return Boolean is
begin
return Dictionary.LoopParameterMovesInReverse (CurrentLoopParameterSym (S, VCGHeap));
end CurrentLoopMovesInReverse;
end LoopContext;
|
