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
|
with Except;
with Screen_Output;
package body Stack is
----------------
-- Local Data --
----------------
Size : constant := 200;
-- The stack size.
Tab : array (1 .. Size) of Value;
-- The stack. We push and pop pointers to Values.
Last : Natural := Tab'First - 1;
-- Indicates the top of the stack. When 0 the stack is empty.
-----------
-- Clear --
-----------
procedure Clear is
begin
Last := Tab'First - 1;
end Clear;
-----------
-- Empty --
-----------
function Empty return Boolean is
begin
return Last < Tab'First;
end Empty;
----------
-- Push --
----------
procedure Push (V : Value) is
begin
if Last = Tab'Last then
raise Overflow;
end if;
Screen_Output.Debug_Msg ("Pushing -> " & Values.To_String (V));
Last := Last - 1;
Tab (Last) := V;
end Push;
---------
-- Pop --
---------
function Pop return Value is
V : Value;
begin
if Empty then
raise Underflow;
end if;
V := Tab (Last);
Last := Last - 1;
Screen_Output.Debug_Msg ("Popping <- " & Values.To_String (V));
return V;
end Pop;
---------
-- Top --
---------
function Top return Value is
begin
if Empty then
raise Underflow;
end if;
return Tab (Last);
end Top;
----------
-- View --
----------
procedure View is
begin
for I in Tab'First .. Last loop
Screen_Output.Msg (Values.To_String (Tab (I)));
end loop;
Screen_Output.Msg ("");
end View;
end Stack;
|
