URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [sinput-p.adb] - Rev 714
Go to most recent revision | Compare with Previous | Blame | View Log
------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- S I N P U T . P -- -- -- -- B o d y -- -- -- -- Copyright (C) 1992-2012, 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 ('$'); Check_For_BOM; -- 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;
Go to most recent revision | Compare with Previous | Blame | View Log