File: dictionary-addloop.adb

package info (click to toggle)
spark 2012.0.deb-9
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 29,260 kB
  • ctags: 3,098
  • sloc: ada: 186,243; cpp: 13,497; makefile: 685; yacc: 440; lex: 176; ansic: 119; sh: 16
file content (86 lines) | stat: -rw-r--r-- 4,055 bytes parent folder | download | duplicates (2)
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
-------------------------------------------------------------------------------
-- (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 (Dictionary)
procedure AddLoop
  (Scope         : in     Scopes;
   Comp_Unit     : in     ContextManager.UnitDescriptors;
   LoopStatement : in     Location;
   TheLoop       :    out Symbol) is
   CompilationUnit, Previous : Symbol;
begin
   RawDict.CreateLoop
     (Region    => GetRegion (Scope),
      Comp_Unit => Comp_Unit,
      Loc       => LoopStatement.Start_Position,
      TheLoop   => TheLoop);

   CompilationUnit := GetEnclosingCompilationUnit (Scope);
   case RawDict.GetSymbolDiscriminant (CompilationUnit) is
      when Subprogram_Symbol =>
         Previous :=
           RawDict.Get_Subprogram_Last_Loop (The_Subprogram => RawDict.Get_Subprogram_Info_Ref (Item => CompilationUnit));
         if Previous = NullSymbol then
            RawDict.Set_Subprogram_First_Loop
              (The_Subprogram => RawDict.Get_Subprogram_Info_Ref (Item => CompilationUnit),
               The_Loop       => TheLoop);
         else
            RawDict.SetNextLoop (Previous, TheLoop);
         end if;
         RawDict.Set_Subprogram_Last_Loop
           (The_Subprogram => RawDict.Get_Subprogram_Info_Ref (Item => CompilationUnit),
            The_Loop       => TheLoop);
      when Type_Symbol =>
         -- must be task body, no other type could have a loop in it
         Previous := RawDict.Get_Task_Type_Last_Loop (The_Task_Type => RawDict.Get_Type_Info_Ref (Item => CompilationUnit));
         if Previous = NullSymbol then
            RawDict.Set_Task_Type_First_Loop
              (The_Task_Type => RawDict.Get_Type_Info_Ref (Item => CompilationUnit),
               The_Loop      => TheLoop);
         else
            RawDict.SetNextLoop (Previous, TheLoop);
         end if;
         RawDict.Set_Task_Type_Last_Loop
           (The_Task_Type => RawDict.Get_Type_Info_Ref (Item => CompilationUnit),
            The_Loop      => TheLoop);
      when Package_Symbol =>
         Previous := RawDict.Get_Package_Last_Loop (The_Package => RawDict.Get_Package_Info_Ref (Item => CompilationUnit));
         if Previous = NullSymbol then
            RawDict.Set_Package_First_Loop
              (The_Package => RawDict.Get_Package_Info_Ref (Item => CompilationUnit),
               The_Loop    => TheLoop);
         else
            RawDict.SetNextLoop (Previous, TheLoop);
         end if;
         RawDict.Set_Package_Last_Loop
           (The_Package => RawDict.Get_Package_Info_Ref (Item => CompilationUnit),
            The_Loop    => TheLoop);
      when others => -- non-exec code
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.Invalid_Symbol_Table,
                                   Msg     => "in Dictionary.AddLoop");
   end case;

   if SPARK_IO.Is_Open (Dict.TemporaryFile) then
      Write_String (Dict.TemporaryFile, "loop statement for ");
      Write_Name (File => Dict.TemporaryFile,
                  Item => TheLoop);
      Write_String (Dict.TemporaryFile, " is at ");
      Write_Location (File => Dict.TemporaryFile,
                      Loc  => LoopStatement);
      Write_Line (Dict.TemporaryFile, " ;");
   end if;
end AddLoop;