X-Git-Url: https://oss.titaniummirror.com/gitweb/?a=blobdiff_plain;f=gcc%2Fada%2Ffname-sf.adb;fp=gcc%2Fada%2Ffname-sf.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=cf8d731d268922ca1caf4e6acb674903440b9090;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/fname-sf.adb b/gcc/ada/fname-sf.adb deleted file mode 100644 index cf8d731d..00000000 --- a/gcc/ada/fname-sf.adb +++ /dev/null @@ -1,138 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- F N A M E . S F -- --- -- --- B o d y -- --- -- --- $Revision: 1.1.16.1 $ --- -- --- Copyright (C) 1992-2000 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. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Casing; use Casing; -with Fname; use Fname; -with Fname.UF; use Fname.UF; -with SFN_Scan; use SFN_Scan; -with Namet; use Namet; -with Osint; use Osint; -with Types; use Types; - -with Unchecked_Conversion; - -package body Fname.SF is - - subtype Big_String is String (Positive); - type Big_String_Ptr is access all Big_String; - - function To_Big_String_Ptr is new Unchecked_Conversion - (Source_Buffer_Ptr, Big_String_Ptr); - - ---------------------- - -- Local Procedures -- - ---------------------- - - procedure Set_File_Name (Typ : Character; U : String; F : String); - -- This is a transfer function that is called from Scan_SFN_Pragmas, - -- and reformats its parameters appropriately for the version of - -- Set_File_Name found in Fname.SF. - - procedure Set_File_Name_Pattern - (Pat : String; - Typ : Character; - Dot : String; - Cas : Character); - -- This is a transfer function that is called from Scan_SFN_Pragmas, - -- and reformats its parameters appropriately for the version of - -- Set_File_Name_Pattern found in Fname.SF. - - ----------------------------------- - -- Read_Source_File_Name_Pragmas -- - ----------------------------------- - - procedure Read_Source_File_Name_Pragmas is - Src : Source_Buffer_Ptr; - Hi : Source_Ptr; - BS : Big_String_Ptr; - SP : String_Ptr; - - begin - Name_Buffer (1 .. 8) := "gnat.adc"; - Name_Len := 8; - Read_Source_File (Name_Enter, 0, Hi, Src); - - if Src /= null then - BS := To_Big_String_Ptr (Src); - SP := BS (1 .. Natural (Hi))'Unrestricted_Access; - Scan_SFN_Pragmas - (SP.all, - Set_File_Name'Access, - Set_File_Name_Pattern'Access); - end if; - end Read_Source_File_Name_Pragmas; - - ------------------- - -- Set_File_Name -- - ------------------- - - procedure Set_File_Name (Typ : Character; U : String; F : String) is - Unm : Unit_Name_Type; - Fnm : File_Name_Type; - - begin - Name_Buffer (1 .. U'Length) := U; - Name_Len := U'Length; - Set_Casing (All_Lower_Case); - Name_Buffer (Name_Len + 1) := '%'; - Name_Buffer (Name_Len + 2) := Typ; - Name_Len := Name_Len + 2; - Unm := Name_Find; - Name_Buffer (1 .. F'Length) := F; - Name_Len := F'Length; - Fnm := Name_Find; - Fname.UF.Set_File_Name (Unm, Fnm); - end Set_File_Name; - - --------------------------- - -- Set_File_Name_Pattern -- - --------------------------- - - procedure Set_File_Name_Pattern - (Pat : String; - Typ : Character; - Dot : String; - Cas : Character) - is - Ctyp : Casing_Type; - Patp : constant String_Ptr := new String'(Pat); - Dotp : constant String_Ptr := new String'(Dot); - - begin - if Cas = 'l' then - Ctyp := All_Lower_Case; - elsif Cas = 'u' then - Ctyp := All_Upper_Case; - else -- Cas = 'm' - Ctyp := Mixed_Case; - end if; - - Fname.UF.Set_File_Name_Pattern (Patp, Typ, Dotp, Ctyp); - end Set_File_Name_Pattern; - -end Fname.SF;