libxmlada5-dev 4.4.2014-1build1 / usr / share / ada / adainclude / xmlada / sax-pointers.adb

This file is indexed.

/usr/share/ada/adainclude/xmlada/sax-pointers.adb is in libxmlada5-dev 4.4.2014-1build1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
------------------------------------------------------------------------------
--                     XML/Ada - An XML suite for Ada95                     --
--                                                                          --
--                     Copyright (C) 2007-2014, AdaCore                     --
--                                                                          --
-- This library 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. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
-- You should have received a copy of the GNU General Public License along  --
-- with this program;  see the file COPYING3.  If not, see                  --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Unchecked_Deallocation;
with GNAT.Task_Lock;
with Interfaces;   use Interfaces;

package body Sax.Pointers is

   procedure Unchecked_Free is new Ada.Unchecked_Deallocation
     (Root_Encapsulated'Class, Root_Encapsulated_Access);

--     function Sync_Add_And_Fetch
--       (Ptr   : access Interfaces.Integer_32;
--        Value : Interfaces.Integer_32) return Interfaces.Integer_32;
--     pragma Import (Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");
   --  Increment Ptr by Value. This is task safe (either using a lock or
   --  intrinsic atomic operations). Returns the new value (as set, it
   --  might already have been changed by another by the time this function
   --  returns.

   ----------
   -- Free --
   ----------

   procedure Free (Data : in out Root_Encapsulated) is
      pragma Unreferenced (Data);
   begin
      null;
   end Free;

   --------------------
   -- Smart_Pointers --
   --------------------

   package body Smart_Pointers is

      --------------
      -- Allocate --
      --------------

      function Allocate (Data : Encapsulated'Class) return Pointer is
         Tmp : constant Encapsulated_Access := new Encapsulated'Class'(Data);
      begin
         return Allocate (Tmp);
      end Allocate;

      function Allocate (Data : access Encapsulated'Class) return Pointer is
      begin
         return
           (Ada.Finalization.Controlled with Root_Encapsulated_Access (Data));
      end Allocate;

      ---------
      -- Get --
      ---------

      function Get (P : Pointer) return Encapsulated_Access is
      begin
         return Encapsulated_Access (P.Data);
      end Get;

      ---------
      -- "=" --
      ---------

      function "=" (P1, P2 : Pointer) return Boolean is
      begin
         return P1.Data = P2.Data;
      end "=";

      --------------
      -- Finalize --
      --------------

      procedure Finalize (P : in out Pointer) is
         Data : Root_Encapsulated_Access := P.Data;
      begin
         --  Make Finalize idempotent, since it could be called several
         --  times for the same instance (RM 7.6.1(24)

         P.Data := null;

         --  Test if refcount is > 0, in case we are already freeing this
         --  element. That shouldn't happen, though, since we are not in a
         --  multi-tasking environment.

         if Data /= null then
            --  GNATCOLL uses a more efficient implementation for platforms
            --  providing the gcc builtin. Here, we keep things simpler,
            --  although less efficient.
            GNAT.Task_Lock.Lock;
            Data.Refcount := Data.Refcount - 1;
            if Data.Refcount = 0 then
               GNAT.Task_Lock.Unlock;
               Free (Data.all);
               Unchecked_Free (Data);
            else
               GNAT.Task_Lock.Unlock;
            end if;
         end if;
      end Finalize;

      ------------
      -- Adjust --
      ------------

      procedure Adjust (P : in out Pointer) is
         Dummy : Integer_32;
         pragma Unreferenced (Dummy);
         Data : constant Root_Encapsulated_Access := P.Data;
      begin
         if Data /= null then
            GNAT.Task_Lock.Lock;
            Data.Refcount := Data.Refcount + 1;
            GNAT.Task_Lock.Unlock;
         end if;
      end Adjust;

   end Smart_Pointers;

end Sax.Pointers;

APT Browse - Built by Thomas Orozco.