From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/ada/s-finimp.ads | 158 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 158 insertions(+) create mode 100644 gcc/ada/s-finimp.ads (limited to 'gcc/ada/s-finimp.ads') diff --git a/gcc/ada/s-finimp.ads b/gcc/ada/s-finimp.ads new file mode 100644 index 000000000..944fe6f11 --- /dev/null +++ b/gcc/ada/s-finimp.ads @@ -0,0 +1,158 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . F I N A L I Z A T I O N _ I M P L E M E N T A T I O N -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Conversion; + +with System.Storage_Elements; +with System.Finalization_Root; + +package System.Finalization_Implementation is + pragma Elaborate_Body; + + package SSE renames System.Storage_Elements; + package SFR renames System.Finalization_Root; + + ------------------------------------------------ + -- Finalization Management Abstract Interface -- + ------------------------------------------------ + + function To_Finalizable_Ptr is new Ada.Unchecked_Conversion + (Source => System.Address, Target => SFR.Finalizable_Ptr); + + Collection_Finalization_Started : constant SFR.Finalizable_Ptr := + To_Finalizable_Ptr (SSE.To_Address (1)); + -- This is used to implement the rule in RM 4.8(10.2/2) that requires an + -- allocator to raise Program_Error if the collection finalization has + -- already started. See also Ada.Finalization.List_Controller. Finalize on + -- List_Controller first sets the list to Collection_Finalization_Started, + -- to indicate that finalization has started. An allocator will call + -- Attach_To_Final_List, which checks for the special value and raises + -- Program_Error if appropriate. The Collection_Finalization_Started value + -- must be different from 'Access of any finalizable object, and different + -- from null. See AI-280. + + Global_Final_List : SFR.Finalizable_Ptr; + -- This list stores the controlled objects defined in library-level + -- packages. They will be finalized after the main program completion. + + procedure Finalize_Global_List; + -- The procedure to be called in order to finalize the global list + + procedure Attach_To_Final_List + (L : in out SFR.Finalizable_Ptr; + Obj : in out SFR.Finalizable; + Nb_Link : Short_Short_Integer); + -- Attach finalizable object Obj to the linked list L. Nb_Link controls the + -- number of link of the linked_list, and is one of: 0 for no attachment, 1 + -- for simple linked lists or 2 for doubly linked lists or even 3 for a + -- simple attachment of a whole array of elements. Attachment to a simply + -- linked list is not protected against concurrent access and should only + -- be used in contexts where it doesn't matter, such as for objects + -- allocated on the stack. In the case of an attachment on a doubly linked + -- list, L must not be null and Obj will be inserted AFTER the first + -- element and the attachment is protected against concurrent call. + -- Typically used to attach to a dynamically allocated object to a + -- List_Controller (whose first element is always a dummy element) + + type Finalizable_Ptr_Ptr is access all SFR.Finalizable_Ptr; + -- A pointer to a finalization list. This is used as the type of the extra + -- implicit formal which are passed to build-in-place functions that return + -- controlled types (see Sem_Ch6). That extra formal is then passed on to + -- Move_Final_List (below). + + procedure Move_Final_List + (From : in out SFR.Finalizable_Ptr; + To : Finalizable_Ptr_Ptr); + -- Move all objects on From list to To list. This is used to implement + -- build-in-place function returns. The return object is initially placed + -- on a finalization list local to the return statement, in case the + -- return statement is left prematurely (due to raising an exception, + -- being aborted, or a goto or exit statement). Once the return statement + -- has completed successfully, Move_Final_List is called to move the + -- return object to the caller's finalization list. + + procedure Finalize_List (L : SFR.Finalizable_Ptr); + -- Call Finalize on each element of the list L + + procedure Finalize_One (Obj : in out SFR.Finalizable); + -- Call Finalize on Obj and remove its final list + + --------------------- + -- Deep Procedures -- + --------------------- + + procedure Deep_Tag_Attach + (L : in out SFR.Finalizable_Ptr; + A : System.Address; + B : Short_Short_Integer); + -- Generic attachment for tagged objects with controlled components. + -- A is the address of the object, L the finalization list when it needs + -- to be attached and B the attachment level (see Attach_To_Final_List). + + ----------------------------- + -- Record Controller Types -- + ----------------------------- + + -- Definition of the types of the controller component that is included + -- in records containing controlled components. This controller is + -- attached to the finalization chain of the upper-level and carries + -- the pointer of the finalization chain for the lower level. + + type Limited_Record_Controller is new SFR.Root_Controlled with record + F : SFR.Finalizable_Ptr; + end record; + + overriding procedure Initialize (Object : in out Limited_Record_Controller); + -- Does nothing currently + + overriding procedure Finalize (Object : in out Limited_Record_Controller); + -- Finalize the controlled components of the enclosing record by following + -- the list starting at Object.F. + + type Record_Controller is + new Limited_Record_Controller with record + My_Address : System.Address; + end record; + + overriding procedure Initialize (Object : in out Record_Controller); + -- Initialize the field My_Address to the Object'Address + + overriding procedure Adjust (Object : in out Record_Controller); + -- Adjust the components and their finalization pointers by subtracting by + -- the offset of the target and the source addresses of the assignment. + + -- Inherit Finalize from Limited_Record_Controller + + procedure Detach_From_Final_List (Obj : in out SFR.Finalizable); + -- Remove the specified object from its Final list, which must be a doubly + -- linked list. + +end System.Finalization_Implementation; -- cgit v1.2.3