diff options
author | Jing Yu <jingyu@google.com> | 2011-12-19 16:56:54 -0800 |
---|---|---|
committer | Jing Yu <jingyu@google.com> | 2011-12-19 16:56:54 -0800 |
commit | 40d7cd0fd78fe2004e2a53c4618c148339b02733 (patch) | |
tree | 5874557a6c86a1f564a03e5f28b266e31bc3759c /gcc-4.6/gcc/ada/sinput-p.adb | |
parent | fe2afdf3f3701489c05d2a7509752d6f0c7616f7 (diff) | |
download | toolchain_gcc-40d7cd0fd78fe2004e2a53c4618c148339b02733.tar.gz toolchain_gcc-40d7cd0fd78fe2004e2a53c4618c148339b02733.tar.bz2 toolchain_gcc-40d7cd0fd78fe2004e2a53c4618c148339b02733.zip |
Add gcc-4.6. Synced to @180989
Change-Id: Ie3676586e1d8e3c8cd9f07d022f450d05fa08439
svn://gcc.gnu.org/svn/gcc/branches/google/gcc-4_6-mobile
Diffstat (limited to 'gcc-4.6/gcc/ada/sinput-p.adb')
-rw-r--r-- | gcc-4.6/gcc/ada/sinput-p.adb | 184 |
1 files changed, 184 insertions, 0 deletions
diff --git a/gcc-4.6/gcc/ada/sinput-p.adb b/gcc-4.6/gcc/ada/sinput-p.adb new file mode 100644 index 000000000..cd513d010 --- /dev/null +++ b/gcc-4.6/gcc/ada/sinput-p.adb @@ -0,0 +1,184 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S I N P U T . P -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2010, 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. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- +-- -- +-- 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 Ada.Unchecked_Deallocation; + +with Prj.Err; +with Sinput.C; + +with System; + +package body Sinput.P is + + First : Boolean := True; + -- Flag used when Load_Project_File is called the first time, + -- to set Main_Source_File. + -- The flag is reset to False at the first call to Load_Project_File. + -- Calling Reset_First sets it back to True. + + procedure Free is new Ada.Unchecked_Deallocation + (Lines_Table_Type, Lines_Table_Ptr); + + procedure Free is new Ada.Unchecked_Deallocation + (Logical_Lines_Table_Type, Logical_Lines_Table_Ptr); + + ----------------------------- + -- Clear_Source_File_Table -- + ----------------------------- + + procedure Clear_Source_File_Table is + use System; + + begin + for X in 1 .. Source_File.Last loop + declare + S : Source_File_Record renames Source_File.Table (X); + Lo : constant Source_Ptr := S.Source_First; + Hi : constant Source_Ptr := S.Source_Last; + subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi); + -- Physical buffer allocated + + type Actual_Source_Ptr is access Actual_Source_Buffer; + -- This is the pointer type for the physical buffer allocated + + procedure Free is new Ada.Unchecked_Deallocation + (Actual_Source_Buffer, Actual_Source_Ptr); + + pragma Suppress (All_Checks); + + pragma Warnings (Off); + -- The following unchecked conversion is aliased safe, since it + -- is not used to create improperly aliased pointer values. + + function To_Actual_Source_Ptr is new + Ada.Unchecked_Conversion (Address, Actual_Source_Ptr); + + pragma Warnings (On); + + Actual_Ptr : Actual_Source_Ptr := + To_Actual_Source_Ptr (S.Source_Text (Lo)'Address); + + begin + Free (Actual_Ptr); + Free (S.Lines_Table); + Free (S.Logical_Lines_Table); + end; + end loop; + + Source_File.Free; + Sinput.Initialize; + end Clear_Source_File_Table; + + ----------------------- + -- Load_Project_File -- + ----------------------- + + function Load_Project_File (Path : String) return Source_File_Index is + X : Source_File_Index; + + begin + X := Sinput.C.Load_File (Path); + + if First then + Main_Source_File := X; + First := False; + end if; + + return X; + end Load_Project_File; + + ----------------- + -- Reset_First -- + ----------------- + + procedure Reset_First is + begin + First := True; + end Reset_First; + + -------------------------------- + -- Restore_Project_Scan_State -- + -------------------------------- + + procedure Restore_Project_Scan_State + (Saved_State : Saved_Project_Scan_State) + is + begin + Restore_Scan_State (Saved_State.Scan_State); + Source := Saved_State.Source; + Current_Source_File := Saved_State.Current_Source_File; + end Restore_Project_Scan_State; + + ----------------------------- + -- Save_Project_Scan_State -- + ----------------------------- + + procedure Save_Project_Scan_State + (Saved_State : out Saved_Project_Scan_State) + is + begin + Save_Scan_State (Saved_State.Scan_State); + Saved_State.Source := Source; + Saved_State.Current_Source_File := Current_Source_File; + end Save_Project_Scan_State; + + ---------------------------- + -- Source_File_Is_Subunit -- + ---------------------------- + + function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is + begin + -- Nothing to do if X is no source file, so simply return False + + if X = No_Source_File then + return False; + end if; + + Prj.Err.Scanner.Initialize_Scanner (X); + + -- No error for special characters that are used for preprocessing + + Prj.Err.Scanner.Set_Special_Character ('#'); + Prj.Err.Scanner.Set_Special_Character ('$'); + + -- We scan past junk to the first interesting compilation unit token, to + -- see if it is SEPARATE. We ignore WITH keywords during this and also + -- PRIVATE. The reason for ignoring PRIVATE is that it handles some + -- error situations, and also to handle PRIVATE WITH in Ada 2005 mode. + + while Token = Tok_With + or else Token = Tok_Private + or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF) + loop + Prj.Err.Scanner.Scan; + end loop; + + Prj.Err.Scanner.Reset_Special_Characters; + + return Token = Tok_Separate; + end Source_File_Is_Subunit; + +end Sinput.P; |