OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [scil_ll.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                              S C I L _ L L                               --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--             Copyright (C) 2010, Free Software Foundation, Inc.           --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
-- GNAT was originally developed  by the GNAT team at  New York University. --
28
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
32
with Alloc; use Alloc;
33
with Atree; use Atree;
34
with Opt;   use Opt;
35
with Sinfo; use Sinfo;
36
with Table;
37
 
38
package body SCIL_LL is
39
 
40
   procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id);
41
   --  Copy the SCIL field from Source to Target (it is used as the argument
42
   --  for a call to Set_Reporting_Proc in package atree).
43
 
44
   function SCIL_Nodes_Table_Size return Pos;
45
   --  Used to initialize the table of SCIL nodes because we do not want
46
   --  to consume memory for this table if it is not required.
47
 
48
   ----------------------------
49
   --  SCIL_Nodes_Table_Size --
50
   ----------------------------
51
 
52
   function SCIL_Nodes_Table_Size return Pos is
53
   begin
54
      if Generate_SCIL then
55
         return Alloc.Orig_Nodes_Initial;
56
      else
57
         return 1;
58
      end if;
59
   end SCIL_Nodes_Table_Size;
60
 
61
   package SCIL_Nodes is new Table.Table (
62
      Table_Component_Type => Node_Id,
63
      Table_Index_Type     => Node_Id'Base,
64
      Table_Low_Bound      => First_Node_Id,
65
      Table_Initial        => SCIL_Nodes_Table_Size,
66
      Table_Increment      => Alloc.Orig_Nodes_Increment,
67
      Table_Name           => "SCIL_Nodes");
68
   --  This table records the value of attribute SCIL_Node of all the
69
   --  tree nodes.
70
 
71
   --------------------
72
   -- Copy_SCIL_Node --
73
   --------------------
74
 
75
   procedure Copy_SCIL_Node (Target : Node_Id; Source : Node_Id) is
76
   begin
77
      Set_SCIL_Node (Target, Get_SCIL_Node (Source));
78
   end Copy_SCIL_Node;
79
 
80
   ----------------
81
   -- Initialize --
82
   ----------------
83
 
84
   procedure Initialize is
85
   begin
86
      SCIL_Nodes.Init;
87
      Set_Reporting_Proc (Copy_SCIL_Node'Access);
88
   end Initialize;
89
 
90
   -------------------
91
   -- Get_SCIL_Node --
92
   -------------------
93
 
94
   function Get_SCIL_Node (N : Node_Id) return Node_Id is
95
   begin
96
      if Generate_SCIL
97
        and then Present (N)
98
      then
99
         return SCIL_Nodes.Table (N);
100
      else
101
         return Empty;
102
      end if;
103
   end Get_SCIL_Node;
104
 
105
   -------------------
106
   -- Set_SCIL_Node --
107
   -------------------
108
 
109
   procedure Set_SCIL_Node (N : Node_Id; Value : Node_Id) is
110
   begin
111
      pragma Assert (Generate_SCIL);
112
 
113
      if Present (Value) then
114
         case Nkind (Value) is
115
            when N_SCIL_Dispatch_Table_Tag_Init =>
116
               pragma Assert (Nkind (N) = N_Object_Declaration);
117
               null;
118
 
119
            when N_SCIL_Dispatching_Call =>
120
               pragma Assert (Nkind_In (N, N_Function_Call,
121
                                           N_Procedure_Call_Statement));
122
               null;
123
 
124
            when N_SCIL_Membership_Test =>
125
               pragma Assert (Nkind_In (N, N_Identifier,
126
                                           N_And_Then,
127
                                           N_Or_Else,
128
                                           N_Expression_With_Actions));
129
               null;
130
 
131
            when others =>
132
               pragma Assert (False);
133
               raise Program_Error;
134
         end case;
135
      end if;
136
 
137
      if Atree.Last_Node_Id > SCIL_Nodes.Last then
138
         SCIL_Nodes.Set_Last (Atree.Last_Node_Id);
139
      end if;
140
 
141
      SCIL_Nodes.Set_Item (N, Value);
142
   end Set_SCIL_Node;
143
 
144
end SCIL_LL;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.