/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;
|