← Back to branch summary

~ubuntu-branches/ubuntu/hardy/asis/hardy-proposed

« back to all changes in this revision

Viewing changes to tools/gnatpp/gnatpp-stacs.adb

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2006-08-08 23:02:17 UTC
  • mfrom: (3.1.6 edgy)
  • Revision ID: james.westby@ubuntu.com-20060808230217-8j3ts1m8i83e0apm
Tags: 2005-5

debian/control: add support for alpha and s390.

Show diffs side-by-side

added added

removed removed

Lines of Context:
tools/gnatpp/gnatpp-stacs.adb
 
1
------------------------------------------------------------------------------
 
2
--                                                                          --
 
3
--                            GNATPP COMPONENTS                             --
 
4
--                                                                          --
 
5
--                         G N A T P P . S T A C S                          --
 
6
--                                                                          --
 
7
--                                 B o d y                                  --
 
8
--                                                                          --
 
9
--                            1.3
 
10
--                                                                          --
 
11
--                       Copyright (C) 2001, ACT Europe                     --
 
12
--                                                                          --
 
13
-- GNATPP is free software; you can redistribute it  and/or modify it under --
 
14
-- terms of the  GNU General Public License as published  by the Free Soft- --
 
15
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
 
16
-- sion.  GNATPP is  distributed in the  hope that it will  be  useful, but --
 
17
-- WITHOUT ANY WARRANTY; without even the implied warranty of  MERCHANTABI- --
 
18
-- LITY or  FITNESS  FOR A  PARTICULAR  PURPOSE. See the GNU General Public --
 
19
-- License  for more details. You  should  have  received a copy of the GNU --
 
20
-- General Public License  distributed with GNAT; see file COPYING. If not, --
 
21
-- write  to  the Free  Software  Foundation,  59 Temple Place - Suite 330, --
 
22
-- Boston,                                                                  --
 
23
--                                                                          --
 
24
-- GNATPP is maintained by ACT Europe (http://www.act-europe.fr).           --
 
25
--                                                                          --
 
26
------------------------------------------------------------------------------
 
27
 
 
28
with Table;
 
29
 
 
30
package body GNATPP.Stacs is
 
31
 
 
32
   package Stack_Table is new Table.Table
 
33
     (Table_Component_Type => Element_Type,
 
34
      Table_Index_Type     => Natural,
 
35
      Table_Low_Bound      => 1,
 
36
      Table_Initial        => 100,
 
37
      Table_Increment      => 100,
 
38
      Table_Name           => "Generic Stack");
 
39
 
 
40
   Stack : Stack_Table.Table_Ptr renames Stack_Table.Table;
 
41
 
 
42
   --------------
 
43
   -- Is_Empty --
 
44
   --------------
 
45
 
 
46
   function Is_Empty return Boolean is
 
47
   begin
 
48
      return Stack_Table.Last = 0;
 
49
   end Is_Empty;
 
50
 
 
51
   ---------
 
52
   -- Pop --
 
53
   ---------
 
54
 
 
55
   function Pop return Element_Type is
 
56
   begin
 
57
 
 
58
      if Is_Empty then
 
59
         return No_Element;
 
60
      else
 
61
         Stack_Table.Decrement_Last;
 
62
         return Stack (Stack_Table.Last + 1);
 
63
      end if;
 
64
 
 
65
   end Pop;
 
66
 
 
67
   ---------
 
68
   -- Pop --
 
69
   ---------
 
70
 
 
71
   procedure Pop is
 
72
   begin
 
73
 
 
74
      if not Is_Empty then
 
75
         Stack_Table.Decrement_Last;
 
76
      end if;
 
77
 
 
78
   end Pop;
 
79
 
 
80
   ----------
 
81
   -- Push --
 
82
   ----------
 
83
 
 
84
   procedure Push (Elem : Element_Type) is
 
85
   begin
 
86
      Stack_Table.Append (Elem);
 
87
   end Push;
 
88
 
 
89
   ----------
 
90
   -- Size --
 
91
   ----------
 
92
 
 
93
   function Size return Natural renames Stack_Table.Last;
 
94
 
 
95
   ---------
 
96
   -- Top --
 
97
   ---------
 
98
 
 
99
   function Top (Step_Down : Natural := 0) return Element_Type is
 
100
   begin
 
101
 
 
102
      if Is_Empty or else Step_Down > Stack_Table.Last then
 
103
         return No_Element;
 
104
      else
 
105
         return Stack (Stack_Table.Last - Step_Down);
 
106
      end if;
 
107
 
 
108
   end Top;
 
109
 
 
110
end GNATPP.Stacs;