diff options
Diffstat (limited to 'gcc-4.4.0/gcc/ada/fname.adb')
| -rw-r--r-- | gcc-4.4.0/gcc/ada/fname.adb | 204 |
1 files changed, 0 insertions, 204 deletions
diff --git a/gcc-4.4.0/gcc/ada/fname.adb b/gcc-4.4.0/gcc/ada/fname.adb deleted file mode 100644 index 48cb20705..000000000 --- a/gcc-4.4.0/gcc/ada/fname.adb +++ /dev/null @@ -1,204 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- F N A M E -- --- -- --- B o d y -- --- -- --- 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 -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Alloc; -with Hostparm; use Hostparm; -with Table; -with Types; use Types; - -package body Fname is - - ----------------------------- - -- Dummy Table Definitions -- - ----------------------------- - - -- The following table was used in old versions of the compiler. We retain - -- the declarations here for compatibility with old tree files. The new - -- version of the compiler does not use this table, and will write out a - -- dummy empty table for Tree_Write. - - type SFN_Entry is record - U : Unit_Name_Type; - F : File_Name_Type; - end record; - - package SFN_Table is new Table.Table ( - Table_Component_Type => SFN_Entry, - Table_Index_Type => Int, - Table_Low_Bound => 0, - Table_Initial => Alloc.SFN_Table_Initial, - Table_Increment => Alloc.SFN_Table_Increment, - Table_Name => "Fname_Dummy_Table"); - - --------------------------- - -- Is_Internal_File_Name -- - --------------------------- - - function Is_Internal_File_Name - (Fname : File_Name_Type; - Renamings_Included : Boolean := True) return Boolean - is - begin - if Is_Predefined_File_Name (Fname, Renamings_Included) then - return True; - - -- Once Is_Predefined_File_Name has been called and returns False, - -- Name_Buffer contains Fname and Name_Len is set to 8. - - elsif Name_Buffer (1 .. 2) = "g-" - or else Name_Buffer (1 .. 8) = "gnat " - then - return True; - - elsif OpenVMS - and then - (Name_Buffer (1 .. 4) = "dec-" - or else Name_Buffer (1 .. 8) = "dec ") - then - return True; - - else - return False; - end if; - end Is_Internal_File_Name; - - ----------------------------- - -- Is_Predefined_File_Name -- - ----------------------------- - - -- This should really be a test of unit name, given the possibility of - -- pragma Source_File_Name setting arbitrary file names for any files??? - - -- Once Is_Predefined_File_Name has been called and returns False, - -- Name_Buffer contains Fname and Name_Len is set to 8. This is used - -- only by Is_Internal_File_Name, and is not part of the official - -- external interface of this function. - - function Is_Predefined_File_Name - (Fname : File_Name_Type; - Renamings_Included : Boolean := True) return Boolean - is - begin - Get_Name_String (Fname); - return Is_Predefined_File_Name (Renamings_Included); - end Is_Predefined_File_Name; - - function Is_Predefined_File_Name - (Renamings_Included : Boolean := True) return Boolean - is - subtype Str8 is String (1 .. 8); - - Predef_Names : constant array (1 .. 11) of Str8 := - ("ada ", -- Ada - "interfac", -- Interfaces - "system ", -- System - - -- Remaining entries are only considered if Renamings_Included true - - "calendar", -- Calendar - "machcode", -- Machine_Code - "unchconv", -- Unchecked_Conversion - "unchdeal", -- Unchecked_Deallocation - "directio", -- Direct_IO - "ioexcept", -- IO_Exceptions - "sequenio", -- Sequential_IO - "text_io "); -- Text_IO - - Num_Entries : constant Natural := - 3 + 8 * Boolean'Pos (Renamings_Included); - - begin - -- Remove extension (if present) - - if Name_Len > 4 and then Name_Buffer (Name_Len - 3) = '.' then - Name_Len := Name_Len - 4; - end if; - - -- Definitely false if longer than 12 characters (8.3) - - if Name_Len > 8 then - return False; - - -- Definitely predefined if prefix is a- i- or s- followed by letter - - elsif Name_Len >= 3 - and then Name_Buffer (2) = '-' - and then (Name_Buffer (1) = 'a' - or else - Name_Buffer (1) = 'i' - or else - Name_Buffer (1) = 's') - and then (Name_Buffer (3) in 'a' .. 'z' - or else - Name_Buffer (3) in 'A' .. 'Z') - then - return True; - end if; - - -- Otherwise check against special list, first padding to 8 characters - - while Name_Len < 8 loop - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := ' '; - end loop; - - for J in 1 .. Num_Entries loop - if Name_Buffer (1 .. 8) = Predef_Names (J) then - return True; - end if; - end loop; - - -- Note: when we return False here, the Name_Buffer contains the - -- padded file name. This is not defined for clients of the package, - -- but is used by Is_Internal_File_Name. - - return False; - end Is_Predefined_File_Name; - - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - SFN_Table.Tree_Read; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - SFN_Table.Tree_Write; - end Tree_Write; - -end Fname; |