X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=gcc%2Fada%2Ffname.adb;fp=gcc%2Fada%2Ffname.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=3a766a0ac75dc0431279c7572e2b16ee204cc627;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/fname.adb b/gcc/ada/fname.adb deleted file mode 100644 index 3a766a0a..00000000 --- a/gcc/ada/fname.adb +++ /dev/null @@ -1,224 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- F N A M E -- --- -- --- B o d y -- --- -- --- $Revision: 1.1.16.1 $ --- -- --- Copyright (C) 1992-2001, 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 2, 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 COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- 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 Namet; use Namet; -with Table; - -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"); - ---------------------------- - -- Get_Expected_Unit_Type -- - ---------------------------- - - -- We assume that a file name whose last character is a lower case b is - -- a body and a file name whose last character is a lower case s is a - -- spec. If any other character is found (e.g. when we are in syntax - -- checking only mode, where the file name conventions are not set), - -- then we return Unknown. - - function Get_Expected_Unit_Type - (Fname : File_Name_Type) - return Expected_Unit_Type - is - begin - Get_Name_String (Fname); - - if Name_Buffer (Name_Len) = 'b' then - return Expect_Body; - elsif Name_Buffer (Name_Len) = 's' then - return Expect_Spec; - else - return Unknown; - end if; - end Get_Expected_Unit_Type; - - --------------------------- - -- 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 - subtype Str8 is String (1 .. 8); - - Predef_Names : array (1 .. 11) of Str8 := - ("ada ", -- Ada - "calendar", -- Calendar - "interfac", -- Interfaces - "system ", -- System - "machcode", -- Machine_Code - "unchconv", -- Unchecked_Conversion - "unchdeal", -- Unchecked_Deallocation - - -- Remaining entries are only considered if Renamings_Included true - - "directio", -- Direct_IO - "ioexcept", -- IO_Exceptions - "sequenio", -- Sequential_IO - "text_io "); -- Text_IO - - Num_Entries : constant Natural := - 7 + 4 * Boolean'Pos (Renamings_Included); - - begin - -- Get file name, removing the extension (if any) - - Get_Name_String (Fname); - - 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- - - elsif Name_Len > 2 - and then Name_Buffer (2) = '-' - and then (Name_Buffer (1) = 'a' or else - Name_Buffer (1) = 'i' or else - Name_Buffer (1) = 's') - 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;