X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=gcc%2Fada%2Fexp_code.adb;fp=gcc%2Fada%2Fexp_code.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=87ed0db572fe84f287202ec70ffaf1df2db45222;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/exp_code.adb b/gcc/ada/exp_code.adb deleted file mode 100644 index 87ed0db5..00000000 --- a/gcc/ada/exp_code.adb +++ /dev/null @@ -1,499 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- E X P _ C O D E -- --- -- --- B o d y -- --- -- --- $Revision: 1.1.16.1 $ --- -- --- Copyright (C) 1996-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. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Atree; use Atree; -with Einfo; use Einfo; -with Errout; use Errout; -with Fname; use Fname; -with Lib; use Lib; -with Namet; use Namet; -with Nlists; use Nlists; -with Nmake; use Nmake; -with Opt; use Opt; -with Rtsfind; use Rtsfind; -with Sem_Eval; use Sem_Eval; -with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; -with Stringt; use Stringt; -with Tbuild; use Tbuild; - -package body Exp_Code is - - ----------------------- - -- Local_Subprograms -- - ----------------------- - - function Asm_Constraint (Operand_Var : Node_Id) return Node_Id; - -- Common processing for Asm_Input_Constraint and Asm_Output_Constraint. - -- Obtains the constraint argument from the global operand variable - -- Operand_Var, which must be non-Empty. - - function Asm_Operand (Operand_Var : Node_Id) return Node_Id; - -- Common processing for Asm_Input_Value and Asm_Output_Variable. Obtains - -- the value/variable argument from Operand_Var, the global operand - -- variable. Returns Empty if no operand available. - - function Get_String_Node (S : Node_Id) return Node_Id; - -- Given S, a static expression node of type String, returns the - -- string literal node. This is needed to deal with the use of constants - -- for these expressions, which is perfectly permissible. - - procedure Next_Asm_Operand (Operand_Var : in out Node_Id); - -- Common processing for Next_Asm_Input and Next_Asm_Output, updates - -- the value of the global operand variable Operand_Var appropriately. - - procedure Setup_Asm_IO_Args (Arg : Node_Id; Operand_Var : out Node_Id); - -- Common processing for Setup_Asm_Inputs and Setup_Asm_Outputs. Arg - -- is the actual parameter from the call, and Operand_Var is the global - -- operand variable to be initialized to the first operand. - - ---------------------- - -- Global Variables -- - ---------------------- - - Current_Input_Operand : Node_Id := Empty; - -- Points to current Asm_Input_Operand attribute reference. Initialized - -- by Setup_Asm_Inputs, updated by Next_Asm_Input, and referenced by - -- Asm_Input_Constraint and Asm_Input_Value. - - Current_Output_Operand : Node_Id := Empty; - -- Points to current Asm_Output_Operand attribute reference. Initialized - -- by Setup_Asm_Outputs, updated by Next_Asm_Output, and referenced by - -- Asm_Output_Constraint and Asm_Output_Variable. - - -------------------- - -- Asm_Constraint -- - -------------------- - - function Asm_Constraint (Operand_Var : Node_Id) return Node_Id is - begin - pragma Assert (Present (Operand_Var)); - return Get_String_Node (First (Expressions (Operand_Var))); - end Asm_Constraint; - - -------------------------- - -- Asm_Input_Constraint -- - -------------------------- - - -- Note: error checking on Asm_Input attribute done in Sem_Attr - - function Asm_Input_Constraint return Node_Id is - begin - return Get_String_Node (Asm_Constraint (Current_Input_Operand)); - end Asm_Input_Constraint; - - --------------------- - -- Asm_Input_Value -- - --------------------- - - -- Note: error checking on Asm_Input attribute done in Sem_Attr - - function Asm_Input_Value return Node_Id is - begin - return Asm_Operand (Current_Input_Operand); - end Asm_Input_Value; - - ----------------- - -- Asm_Operand -- - ----------------- - - function Asm_Operand (Operand_Var : Node_Id) return Node_Id is - begin - if No (Operand_Var) then - return Empty; - else - return Next (First (Expressions (Operand_Var))); - end if; - end Asm_Operand; - - --------------------------- - -- Asm_Output_Constraint -- - --------------------------- - - -- Note: error checking on Asm_Output attribute done in Sem_Attr - - function Asm_Output_Constraint return Node_Id is - begin - return Asm_Constraint (Current_Output_Operand); - end Asm_Output_Constraint; - - ------------------------- - -- Asm_Output_Variable -- - ------------------------- - - -- Note: error checking on Asm_Output attribute done in Sem_Attr - - function Asm_Output_Variable return Node_Id is - begin - return Asm_Operand (Current_Output_Operand); - end Asm_Output_Variable; - - ------------------ - -- Asm_Template -- - ------------------ - - function Asm_Template (N : Node_Id) return Node_Id is - Call : constant Node_Id := Expression (Expression (N)); - Temp : constant Node_Id := First_Actual (Call); - - begin - -- Require static expression for template. We also allow a string - -- literal (this is useful for Ada 83 mode where string expressions - -- are never static). - - if Is_OK_Static_Expression (Temp) - or else (Ada_83 and then Nkind (Temp) = N_String_Literal) - then - return Get_String_Node (Temp); - - else - Error_Msg_N ("asm template argument is not static", Temp); - return Empty; - end if; - end Asm_Template; - - ---------------------- - -- Clobber_Get_Next -- - ---------------------- - - Clobber_Node : Node_Id; - -- String literal node for clobber string. Initialized by Clobber_Setup, - -- and not modified by Clobber_Get_Next. Empty if clobber string was in - -- error (resulting in no clobber arguments being returned). - - Clobber_Ptr : Nat; - -- Pointer to current character of string. Initialized to 1 by the call - -- to Clobber_Setup, and then updated by Clobber_Get_Next. - - function Clobber_Get_Next return Address is - Str : constant String_Id := Strval (Clobber_Node); - Len : constant Nat := String_Length (Str); - C : Character; - - begin - if No (Clobber_Node) then - return Null_Address; - end if; - - -- Skip spaces and commas before next register name - - loop - -- Return null string if no more names - - if Clobber_Ptr > Len then - return Null_Address; - end if; - - C := Get_Character (Get_String_Char (Str, Clobber_Ptr)); - exit when C /= ',' and then C /= ' '; - Clobber_Ptr := Clobber_Ptr + 1; - end loop; - - -- Acquire next register name - - Name_Len := 0; - loop - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := C; - Clobber_Ptr := Clobber_Ptr + 1; - exit when Clobber_Ptr > Len; - C := Get_Character (Get_String_Char (Str, Clobber_Ptr)); - exit when C = ',' or else C = ' '; - end loop; - - Name_Buffer (Name_Len + 1) := ASCII.NUL; - return Name_Buffer'Address; - - end Clobber_Get_Next; - - ------------------- - -- Clobber_Setup -- - ------------------- - - procedure Clobber_Setup (N : Node_Id) is - Call : constant Node_Id := Expression (Expression (N)); - Clob : constant Node_Id := Next_Actual ( - Next_Actual ( - Next_Actual ( - First_Actual (Call)))); - - begin - if not Is_OK_Static_Expression (Clob) then - Error_Msg_N ("asm clobber argument is not static", Clob); - Clobber_Node := Empty; - - else - Clobber_Node := Get_String_Node (Clob); - Clobber_Ptr := 1; - end if; - end Clobber_Setup; - - --------------------- - -- Expand_Asm_Call -- - --------------------- - - procedure Expand_Asm_Call (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - - procedure Check_IO_Operand (N : Node_Id); - -- Check for incorrect input or output operand - - procedure Check_IO_Operand (N : Node_Id) is - Err : Node_Id := N; - - begin - -- The only identifier allows is No_xxput_Operands. Since we - -- know the type is right, it is sufficient to see if the - -- referenced entity is in a runtime routine. - - if Nkind (N) = N_Identifier - and then - Is_Predefined_File_Name (Unit_File_Name - (Get_Source_Unit (Entity (N)))) - then - return; - - -- An attribute reference is fine, again the analysis reasonably - -- guarantees that the attribute must be subtype'Asm_??put. - - elsif Nkind (N) = N_Attribute_Reference then - return; - - -- The only other allowed form is an array aggregate in which - -- all the entries are positional and are attribute references. - - elsif Nkind (N) = N_Aggregate then - if Present (Component_Associations (N)) then - Err := First (Component_Associations (N)); - - elsif Present (Expressions (N)) then - Err := First (Expressions (N)); - while Present (Err) loop - exit when Nkind (Err) /= N_Attribute_Reference; - Next (Err); - end loop; - - if No (Err) then - return; - end if; - end if; - end if; - - -- If we fall through, Err is pointing to the bad node - - Error_Msg_N ("Asm operand has wrong form", Err); - end Check_IO_Operand; - - -- Start of processing for Expand_Asm_Call - - begin - -- Check that the input and output operands have the right - -- form, as required by the documentation of the Asm feature: - - -- OUTPUT_OPERAND_LIST ::= - -- No_Output_Operands - -- | OUTPUT_OPERAND_ATTRIBUTE - -- | (OUTPUT_OPERAND_ATTRIBUTE @{,OUTPUT_OPERAND_ATTRIBUTE@}) - - -- OUTPUT_OPERAND_ATTRIBUTE ::= - -- SUBTYPE_MARK'Asm_Output (static_string_EXPRESSION, NAME) - - -- INPUT_OPERAND_LIST ::= - -- No_Input_Operands - -- | INPUT_OPERAND_ATTRIBUTE - -- | (INPUT_OPERAND_ATTRIBUTE @{,INPUT_OPERAND_ATTRIBUTE@}) - - -- INPUT_OPERAND_ATTRIBUTE ::= - -- SUBTYPE_MARK'Asm_Input (static_string_EXPRESSION, EXPRESSION) - - declare - Arg_Output : constant Node_Id := Next_Actual (First_Actual (N)); - Arg_Input : constant Node_Id := Next_Actual (Arg_Output); - - begin - Check_IO_Operand (Arg_Output); - Check_IO_Operand (Arg_Input); - end; - - -- If we have the function call case, we are inside a code statement, - -- and the tree is already in the necessary form for gigi. - - if Nkind (N) = N_Function_Call then - null; - - -- For the procedure case, we convert the call into a code statement - - else - pragma Assert (Nkind (N) = N_Procedure_Call_Statement); - - -- Note: strictly we should change the procedure call to a function - -- call in the qualified expression, but since we are not going to - -- reanalyze (see below), and the interface subprograms in this - -- package don't care, we can leave it as a procedure call. - - Rewrite (N, - Make_Code_Statement (Loc, - Expression => - Make_Qualified_Expression (Loc, - Subtype_Mark => New_Occurrence_Of (RTE (RE_Asm_Insn), Loc), - Expression => Relocate_Node (N)))); - - -- There is no need to reanalyze this node, it is completely analyzed - -- already, at least sufficiently for the purposes of the abstract - -- procedural interface defined in this package. - - Set_Analyzed (N); - end if; - end Expand_Asm_Call; - - --------------------- - -- Get_String_Node -- - --------------------- - - function Get_String_Node (S : Node_Id) return Node_Id is - begin - if Nkind (S) = N_String_Literal then - return S; - - else - pragma Assert (Ekind (Entity (S)) = E_Constant); - return Get_String_Node (Constant_Value (Entity (S))); - end if; - end Get_String_Node; - - --------------------- - -- Is_Asm_Volatile -- - --------------------- - - function Is_Asm_Volatile (N : Node_Id) return Boolean is - Call : constant Node_Id := Expression (Expression (N)); - Vol : constant Node_Id := - Next_Actual ( - Next_Actual ( - Next_Actual ( - Next_Actual ( - First_Actual (Call))))); - - begin - if not Is_OK_Static_Expression (Vol) then - Error_Msg_N ("asm volatile argument is not static", Vol); - return False; - - else - return Is_True (Expr_Value (Vol)); - end if; - end Is_Asm_Volatile; - - -------------------- - -- Next_Asm_Input -- - -------------------- - - procedure Next_Asm_Input is - begin - Next_Asm_Operand (Current_Input_Operand); - end Next_Asm_Input; - - ---------------------- - -- Next_Asm_Operand -- - ---------------------- - - procedure Next_Asm_Operand (Operand_Var : in out Node_Id) is - begin - pragma Assert (Present (Operand_Var)); - - if Nkind (Parent (Operand_Var)) = N_Aggregate then - Operand_Var := Next (Operand_Var); - - else - Operand_Var := Empty; - end if; - end Next_Asm_Operand; - - --------------------- - -- Next_Asm_Output -- - --------------------- - - procedure Next_Asm_Output is - begin - Next_Asm_Operand (Current_Output_Operand); - end Next_Asm_Output; - - ---------------------- - -- Setup_Asm_Inputs -- - ---------------------- - - procedure Setup_Asm_Inputs (N : Node_Id) is - Call : constant Node_Id := Expression (Expression (N)); - - begin - Setup_Asm_IO_Args - (Next_Actual (Next_Actual (First_Actual (Call))), - Current_Input_Operand); - end Setup_Asm_Inputs; - - ----------------------- - -- Setup_Asm_IO_Args -- - ----------------------- - - procedure Setup_Asm_IO_Args (Arg : Node_Id; Operand_Var : out Node_Id) is - begin - -- Case of single argument - - if Nkind (Arg) = N_Attribute_Reference then - Operand_Var := Arg; - - -- Case of list of arguments - - elsif Nkind (Arg) = N_Aggregate then - if Expressions (Arg) = No_List then - Operand_Var := Empty; - else - Operand_Var := First (Expressions (Arg)); - end if; - - -- Otherwise must be default (no operands) case - - else - Operand_Var := Empty; - end if; - end Setup_Asm_IO_Args; - - ----------------------- - -- Setup_Asm_Outputs -- - ----------------------- - - procedure Setup_Asm_Outputs (N : Node_Id) is - Call : constant Node_Id := Expression (Expression (N)); - - begin - Setup_Asm_IO_Args - (Next_Actual (First_Actual (Call)), - Current_Output_Operand); - end Setup_Asm_Outputs; - -end Exp_Code;