X-Git-Url: https://oss.titaniummirror.com/gitweb/?a=blobdiff_plain;f=gcc%2Fada%2Fxref_lib.adb;fp=gcc%2Fada%2Fxref_lib.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=8fc80447c6e6b757d21835378d3acd3b3d63d7e2;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb deleted file mode 100644 index 8fc80447..00000000 --- a/gcc/ada/xref_lib.adb +++ /dev/null @@ -1,1676 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- X R E F _ L I B -- --- -- --- B o d y -- --- -- --- $Revision: 1.1.16.1 $ --- -- --- Copyright (C) 1998-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. -- --- -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Ada.Strings.Fixed; use Ada.Strings.Fixed; -with GNAT.Command_Line; use GNAT.Command_Line; -with GNAT.IO_Aux; use GNAT.IO_Aux; -with Osint; -with Output; use Output; -with Types; use Types; -with Unchecked_Deallocation; - -package body Xref_Lib is - - Type_Position : constant := 50; - -- Column for label identifying type of entity - - --------------------- - -- Local Variables -- - --------------------- - - D : constant Character := 'D'; - X : constant Character := 'X'; - W : constant Character := 'W'; - Dot : constant Character := '.'; - - Pipe : constant Character := '|'; - -- First character on xref lines in the .ali file - - EOF : constant Character := ASCII.SUB; - -- Special character to signal end of file. Not required in input file, - -- but should be properly treated if present. See also Read_File. - - No_Xref_Information : exception; - -- Exception raised when there is no cross-referencing information in - -- the .ali files - - subtype File_Offset is Natural; - - function End_Of_Line_Index (File : ALI_File) return Integer; - -- Returns the index of the last character of the current_line - - procedure Read_File - (FD : File_Descriptor; - Contents : out String_Access; - Success : out Boolean); - -- Reads file associated with FS into the newly allocated - -- string Contents. An EOF character will be added to the - -- returned Contents to simplify parsing. - -- [VMS] Success is true iff the number of bytes read is less than or - -- equal to the file size. - -- [Other] Success is true iff the number of bytes read is equal to - -- the file size. - - procedure Parse_EOL (Source : access String; Ptr : in out Positive); - -- On return Source (Ptr) is the first character of the next line - -- or EOF. Source.all must be terminated by EOF. - - procedure Parse_Identifier_Info - (Pattern : Search_Pattern; - File : in out ALI_File; - Local_Symbols : Boolean; - Der_Info : Boolean := False; - Type_Tree : Boolean := False; - Wide_Search : Boolean := True); - -- Output the file and the line where the identifier was referenced, - -- If Local_Symbols is False then only the publicly visible symbols - -- will be processed - - procedure Parse_Token - (Source : access String; - Ptr : in out Positive; - Token_Ptr : out Positive); - -- Skips any separators and stores the start of the token in Token_Ptr. - -- Then stores the position of the next separator in Ptr. - -- On return Source (Token_Ptr .. Ptr - 1) is the token. - -- Separators are space and ASCII.HT. - -- Parse_Token will never skip to the next line. - - procedure Parse_Number - (Source : access String; - Ptr : in out Positive; - Number : out Natural); - -- Skips any separators and parses Source upto the first character that - -- is not a decimal digit. Returns value of parsed digits or 0 if none. - - procedure Parse_X_Filename (File : in out ALI_File); - -- Reads and processes "X..." lines in the ALI file - -- and updates the File.X_File information. - - ---------------- - -- Add_Entity -- - ---------------- - - procedure Add_Entity - (Pattern : in out Search_Pattern; - Entity : String; - Glob : Boolean := False) - is - File_Start : Natural; - Line_Start : Natural; - Col_Start : Natural; - Line_Num : Natural := 0; - Col_Num : Natural := 0; - File_Ref : File_Reference := Empty_File; - File_Existed : Boolean; - Has_Pattern : Boolean := False; - - begin - -- Find the end of the first item in Entity (pattern or file?) - -- If there is no ':', we only have a pattern - - File_Start := Index (Entity, ":"); - if File_Start = 0 then - - -- If the regular expression is invalid, just consider it as a string - - begin - Pattern.Entity := Compile (Entity, Glob, False); - Pattern.Initialized := True; - - exception - when Error_In_Regexp => - - -- The basic idea is to insert a \ before every character - - declare - Tmp_Regexp : String (1 .. 2 * Entity'Length); - Index : Positive := 1; - - begin - for J in Entity'Range loop - Tmp_Regexp (Index) := '\'; - Tmp_Regexp (Index + 1) := Entity (J); - Index := Index + 2; - end loop; - - Pattern.Entity := Compile (Tmp_Regexp, True, False); - Pattern.Initialized := True; - end; - end; - - Set_Default_Match (True); - return; - end if; - - -- If there is a dot in the pattern, then it is a file name - - if (Glob and then - Index (Entity (Entity'First .. File_Start - 1), ".") /= 0) - or else - (not Glob - and then Index (Entity (Entity'First .. File_Start - 1), - "\.") /= 0) - then - Pattern.Entity := Compile (".*", False); - Pattern.Initialized := True; - File_Start := Entity'First; - - else - -- If the regular expression is invalid, - -- just consider it as a string - - begin - Pattern.Entity := - Compile (Entity (Entity'First .. File_Start - 1), Glob, False); - Pattern.Initialized := True; - - exception - when Error_In_Regexp => - - -- The basic idea is to insert a \ before every character - - declare - Tmp_Regexp : String (1 .. 2 * (File_Start - Entity'First)); - Index : Positive := 1; - - begin - for J in Entity'First .. File_Start - 1 loop - Tmp_Regexp (Index) := '\'; - Tmp_Regexp (Index + 1) := Entity (J); - Index := Index + 2; - end loop; - - Pattern.Entity := Compile (Tmp_Regexp, True, False); - Pattern.Initialized := True; - end; - end; - - File_Start := File_Start + 1; - Has_Pattern := True; - end if; - - -- Parse the file name - - Line_Start := Index (Entity (File_Start .. Entity'Last), ":"); - - -- Check if it was a disk:\directory item (for NT and OS/2) - - if File_Start = Line_Start - 1 - and then Line_Start < Entity'Last - and then Entity (Line_Start + 1) = '\' - then - Line_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":"); - end if; - - if Line_Start = 0 then - Line_Start := Entity'Length + 1; - - elsif Line_Start /= Entity'Last then - Col_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":"); - - if Col_Start = 0 then - Col_Start := Entity'Last + 1; - end if; - - if Col_Start > Line_Start + 1 then - begin - Line_Num := Natural'Value - (Entity (Line_Start + 1 .. Col_Start - 1)); - - exception - when Constraint_Error => - raise Invalid_Argument; - end; - end if; - - if Col_Start < Entity'Last then - begin - Col_Num := Natural'Value (Entity - (Col_Start + 1 .. Entity'Last)); - - exception - when Constraint_Error => raise Invalid_Argument; - end; - end if; - end if; - - Add_File (Entity (File_Start .. Line_Start - 1), - File_Existed, - File_Ref, - Visited => True); - Add_Line (File_Ref, Line_Num, Col_Num); - Add_File - (ALI_File_Name (Entity (File_Start .. Line_Start - 1)), - File_Existed, File_Ref, - Visited => False, - Emit_Warning => True); - end Add_Entity; - - -------------- - -- Add_File -- - -------------- - - procedure Add_File (File : String) is - File_Ref : File_Reference := Empty_File; - File_Existed : Boolean; - Iterator : Expansion_Iterator; - - procedure Add_File_Internal (File : String); - -- Do the actual addition of the file - - ----------------------- - -- Add_File_Internal -- - ----------------------- - - procedure Add_File_Internal (File : String) is - begin - -- Case where we have an ALI file, accept it even though this is - -- not official usage, since the intention is obvious - - if Tail (File, 4) = ".ali" then - Add_File - (File, - File_Existed, - File_Ref, - Visited => False, - Emit_Warning => True); - - -- Normal non-ali file case - - else - Add_File - (File, - File_Existed, - File_Ref, - Visited => True); - - Add_File - (ALI_File_Name (File), - File_Existed, - File_Ref, - Visited => False, - Emit_Warning => True); - end if; - end Add_File_Internal; - - -- Start of processing for Add_File - - begin - -- Check if we need to do the expansion - - if Ada.Strings.Fixed.Index (File, "*") /= 0 - or else Ada.Strings.Fixed.Index (File, "?") /= 0 - then - Start_Expansion (Iterator, File); - - loop - declare - S : constant String := Expansion (Iterator); - - begin - exit when S'Length = 0; - Add_File_Internal (S); - end; - end loop; - - else - Add_File_Internal (File); - end if; - end Add_File; - - ----------------------- - -- Current_Xref_File -- - ----------------------- - - function Current_Xref_File (File : ALI_File) return File_Reference is - begin - return File.X_File; - end Current_Xref_File; - - -------------------------- - -- Default_Project_File -- - -------------------------- - - function Default_Project_File - (Dir_Name : String) - return String - is - My_Dir : Dir_Type; - Dir_Ent : File_Name_String; - Last : Natural; - - begin - Open (My_Dir, Dir_Name); - - loop - Read (My_Dir, Dir_Ent, Last); - exit when Last = 0; - - if Tail (Dir_Ent (1 .. Last), 4) = ".adp" then - - -- The first project file found is the good one. - - Close (My_Dir); - return Dir_Ent (1 .. Last); - end if; - end loop; - - Close (My_Dir); - return String'(1 .. 0 => ' '); - - exception - when Directory_Error => return String'(1 .. 0 => ' '); - end Default_Project_File; - - ----------------------- - -- End_Of_Line_Index -- - ----------------------- - - function End_Of_Line_Index (File : ALI_File) return Integer is - Index : Integer := File.Current_Line; - begin - while Index <= File.Buffer'Last - and then File.Buffer (Index) /= ASCII.LF - loop - Index := Index + 1; - end loop; - - return Index; - end End_Of_Line_Index; - - --------------- - -- File_Name -- - --------------- - - function File_Name - (File : ALI_File; - Num : Positive) - return File_Reference - is - begin - return File.Dep.Table (Num); - end File_Name; - - -------------------- - -- Find_ALI_Files -- - -------------------- - - procedure Find_ALI_Files is - My_Dir : Rec_DIR; - Dir_Ent : File_Name_String; - Last : Natural; - File_Existed : Boolean; - File_Ref : File_Reference; - - function Open_Next_Dir return Boolean; - -- Tries to open the next object directory, and return False if - -- the directory cannot be opened. - - ------------------- - -- Open_Next_Dir -- - ------------------- - - function Open_Next_Dir return Boolean is - begin - -- Until we are able to open a new directory - - loop - declare - Obj_Dir : constant String := Next_Obj_Dir; - - begin - -- If there was no more Obj_Dir line - - if Obj_Dir'Length = 0 then - return False; - end if; - - Open (My_Dir.Dir, Obj_Dir); - exit; - - exception - -- Could not open the directory - - when Directory_Error => null; - end; - end loop; - - return True; - end Open_Next_Dir; - - -- Start of processing for Find_ALI_Files - - begin - if Open_Next_Dir then - loop - Read (My_Dir.Dir, Dir_Ent, Last); - - if Last = 0 then - Close (My_Dir.Dir); - - if not Open_Next_Dir then - return; - end if; - - elsif Last > 4 and then Dir_Ent (Last - 3 .. Last) = ".ali" then - Add_File (Dir_Ent (1 .. Last), File_Existed, File_Ref, - Visited => False); - Set_Directory (File_Ref, Current_Obj_Dir); - end if; - end loop; - end if; - end Find_ALI_Files; - - ------------------- - -- Get_Full_Type -- - ------------------- - - function Get_Full_Type (Abbrev : Character) return String is - begin - case Abbrev is - when 'A' => return "array type"; - when 'B' => return "boolean type"; - when 'C' => return "class-wide type"; - when 'D' => return "decimal type"; - when 'E' => return "enumeration type"; - when 'F' => return "float type"; - when 'I' => return "integer type"; - when 'M' => return "modular type"; - when 'O' => return "fixed type"; - when 'P' => return "access type"; - when 'R' => return "record type"; - when 'S' => return "string type"; - when 'T' => return "task type"; - when 'W' => return "protected type"; - - when 'a' => return "array type"; - when 'b' => return "boolean object"; - when 'c' => return "class-wide object"; - when 'd' => return "decimal object"; - when 'e' => return "enumeration object"; - when 'f' => return "float object"; - when 'i' => return "integer object"; - when 'm' => return "modular object"; - when 'o' => return "fixed object"; - when 'p' => return "access object"; - when 'r' => return "record object"; - when 's' => return "string object"; - when 't' => return "task object"; - when 'w' => return "protected object"; - - when 'K' => return "package"; - when 'k' => return "generic package"; - when 'L' => return "statement label"; - when 'l' => return "loop label"; - when 'N' => return "named number"; - when 'n' => return "enumeration literal"; - when 'q' => return "block label"; - when 'U' => return "procedure"; - when 'u' => return "generic procedure"; - when 'V' => return "function"; - when 'v' => return "generic function"; - when 'X' => return "exception"; - when 'Y' => return "entry"; - - -- The above should be the only possibilities, but for a - -- tool like this we don't want to bomb if we find something - -- else, so just return ??? when we have an unknown Abbrev value - - when others => - return "???"; - end case; - end Get_Full_Type; - - ----------- - -- Match -- - ----------- - - function Match - (Pattern : Search_Pattern; - Symbol : String) - return Boolean - is - begin - -- Get the entity name - - return Match (Symbol, Pattern.Entity); - end Match; - - ---------- - -- Open -- - ---------- - - procedure Open - (Name : String; - File : out ALI_File; - Dependencies : Boolean := False) - is - Name_0 : constant String := Name & ASCII.NUL; - Num_Dependencies : Natural := 0; - File_Existed : Boolean; - File_Ref : File_Reference; - FD : File_Descriptor; - Success : Boolean := False; - Ali : String_Access renames File.Buffer; - Token : Positive; - Ptr : Positive; - File_Start : Positive; - File_End : Positive; - Gnatchop_Offset : Integer; - Gnatchop_Name : Positive; - - begin - if File.Buffer /= null then - Free (File.Buffer); - end if; - - Init (File.Dep); - - FD := Open_Read (Name_0'Address, Binary); - - if FD = Invalid_FD then - raise No_Xref_Information; - end if; - - Read_File (FD, Ali, Success); - Close (FD); - - Ptr := Ali'First; - - -- Read all the lines possibly processing with-clauses and dependency - -- information and exit on finding the first Xref line. - -- A fall-through of the loop means that there is no xref information - -- which is an error condition. - - while Ali (Ptr) /= EOF loop - - if Ali (Ptr) = D then - -- Found dependency information. Format looks like: - -- D source-name time-stamp checksum [subunit-name] \ - -- [line:file-name] - - -- Skip the D and parse the filename - - Ptr := Ptr + 1; - Parse_Token (Ali, Ptr, Token); - File_Start := Token; - File_End := Ptr - 1; - - Num_Dependencies := Num_Dependencies + 1; - Set_Last (File.Dep, Num_Dependencies); - - Parse_Token (Ali, Ptr, Token); -- Skip time-stamp - Parse_Token (Ali, Ptr, Token); -- Skip checksum - Parse_Token (Ali, Ptr, Token); -- Read next entity on the line - - if not (Ali (Token) in '0' .. '9') then - Parse_Token (Ali, Ptr, Token); -- Was a subunit name - end if; - - -- Did we have a gnatchop-ed file with a pragma Source_Reference ? - Gnatchop_Offset := 0; - - if Ali (Token) in '0' .. '9' then - Gnatchop_Name := Token; - while Ali (Gnatchop_Name) /= ':' loop - Gnatchop_Name := Gnatchop_Name + 1; - end loop; - Gnatchop_Offset := - 2 - Natural'Value (Ali (Token .. Gnatchop_Name - 1)); - Token := Gnatchop_Name + 1; - end if; - - Add_File - (Ali (File_Start .. File_End), - File_Existed, - File.Dep.Table (Num_Dependencies), - Gnatchop_File => Ali (Token .. Ptr - 1), - Gnatchop_Offset => Gnatchop_Offset); - - elsif Dependencies and then Ali (Ptr) = W then - -- Found with-clause information. Format looks like: - -- "W debug%s debug.adb debug.ali" - - -- Skip the W and parse the .ali filename (3rd token) - - Parse_Token (Ali, Ptr, Token); - Parse_Token (Ali, Ptr, Token); - Parse_Token (Ali, Ptr, Token); - - Add_File - (Ali (Token .. Ptr - 1), - File_Existed, File_Ref, - Visited => False); - - elsif Ali (Ptr) = X then - -- Found a cross-referencing line - stop processing - - File.Current_Line := Ptr; - File.Xref_Line := Ptr; - return; - end if; - - Parse_EOL (Ali, Ptr); - end loop; - - raise No_Xref_Information; - end Open; - - --------------- - -- Parse_EOL -- - --------------- - - procedure Parse_EOL (Source : access String; Ptr : in out Positive) is - begin - -- Skip to end of line - - while Source (Ptr) /= ASCII.CR and then Source (Ptr) /= ASCII.LF - and then Source (Ptr) /= EOF - loop - Ptr := Ptr + 1; - end loop; - - if Source (Ptr) /= EOF then - Ptr := Ptr + 1; -- skip CR or LF - end if; - - -- Skip past CR/LF or LF/CR combination - - if (Source (Ptr) = ASCII.CR or else Source (Ptr) = ASCII.LF) - and then Source (Ptr) /= Source (Ptr - 1) - then - Ptr := Ptr + 1; - end if; - end Parse_EOL; - - --------------------------- - -- Parse_Identifier_Info -- - --------------------------- - - procedure Parse_Identifier_Info - (Pattern : Search_Pattern; - File : in out ALI_File; - Local_Symbols : Boolean; - Der_Info : Boolean := False; - Type_Tree : Boolean := False; - Wide_Search : Boolean := True) - is - Ptr : Positive renames File.Current_Line; - Ali : String_Access renames File.Buffer; - - E_Line : Natural; -- Line number of current entity - E_Col : Natural; -- Column number of current entity - E_Type : Character; -- Type of current entity - E_Name : Positive; -- Pointer to begin of entity name - E_Global : Boolean; -- True iff entity is global - - R_Line : Natural; -- Line number of current reference - R_Col : Natural; -- Column number of current reference - R_Type : Character; -- Type of current reference - - Decl_Ref : Declaration_Reference; - File_Ref : File_Reference := Current_Xref_File (File); - - function Get_Symbol_Name (Eun, Line, Col : Natural) return String; - -- Returns the symbol name for the entity defined at the specified - -- line and column in the dependent unit number Eun. For this we need - -- to parse the ali file again because the parent entity is not in - -- the declaration table if it did not match the search pattern. - - --------------------- - -- Get_Symbol_Name -- - --------------------- - - function Get_Symbol_Name (Eun, Line, Col : Natural) return String is - Ptr : Positive := 1; - E_Eun : Positive; -- Unit number of current entity - E_Line : Natural; -- Line number of current entity - E_Col : Natural; -- Column number of current entity - E_Name : Positive; -- Pointer to begin of entity name - E_Type : Character; -- Type of current entity - - procedure Skip_Line; - -- skip current line and continuation line - - procedure Skip_Line is - begin - loop - Parse_EOL (Ali, Ptr); - exit when Ali (Ptr) /= '.'; - end loop; - end Skip_Line; - - -- Start of processing for Get_Symbol_Name - - begin - -- Look for the X lines corresponding to unit Eun - - loop - if Ali (Ptr) = 'X' then - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, E_Eun); - exit when E_Eun = Eun; - end if; - - Skip_Line; - end loop; - - -- Here we are in the right Ali section, we now look for the entity - -- declared at position (Line, Col). - - loop - Parse_Number (Ali, Ptr, E_Line); - E_Type := Ali (Ptr); - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, E_Col); - Ptr := Ptr + 1; - - if Line = E_Line and then Col = E_Col then - Parse_Token (Ali, Ptr, E_Name); - return Ali (E_Name .. Ptr - 1); - end if; - - Skip_Line; - end loop; - - -- We were not able to find the symbol, this should not happend but - -- since we don't want to stop here we return a string of three - -- question marks as the symbol name. - - return "???"; - end Get_Symbol_Name; - - -- Start of processing for Parse_Identifier_Info - - begin - -- The identifier info looks like: - -- "38U9*Debug 12|36r6 36r19" - - -- Extract the line, column and entity name information - - Parse_Number (Ali, Ptr, E_Line); - - if Ali (Ptr) > ' ' then - E_Type := Ali (Ptr); - Ptr := Ptr + 1; - end if; - - Parse_Number (Ali, Ptr, E_Col); - - E_Global := False; - if Ali (Ptr) >= ' ' then - E_Global := (Ali (Ptr) = '*'); - Ptr := Ptr + 1; - end if; - - Parse_Token (Ali, Ptr, E_Name); - - -- Exit if the symbol does not match - -- or if we have a local symbol and we do not want it - - if (not Local_Symbols and not E_Global) - or else (Pattern.Initialized - and then not Match (Pattern, Ali (E_Name .. Ptr - 1))) - or else (E_Name >= Ptr) - then - -- Skip rest of this line and all continuation lines - - loop - Parse_EOL (Ali, Ptr); - exit when Ali (Ptr) /= '.'; - end loop; - return; - end if; - - -- Insert the declaration in the table - - Decl_Ref := Add_Declaration - (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type); - - if Ali (Ptr) = '<' then - - -- Here we have a type derivation information. The format is - -- <3|12I45> which means that the current entity is derived from the - -- type defined in unit number 3, line 12 column 45. The pipe and - -- unit number is optional. It is specified only if the parent type - -- is not defined in the current unit. - - Ptr := Ptr + 1; - - Parse_Derived_Info : declare - P_Line : Natural; -- parent entity line - P_Column : Natural; -- parent entity column - P_Type : Character; -- parent entity type - P_Eun : Positive; -- parent entity file number - - begin - Parse_Number (Ali, Ptr, P_Line); - - -- If we have a pipe then the first number was the unit number - - if Ali (Ptr) = '|' then - P_Eun := P_Line; - Ptr := Ptr + 1; - - -- Now we have the line number - - Parse_Number (Ali, Ptr, P_Line); - - else - -- We don't have a unit number specified, so we set P_Eun to - -- the current unit. - - for K in Dependencies_Tables.First .. Last (File.Dep) loop - P_Eun := K; - exit when File.Dep.Table (K) = File_Ref; - end loop; - end if; - - -- Then parse the type and column number - - P_Type := Ali (Ptr); - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, P_Column); - - -- Skip '>' - - Ptr := Ptr + 1; - - -- The derived info is needed only is the derived info mode is on - -- or if we want to output the type hierarchy - - if Der_Info or else Type_Tree then - Add_Parent - (Decl_Ref, - Get_Symbol_Name (P_Eun, P_Line, P_Column), - P_Line, - P_Column, - File.Dep.Table (P_Eun)); - end if; - - if Type_Tree then - Search_Parent_Tree : declare - Pattern : Search_Pattern; -- Parent type pattern - File_Pos_Backup : Positive; - - begin - Add_Entity - (Pattern, - Get_Symbol_Name (P_Eun, P_Line, P_Column) - & ':' & Get_Gnatchop_File (File.Dep.Table (P_Eun)) - & ':' & Get_Line (Get_Parent (Decl_Ref)) - & ':' & Get_Column (Get_Parent (Decl_Ref)), - False); - - -- No default match is needed to look for the parent type - -- since we are using the fully qualified symbol name: - -- symbol:file:line:column - - Set_Default_Match (False); - - -- The parent type is defined in the same unit as the - -- derived type. So we want to revisit the unit. - - File_Pos_Backup := File.Current_Line; - - if File.Dep.Table (P_Eun) = File_Ref then - - -- set file pointer at the start of the xref lines - - File.Current_Line := File.Xref_Line; - - Revisit_ALI_File : declare - File_Existed : Boolean; - File_Ref : File_Reference; - begin - Add_File - (ALI_File_Name (Get_File (File.Dep.Table (P_Eun))), - File_Existed, - File_Ref, - Visited => False); - Set_Unvisited (File_Ref); - end Revisit_ALI_File; - end if; - - Search (Pattern, - Local_Symbols, False, False, Der_Info, Type_Tree); - - File.Current_Line := File_Pos_Backup; - - -- in this mode there is no need to parse the remaining of - -- the lines. - - return; - end Search_Parent_Tree; - end if; - end Parse_Derived_Info; - end if; - - -- To find the body, we will have to parse the file too - - if Wide_Search then - declare - File_Existed : Boolean; - File_Ref : File_Reference; - File_Name : constant String := - Get_Gnatchop_File (File.X_File); - - begin - Add_File (ALI_File_Name (File_Name), - File_Existed, File_Ref, False); - end; - end if; - - -- Parse references to this entity. - -- Ptr points to next reference with leading blanks - - loop - -- Process references on current line - - while Ali (Ptr) = ' ' or Ali (Ptr) = ASCII.HT loop - - -- For every reference read the line, type and column, - -- optionally preceded by a file number and a pipe symbol. - - Parse_Number (Ali, Ptr, R_Line); - - if Ali (Ptr) = Pipe then - Ptr := Ptr + 1; - File_Ref := File_Name (File, R_Line); - - Parse_Number (Ali, Ptr, R_Line); - end if; - - if Ali (Ptr) > ' ' then - R_Type := Ali (Ptr); - Ptr := Ptr + 1; - end if; - - Parse_Number (Ali, Ptr, R_Col); - - -- Insert the reference or body in the table - - Add_Reference (Decl_Ref, File_Ref, R_Line, R_Col, R_Type); - - end loop; - - Parse_EOL (Ali, Ptr); - - -- Loop until new line is no continuation line - - exit when Ali (Ptr) /= '.'; - Ptr := Ptr + 1; - end loop; - end Parse_Identifier_Info; - - ------------------ - -- Parse_Number -- - ------------------ - - procedure Parse_Number - (Source : access String; - Ptr : in out Positive; - Number : out Natural) - is - begin - -- Skip separators - - while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop - Ptr := Ptr + 1; - end loop; - - Number := 0; - while Source (Ptr) in '0' .. '9' loop - Number := 10 * Number - + (Character'Pos (Source (Ptr)) - Character'Pos ('0')); - Ptr := Ptr + 1; - end loop; - end Parse_Number; - - ----------------- - -- Parse_Token -- - ----------------- - - procedure Parse_Token - (Source : access String; - Ptr : in out Positive; - Token_Ptr : out Positive) - is - In_Quotes : Boolean := False; - - begin - -- Skip separators - - while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop - Ptr := Ptr + 1; - end loop; - - Token_Ptr := Ptr; - - -- Find end-of-token - - while (In_Quotes or else - not (Source (Ptr) = ' ' - or else Source (Ptr) = ASCII.HT - or else Source (Ptr) = '<')) - and then Source (Ptr) >= ' ' - loop - if Source (Ptr) = '"' then - In_Quotes := not In_Quotes; - end if; - - Ptr := Ptr + 1; - end loop; - end Parse_Token; - - ---------------------- - -- Parse_X_Filename -- - ---------------------- - - procedure Parse_X_Filename (File : in out ALI_File) is - Ali : String_Access renames File.Buffer; - Ptr : Positive renames File.Current_Line; - File_Nr : Natural; - - begin - while Ali (Ptr) = X loop - - -- The current line is the start of a new Xref file section, - -- whose format looks like: - - -- " X 1 debug.ads" - - -- Skip the X and read the file number for the new X_File - - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, File_Nr); - - if File_Nr > 0 then - File.X_File := File.Dep.Table (File_Nr); - end if; - - Parse_EOL (Ali, Ptr); - end loop; - - end Parse_X_Filename; - - -------------------- - -- Print_Gnatfind -- - -------------------- - - procedure Print_Gnatfind - (References : Boolean; - Full_Path_Name : Boolean) - is - Decl : Declaration_Reference := First_Declaration; - Ref1 : Reference; - Ref2 : Reference; - - procedure Print_Ref - (Ref : Reference; - Msg : String := " "); - -- Print a reference, according to the extended tag of the output - - --------------- - -- Print_Ref -- - --------------- - - procedure Print_Ref - (Ref : Reference; - Msg : String := " ") - is - Buffer : constant String := - Osint.To_Host_File_Spec - (Get_Gnatchop_File (Ref, Full_Path_Name)).all - & ":" & Get_Line (Ref) - & ":" & Get_Column (Ref) - & ": "; - Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; - - begin - Num_Blanks := Integer'Max (0, Num_Blanks); - Write_Line - (Buffer - & String'(1 .. Num_Blanks => ' ') - & Msg & " " & Get_Symbol (Decl)); - if Get_Source_Line (Ref)'Length /= 0 then - Write_Line (" " & Get_Source_Line (Ref)); - end if; - end Print_Ref; - - -- Start of processing for Print_Gnatfind - - begin - while Decl /= Empty_Declaration loop - if Match (Decl) then - - -- Output the declaration - - declare - Parent : constant Declaration_Reference := Get_Parent (Decl); - Buffer : constant String := - Osint.To_Host_File_Spec - (Get_Gnatchop_File (Decl, Full_Path_Name)).all - & ":" & Get_Line (Decl) - & ":" & Get_Column (Decl) - & ": "; - Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; - - begin - Num_Blanks := Integer'Max (0, Num_Blanks); - Write_Line - (Buffer & String'(1 .. Num_Blanks => ' ') - & "(spec) " & Get_Symbol (Decl)); - - if Parent /= Empty_Declaration then - Write_Line - (Buffer & String'(1 .. Num_Blanks => ' ') - & " derived from " & Get_Symbol (Parent) - & " (" - & Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)).all - & ':' & Get_Line (Parent) - & ':' & Get_Column (Parent) & ')'); - end if; - end; - - if Get_Source_Line (Decl)'Length /= 0 then - Write_Line (" " & Get_Source_Line (Decl)); - end if; - - -- Output the body (sorted) - - Ref1 := First_Body (Decl); - while Ref1 /= Empty_Reference loop - Print_Ref (Ref1, "(body)"); - Ref1 := Next (Ref1); - end loop; - - if References then - Ref1 := First_Modif (Decl); - Ref2 := First_Reference (Decl); - while Ref1 /= Empty_Reference - or else Ref2 /= Empty_Reference - loop - if Compare (Ref1, Ref2) = LessThan then - Print_Ref (Ref1); - Ref1 := Next (Ref1); - else - Print_Ref (Ref2); - Ref2 := Next (Ref2); - end if; - end loop; - end if; - end if; - - Decl := Next (Decl); - end loop; - end Print_Gnatfind; - - ------------------ - -- Print_Unused -- - ------------------ - - procedure Print_Unused (Full_Path_Name : in Boolean) is - Decl : Declaration_Reference := First_Declaration; - Ref : Reference; - - begin - while Decl /= Empty_Declaration loop - if First_Modif (Decl) = Empty_Reference - and then First_Reference (Decl) = Empty_Reference - then - Write_Str (Get_Symbol (Decl) - & " " - & Get_Type (Decl) - & " " - & Osint.To_Host_File_Spec - (Get_Gnatchop_File (Decl, Full_Path_Name)).all - & ':' - & Get_Line (Decl) - & ':' - & Get_Column (Decl)); - - -- Print the body if any - - Ref := First_Body (Decl); - - if Ref /= Empty_Reference then - Write_Line (' ' - & Osint.To_Host_File_Spec - (Get_Gnatchop_File (Ref, Full_Path_Name)).all - & ':' & Get_Line (Ref) - & ':' & Get_Column (Ref)); - else - Write_Eol; - end if; - end if; - - Decl := Next (Decl); - end loop; - end Print_Unused; - - -------------- - -- Print_Vi -- - -------------- - - procedure Print_Vi (Full_Path_Name : in Boolean) is - Tab : constant Character := ASCII.HT; - Decl : Declaration_Reference := First_Declaration; - Ref : Reference; - - begin - while Decl /= Empty_Declaration loop - Write_Line (Get_Symbol (Decl) & Tab - & Get_File (Decl, Full_Path_Name) & Tab - & Get_Line (Decl)); - - -- Print the body if any - - Ref := First_Body (Decl); - - if Ref /= Empty_Reference then - Write_Line (Get_Symbol (Decl) & Tab - & Get_File (Ref, Full_Path_Name) - & Tab - & Get_Line (Ref)); - end if; - - -- Print the modifications - - Ref := First_Modif (Decl); - - while Ref /= Empty_Reference loop - Write_Line (Get_Symbol (Decl) & Tab - & Get_File (Ref, Full_Path_Name) - & Tab - & Get_Line (Ref)); - Ref := Next (Ref); - end loop; - - Decl := Next (Decl); - end loop; - end Print_Vi; - - ---------------- - -- Print_Xref -- - ---------------- - - procedure Print_Xref (Full_Path_Name : in Boolean) is - Decl : Declaration_Reference := First_Declaration; - Ref : Reference; - File : File_Reference; - - Margin : constant := 10; - -- Column where file names start - - procedure New_Line80; - -- Go to start of new line - - procedure Print80 (S : in String); - -- Print the text, respecting the 80 columns rule. - - procedure Print_Ref (Line, Column : String); - -- The beginning of the output is aligned on a column multiple of 9 - - ---------------- - -- New_Line80 -- - ---------------- - - procedure New_Line80 is - begin - Write_Eol; - Write_Str (String'(1 .. Margin - 1 => ' ')); - end New_Line80; - - ------------- - -- Print80 -- - ------------- - - procedure Print80 (S : in String) is - Align : Natural := Margin - (Integer (Column) mod Margin); - begin - if Align = Margin then - Align := 0; - end if; - - Write_Str (String'(1 .. Align => ' ') & S); - end Print80; - - --------------- - -- Print_Ref -- - --------------- - - procedure Print_Ref (Line, Column : String) is - Line_Align : constant Integer := 4 - Line'Length; - - S : constant String := String'(1 .. Line_Align => ' ') - & Line & ':' & Column; - - Align : Natural := Margin - (Integer (Output.Column) mod Margin); - - begin - if Align = Margin then - Align := 0; - end if; - - if Integer (Output.Column) + Align + S'Length > 79 then - New_Line80; - Align := 0; - end if; - - Write_Str (String'(1 .. Align => ' ') & S); - end Print_Ref; - - -- Start of processing for Print_Xref - - begin - while Decl /= Empty_Declaration loop - Write_Str (Get_Symbol (Decl)); - - while Column < Type_Position loop - Write_Char (' '); - end loop; - - Write_Line (Get_Full_Type (Get_Type (Decl))); - - Write_Parent_Info : declare - Parent : constant Declaration_Reference := Get_Parent (Decl); - begin - if Parent /= Empty_Declaration then - Write_Str (" Ptype: "); - Print80 - (Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)).all); - Print_Ref (Get_Line (Parent), Get_Column (Parent)); - Print80 (" " & Get_Symbol (Parent)); - Write_Eol; - end if; - end Write_Parent_Info; - - Write_Str (" Decl: "); - Print80 - (Osint.To_Host_File_Spec - (Get_Gnatchop_File (Decl, Full_Path_Name)).all & ' '); - Print_Ref (Get_Line (Decl), Get_Column (Decl)); - - -- Print the body if any - - Ref := First_Body (Decl); - - if Ref /= Empty_Reference then - Write_Eol; - Write_Str (" Body: "); - Print80 - (Osint.To_Host_File_Spec - (Get_Gnatchop_File (Ref, Full_Path_Name)).all & ' '); - Print_Ref (Get_Line (Ref), Get_Column (Ref)); - end if; - - -- Print the modifications if any - - Ref := First_Modif (Decl); - - if Ref /= Empty_Reference then - Write_Eol; - Write_Str (" Modi: "); - end if; - - File := Empty_File; - - while Ref /= Empty_Reference loop - if Get_File_Ref (Ref) /= File then - if File /= Empty_File then - New_Line80; - end if; - - File := Get_File_Ref (Ref); - Write_Str - (Get_Gnatchop_File (Ref, Full_Path_Name) & ' '); - Print_Ref (Get_Line (Ref), Get_Column (Ref)); - - else - Print_Ref (Get_Line (Ref), Get_Column (Ref)); - end if; - - Ref := Next (Ref); - end loop; - - -- Print the references - - Ref := First_Reference (Decl); - - if Ref /= Empty_Reference then - Write_Eol; - Write_Str (" Ref: "); - end if; - - File := Empty_File; - - while Ref /= Empty_Reference loop - if Get_File_Ref (Ref) /= File then - if File /= Empty_File then - New_Line80; - end if; - - File := Get_File_Ref (Ref); - Write_Str - (Osint.To_Host_File_Spec - (Get_Gnatchop_File (Ref, Full_Path_Name)).all & ' '); - Print_Ref (Get_Line (Ref), Get_Column (Ref)); - - else - Print_Ref (Get_Line (Ref), Get_Column (Ref)); - end if; - - Ref := Next (Ref); - end loop; - - Write_Eol; - Decl := Next (Decl); - end loop; - end Print_Xref; - - --------------- - -- Read_File -- - --------------- - - procedure Read_File - (FD : File_Descriptor; - Contents : out String_Access; - Success : out Boolean) - is - Length : constant File_Offset := File_Offset (File_Length (FD)); - -- Include room for EOF char - - Buffer : String (1 .. Length + 1); - - This_Read : Integer; - Read_Ptr : File_Offset := 1; - - begin - - loop - This_Read := Read (FD, - A => Buffer (Read_Ptr)'Address, - N => Length + 1 - Read_Ptr); - Read_Ptr := Read_Ptr + Integer'Max (This_Read, 0); - exit when This_Read <= 0; - end loop; - - Buffer (Read_Ptr) := EOF; - Contents := new String'(Buffer (1 .. Read_Ptr)); - - -- Things aren't simple on VMS due to the plethora of file types - -- and organizations. It seems clear that there shouldn't be more - -- bytes read than are contained in the file though. - - if Hostparm.OpenVMS then - Success := Read_Ptr <= Length + 1; - else - Success := Read_Ptr = Length + 1; - end if; - end Read_File; - - ------------ - -- Search -- - ------------ - - procedure Search - (Pattern : Search_Pattern; - Local_Symbols : Boolean; - Wide_Search : Boolean; - Read_Only : Boolean; - Der_Info : Boolean; - Type_Tree : Boolean) - is - type String_Access is access String; - procedure Free is new Unchecked_Deallocation (String, String_Access); - - ALIfile : ALI_File; - File_Ref : File_Reference; - Strip_Num : Natural := 0; - Ali_Name : String_Access; - - begin - -- If we want all the .ali files, then find them - - if Wide_Search then - Find_ALI_Files; - end if; - - loop - -- Get the next unread ali file - - File_Ref := Next_Unvisited_File; - - exit when File_Ref = Empty_File; - - -- Find the ALI file to use. Most of the time, it will be the unit - -- name, with a different extension. However, when dealing with - -- separates the ALI file is in fact the parent's ALI file (and this - -- is recursive, in case the parent itself is a separate). - - Strip_Num := 0; - loop - Free (Ali_Name); - Ali_Name := new String' - (Get_File (File_Ref, With_Dir => True, Strip => Strip_Num)); - - -- Striped too many things... - if Ali_Name.all = "" then - if Get_Emit_Warning (File_Ref) then - Set_Standard_Error; - Write_Line - ("warning : file " & Get_File (File_Ref, With_Dir => True) - & " not found"); - Set_Standard_Output; - end if; - Free (Ali_Name); - exit; - - -- If not found, try the parent's ALI file (this is needed for - -- separate units and subprograms). - elsif not File_Exists (Ali_Name.all) then - Strip_Num := Strip_Num + 1; - - -- Else we finally found it - else - exit; - end if; - end loop; - - -- Now that we have a file name, parse it to find any reference to - -- the entity. - - if Ali_Name /= null - and then (Read_Only or else Is_Writable_File (Ali_Name.all)) - then - begin - Open (Ali_Name.all, ALIfile); - while ALIfile.Buffer (ALIfile.Current_Line) /= EOF loop - Parse_X_Filename (ALIfile); - Parse_Identifier_Info (Pattern, ALIfile, Local_Symbols, - Der_Info, Type_Tree, Wide_Search); - end loop; - - exception - when No_Xref_Information => - if Get_Emit_Warning (File_Ref) then - Set_Standard_Error; - Write_Line - ("warning : No cross-referencing information in " - & Ali_Name.all); - Set_Standard_Output; - end if; - end; - end if; - end loop; - - Free (Ali_Name); - end Search; - - ----------------- - -- Search_Xref -- - ----------------- - - procedure Search_Xref - (Local_Symbols : Boolean; - Read_Only : Boolean; - Der_Info : Boolean) - is - ALIfile : ALI_File; - File_Ref : File_Reference; - Null_Pattern : Search_Pattern; - begin - loop - -- Find the next unvisited file - - File_Ref := Next_Unvisited_File; - exit when File_Ref = Empty_File; - - -- Search the object directories for the .ali file - - if Read_Only - or else Is_Writable_File (Get_File (File_Ref, With_Dir => True)) - then - begin - Open (Get_File (File_Ref, With_Dir => True), ALIfile, True); - - while ALIfile.Buffer (ALIfile.Current_Line) /= EOF loop - Parse_X_Filename (ALIfile); - Parse_Identifier_Info - (Null_Pattern, ALIfile, Local_Symbols, Der_Info); - end loop; - - exception - when No_Xref_Information => null; - end; - end if; - end loop; - end Search_Xref; - -end Xref_Lib;