-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2007, 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- --
+-- 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. 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. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
with Rtsfind; use Rtsfind;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
+with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo;
with Stringt; use Stringt;
with Tbuild; use Tbuild;
begin
if No (Operand_Var) then
return Empty;
+ elsif Error_Posted (Operand_Var) then
+ return Error;
else
return Next (First (Expressions (Operand_Var)));
end if;
-- are never static).
if Is_OK_Static_Expression (Temp)
- or else (Ada_83 and then Nkind (Temp) = N_String_Literal)
+ or else (Ada_Version = 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);
+ Flag_Non_Static_Expr ("asm template argument is not static!", Temp);
return Empty;
end if;
end Asm_Template;
Name_Buffer (Name_Len + 1) := ASCII.NUL;
return Name_Buffer'Address;
-
end Clobber_Get_Next;
-------------------
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);
+ Flag_Non_Static_Expr ("asm clobber argument is not static!", Clob);
Clobber_Node := Empty;
-
else
Clobber_Node := Get_String_Node (Clob);
Clobber_Ptr := 1;
procedure Check_IO_Operand (N : Node_Id);
-- Check for incorrect input or output operand
+ ----------------------
+ -- Check_IO_Operand --
+ ----------------------
+
procedure Check_IO_Operand (N : Node_Id) is
Err : Node_Id := N;
begin
- -- The only identifier allows is No_xxput_Operands. Since we
+ -- The only identifier allowed 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.
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);
-- 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.
+ -- procedural interface defined in this package. Furthermore if we
+ -- let it go through the normal analysis, that would include some
+ -- inappropriate checks that apply only to explicit code statements
+ -- in the source, and not to calls to intrinsics.
Set_Analyzed (N);
+ Check_Code_Statement (N);
end if;
end Expand_Asm_Call;
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)));
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);
+ Flag_Non_Static_Expr ("asm volatile argument is not static!", Vol);
return False;
-
else
return Is_True (Expr_Value (Vol));
end if;
if Nkind (Parent (Operand_Var)) = N_Aggregate then
Operand_Var := Next (Operand_Var);
-
else
Operand_Var := Empty;
end if;
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))),
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)),
OSDN Git Service
