1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--                            L O C A T I O N S                             --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--               Copyright (C) 2008-2009 Telecom ParisTech,                 --
10
--                 2010-2019 ESA & ISAE, 2019-2020 OpenAADL                 --
11
--                                                                          --
12
-- Ocarina  is free software; you can redistribute it and/or modify under   --
13
-- terms of the  GNU General Public License as published  by the Free Soft- --
14
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
15
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
16
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
17
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
18
--                                                                          --
19
-- As a special exception under Section 7 of GPL version 3, you are granted --
20
-- additional permissions described in the GCC Runtime Library Exception,   --
21
-- version 3.1, as published by the Free Software Foundation.               --
22
--                                                                          --
23
-- You should have received a copy of the GNU General Public License and    --
24
-- a copy of the GCC Runtime Library Exception along with this program;     --
25
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
26
-- <http://www.gnu.org/licenses/>.                                          --
27
--                                                                          --
28
--                    Ocarina is maintained by OpenAADL team                --
29
--                              (info@openaadl.org)                         --
30
--                                                                          --
31
------------------------------------------------------------------------------
32

33
with GNAT.Directory_Operations;
34

35
with Ocarina.Namet;
36
with Ocarina.Types;
37
use type Ocarina.Types.Name_Id, Ocarina.Types.Int, Ocarina.Types.Text_Ptr;
38

39
package body Locations is
40

41
   -----------
42
   -- Image --
43
   -----------
44

45 1
   function Image (Loc : Location) return String is
46 1
      Column : constant Ocarina.Types.Nat :=
47
        Ocarina.Types.Nat (Loc.Last_Pos - Loc.First_Pos + 1);
48 1
      Backup : Ocarina.Types.Name_Id;
49
      --  Backup name buffer
50 1
      Result : Ocarina.Types.Name_Id;
51
   --  Store returned value before restoring name buffer
52
   begin
53 1
      if Loc.Base_Name = Ocarina.Types.No_Name then
54 1
         return Ocarina.Types.No_Str;
55

56
      else
57
         --  A critical issue consist in preserving Name_Buffer. In
58
         --  other words, this function must not have side effect.
59

60
         --  Save name buffer to restore it later on
61 1
         Backup := Ocarina.Namet.Name_Find;
62

63 1
         Ocarina.Namet.Get_Name_String (Loc.Base_Name);
64 1
         Ocarina.Namet.Add_Char_To_Name_Buffer (':');
65
         Ocarina.Namet.Add_Nat_To_Name_Buffer (Ocarina.Types.Nat (Loc.Line));
66 1
         Ocarina.Namet.Add_Char_To_Name_Buffer (':');
67 1
         if Column < 10 then
68 1
            Ocarina.Namet.Add_Char_To_Name_Buffer ('0');
69
         end if;
70 1
         Ocarina.Namet.Add_Nat_To_Name_Buffer (Column);
71 1
         Result := Ocarina.Namet.Name_Find;
72

73
         --  Restore backup into name buffer
74

75 1
         if Backup /= Ocarina.Types.No_Name then
76 1
            Ocarina.Namet.Get_Name_String (Backup);
77
         end if;
78

79
         --  Return result using a Get_Name_String variant with no side effect
80 1
         return Ocarina.Namet.Get_Name_String (Result);
81
      end if;
82 1
   end Image;
83

84
   ----------------
85
   -- Initialize --
86
   ----------------
87

88 1
   procedure Initialize
89
     (Loc    : in out Location;
90
      Name   :        Ocarina.Types.Name_Id;
91
      Size   :        Ocarina.Types.Int;
92
      Buffer :        Ocarina.Types.Text_Buffer_Ptr)
93
   is
94
   begin
95 1
      Loc.Base_Name :=
96 1
        Ocarina.Namet.Get_String_Name
97 1
        (GNAT.Directory_Operations.Base_Name
98 1
           (Ocarina.Namet.Get_Name_String (Name)));
99 1
      Loc.Dir_Name :=
100 1
        Ocarina.Namet.Get_String_Name
101 1
        (GNAT.Directory_Operations.Dir_Name
102 1
           (Ocarina.Namet.Get_Name_String (Name)));
103 1
      Loc.Line      := 1;
104 1
      Loc.First_Pos := 1;
105 1
      Loc.Last_Pos  := 1;
106 1
      Loc.Scan      := 1;
107 1
      Loc.EOF       := Ocarina.Types.Text_Ptr (Size);
108 1
      Loc.Buffer    := Buffer;
109 1
   end Initialize;
110

111
   --------------------------
112
   -- Update_Name_And_Line --
113
   --------------------------
114

115 0
   procedure Update_Name_And_Line
116
     (Loc  : in out Location;
117
      Name :        Ocarina.Types.Name_Id;
118
      Line :        Ocarina.Types.Int)
119
   is
120
   begin
121 0
      Loc.Line      := Line;
122 0
      Loc.Base_Name :=
123 0
        Ocarina.Namet.Get_String_Name
124 0
        (GNAT.Directory_Operations.Base_Name
125 0
           (Ocarina.Namet.Get_Name_String (Name)));
126 0
      Loc.Dir_Name :=
127 0
        Ocarina.Namet.Get_String_Name
128 0
        (GNAT.Directory_Operations.Dir_Name
129 0
           (Ocarina.Namet.Get_Name_String (Name)));
130 0
   end Update_Name_And_Line;
131

132
end Locations;

Read our documentation on viewing source code .

Loading