1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- SYSTEM.STORAGE_POOLS.SUBPOOLS.FINALIZATION -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2011-2012, 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 32with Ada.Unchecked_Deallocation; 33 34with System.Finalization_Masters; use System.Finalization_Masters; 35 36package body System.Storage_Pools.Subpools.Finalization is 37 38 ----------------------------- 39 -- Finalize_And_Deallocate -- 40 ----------------------------- 41 42 procedure Finalize_And_Deallocate (Subpool : in out Subpool_Handle) is 43 procedure Free is new Ada.Unchecked_Deallocation (SP_Node, SP_Node_Ptr); 44 45 begin 46 -- Do nothing if the subpool was never created or never used. The latter 47 -- case may arise with an array of subpool implementations. 48 49 if Subpool = null 50 or else Subpool.Owner = null 51 or else Subpool.Node = null 52 then 53 return; 54 end if; 55 56 -- Clean up all controlled objects chained on the subpool's master 57 58 Finalize (Subpool.Master); 59 60 -- Remove the subpool from its owner's list of subpools 61 62 Detach (Subpool.Node); 63 64 -- Destroy the associated doubly linked list node which was created in 65 -- Set_Pool_Of_Subpools. 66 67 Free (Subpool.Node); 68 69 -- Dispatch to the user-defined implementation of Deallocate_Subpool 70 71 Deallocate_Subpool (Pool_Of_Subpool (Subpool).all, Subpool); 72 73 Subpool := null; 74 end Finalize_And_Deallocate; 75 76end System.Storage_Pools.Subpools.Finalization; 77