Nodes.Table (New_Id).Rewrite_Ins := False;
pragma Debug (New_Node_Debugging_Output (New_Id));
- -- Clear Has_Dynamic_Range_Check since it doesn't apply anymore
-
- if Nkind (Source) in N_Subexpr then
- Set_Has_Dynamic_Range_Check (New_Id, False);
- end if;
-
-- Clear Is_Overloaded since we cannot have semantic interpretations
-- of this new node.
(Checks : Check_Result;
Stmts : List_Id;
Suppress_Typ : Entity_Id;
- Static_Sloc : Source_Ptr;
- Flag_Node : Node_Id)
+ Static_Sloc : Source_Ptr)
is
Checks_On : constant Boolean :=
not Index_Checks_Suppressed (Suppress_Typ)
or else
not Range_Checks_Suppressed (Suppress_Typ);
- Internal_Flag_Node : constant Node_Id := Flag_Node;
- Internal_Static_Sloc : constant Source_Ptr := Static_Sloc;
-
begin
-- For now we just return if Checks_On is false, however this should be
-- enhanced to check for an always True value in the condition and to
if Nkind (Checks (J)) = N_Raise_Constraint_Error
and then Present (Condition (Checks (J)))
then
- if Has_Dynamic_Range_Check (Internal_Flag_Node) then
- pragma Assert (False);
- null;
-
- else
- Append_To (Stmts, Checks (J));
- Set_Has_Dynamic_Range_Check (Internal_Flag_Node);
- end if;
-
+ Append_To (Stmts, Checks (J));
else
Append_To
(Stmts,
- Make_Raise_Constraint_Error (Internal_Static_Sloc,
+ Make_Raise_Constraint_Error (Static_Sloc,
Reason => CE_Range_Check_Failed));
end if;
end loop;
Insert_Action (Expr, R_Cno);
- -- This old code doesn't make sense, why is the context flagged as
- -- requiring dynamic range checks now in the middle of generating
- -- them ???
-
- if not Do_Static then
- Set_Has_Dynamic_Range_Check (Expr);
- end if;
-
-- The triggering condition evaluates to True, the range check
-- can be converted into a compile time constraint check.
(Checks : Check_Result;
Node : Node_Id;
Suppress_Typ : Entity_Id;
- Static_Sloc : Source_Ptr := No_Location;
- Flag_Node : Node_Id := Empty;
+ Static_Sloc : Source_Ptr;
Do_Before : Boolean := False)
is
Checks_On : constant Boolean :=
or else
not Range_Checks_Suppressed (Suppress_Typ);
- Check_Node : Node_Id;
- Internal_Flag_Node : Node_Id := Flag_Node;
- Internal_Static_Sloc : Source_Ptr := Static_Sloc;
+ Check_Node : Node_Id;
begin
-- For now we just return if Checks_On is false, however this should be
return;
end if;
- if Static_Sloc = No_Location then
- Internal_Static_Sloc := Sloc (Node);
- end if;
-
- if No (Flag_Node) then
- Internal_Flag_Node := Node;
- end if;
-
for J in 1 .. 2 loop
exit when No (Checks (J));
if Nkind (Checks (J)) = N_Raise_Constraint_Error
and then Present (Condition (Checks (J)))
then
- if Has_Dynamic_Range_Check (Internal_Flag_Node) then
- pragma Assert (False);
- null;
-
- else
- Check_Node := Checks (J);
- Mark_Rewrite_Insertion (Check_Node);
-
- if Do_Before then
- Insert_Before_And_Analyze (Node, Check_Node);
- else
- Insert_After_And_Analyze (Node, Check_Node);
- end if;
-
- Set_Has_Dynamic_Range_Check (Internal_Flag_Node);
- end if;
-
+ Check_Node := Checks (J);
else
Check_Node :=
- Make_Raise_Constraint_Error (Internal_Static_Sloc,
+ Make_Raise_Constraint_Error (Static_Sloc,
Reason => CE_Range_Check_Failed);
- Mark_Rewrite_Insertion (Check_Node);
+ end if;
- if Do_Before then
- Insert_Before_And_Analyze (Node, Check_Node);
- else
- Insert_After_And_Analyze (Node, Check_Node);
- end if;
+ Mark_Rewrite_Insertion (Check_Node);
+
+ if Do_Before then
+ Insert_Before_And_Analyze (Node, Check_Node);
+ else
+ Insert_After_And_Analyze (Node, Check_Node);
end if;
end loop;
end Insert_Range_Checks;
(Checks : Check_Result;
Stmts : List_Id;
Suppress_Typ : Entity_Id;
- Static_Sloc : Source_Ptr;
- Flag_Node : Node_Id);
+ Static_Sloc : Source_Ptr);
-- Called to append range checks as returned by a call to Get_Range_Checks.
-- Stmts is a list to which either the dynamic check is appended or the
-- raise Constraint_Error statement is appended (for static checks).
- -- Static_Sloc is the Sloc at which the raise CE node points, Flag_Node is
- -- used as the node at which to set the Has_Dynamic_Check flag. Checks_On
- -- is a boolean value that says if range and index checking is on or not.
+ -- Suppress_Typ is the type to check to determine if checks are suppressed.
+ -- Static_Sloc is the Sloc at which the raise CE node points.
procedure Insert_Range_Checks
(Checks : Check_Result;
Node : Node_Id;
Suppress_Typ : Entity_Id;
- Static_Sloc : Source_Ptr := No_Location;
- Flag_Node : Node_Id := Empty;
- Do_Before : Boolean := False);
+ Static_Sloc : Source_Ptr;
+ Do_Before : Boolean := False);
-- Called to insert range checks as returned by a call to Get_Range_Checks.
-- Node is the node after which either the dynamic check is inserted or
-- the raise Constraint_Error statement is inserted (for static checks).
-- Suppress_Typ is the type to check to determine if checks are suppressed.
- -- Static_Sloc, if passed, is the Sloc at which the raise CE node points,
- -- otherwise Sloc (Node) is used. The Has_Dynamic_Check flag is normally
- -- set at Node. If Flag_Node is present, then this is used instead as the
- -- node at which to set the Has_Dynamic_Check flag. Normally the check is
- -- inserted after, if Do_Before is True, the check is inserted before
- -- Node.
+ -- Static_Sloc is the Sloc at which the raise CE node points. Normally the
+ -- checks are inserted after Node; if Do_Before is True, they are before.
-----------------------
-- Expander Routines --
Flags : TV.Table (20);
-- Maps flag numbers to letters
- N_Fields : constant Pattern := BreakX ("JL");
- E_Fields : constant Pattern := BreakX ("5EFGHIJLOP");
- U_Fields : constant Pattern := BreakX ("1345EFGHIJKLOPQ");
- B_Fields : constant Pattern := BreakX ("12345EFGHIJKLOPQ");
+ N_Fields : constant Pattern := BreakX ("J");
+ E_Fields : constant Pattern := BreakX ("5EFGHIJOP");
+ U_Fields : constant Pattern := BreakX ("1345EFGHIJKOPQ");
+ B_Fields : constant Pattern := BreakX ("12345EFGHIJKOPQ");
Line : VString;
Bad : Boolean;
Set (Special, "First_Itype", True);
Set (Special, "Has_Aspect_Specifications", True);
Set (Special, "Has_Dynamic_Itype", True);
- Set (Special, "Has_Dynamic_Range_Check", True);
Set (Special, "Has_Dynamic_Length_Check", True);
Set (Special, "Has_Private_View", True);
Set (Special, "Is_Controlling_Actual", True);
(C_Es,
N,
Target_Typ,
- Sloc (Lhs),
- Lhs);
+ Sloc (Lhs));
end;
end if;
end if;
Target_Index : Node_Id :=
First_Index (Etype
(Subtype_Mark (Subtype_Indication (N))));
- Has_Dyn_Chk : Boolean := Has_Dynamic_Range_Check (N);
begin
while Present (Subt_Index) loop
Etype (Subt_Index),
Defining_Identifier (N));
- -- Reset Has_Dynamic_Range_Check on the subtype to
- -- prevent elision of the index check due to a dynamic
- -- check generated for a preceding index (needed since
- -- Insert_Range_Checks tries to avoid generating
- -- redundant checks on a given declaration).
-
- Set_Has_Dynamic_Range_Check (N, False);
-
Insert_Range_Checks
(R_Checks,
N,
Target_Typ,
Sloc (Defining_Identifier (N)));
-
- -- Record whether this index involved a dynamic check
-
- Has_Dyn_Chk :=
- Has_Dyn_Chk or else Has_Dynamic_Range_Check (N);
end;
end if;
Next_Index (Subt_Index);
Next_Index (Target_Index);
end loop;
-
- -- Finally, mark whether the subtype involves dynamic checks
-
- Set_Has_Dynamic_Range_Check (N, Has_Dyn_Chk);
end;
end if;
end if;
Insert_Node,
Def_Id,
Sloc (Insert_Node),
- R,
Do_Before => True);
end if;
end;
if Present (Check_List) then
Append_Range_Checks
(R_Checks,
- Check_List, Def_Id, Sloc (Insert_Node), R);
+ Check_List, Def_Id, Sloc (Insert_Node));
end if;
else
if No (Check_List) then
Insert_Range_Checks
(R_Checks,
- Insert_Node, Def_Id, Sloc (Insert_Node), R);
+ Insert_Node, Def_Id, Sloc (Insert_Node));
end if;
end if;
return Flag10 (N);
end Has_Dynamic_Length_Check;
- function Has_Dynamic_Range_Check
- (N : Node_Id) return Boolean is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Subtype_Declaration
- or else NT (N).Nkind in N_Subexpr);
- return Flag12 (N);
- end Has_Dynamic_Range_Check;
-
function Has_Init_Expression
(N : Node_Id) return Boolean is
begin
Set_Flag10 (N, Val);
end Set_Has_Dynamic_Length_Check;
- procedure Set_Has_Dynamic_Range_Check
- (N : Node_Id; Val : Boolean := True) is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Subtype_Declaration
- or else NT (N).Nkind in N_Subexpr);
- Set_Flag12 (N, Val);
- end Set_Has_Dynamic_Range_Check;
-
procedure Set_Has_Init_Expression
(N : Node_Id; Val : Boolean := True) is
begin
-- Must_Not_Freeze (Flag8-Sem) set if must not freeze
-- Do_Range_Check (Flag9-Sem) set if a range check needed
-- Has_Dynamic_Length_Check (Flag10-Sem) set if length check inserted
- -- Has_Dynamic_Range_Check (Flag12-Sem) set if range check inserted
-- Assignment_OK (Flag15-Sem) set if modification is OK
-- Is_Controlling_Actual (Flag16-Sem) set for controlling argument
-- action which has been inserted at the flagged node. This is used to
-- avoid the generation of duplicate checks.
- -- Has_Dynamic_Range_Check (Flag12-Sem)
- -- This flag is present in N_Subtype_Declaration nodes and on all
- -- expression nodes. It is set to indicate that one of the routines in
- -- unit Checks has generated a range check action which has been inserted
- -- at the flagged node. This is used to avoid the generation of duplicate
- -- checks. Why does this occur on N_Subtype_Declaration nodes, what does
- -- it mean in that context???
-
-- Has_Local_Raise (Flag8-Sem)
-- Present in exception handler nodes. Set if the handler can be entered
-- via a local raise that gets transformed to a goto statement. This will
-- Subtype_Indication (Node5)
-- Generic_Parent_Type (Node4-Sem) (set for an actual derived type).
-- Exception_Junk (Flag8-Sem)
- -- Has_Dynamic_Range_Check (Flag12-Sem)
-------------------------------
-- 3.2.2 Subtype Indication --
function Has_Dynamic_Length_Check
(N : Node_Id) return Boolean; -- Flag10
- function Has_Dynamic_Range_Check
- (N : Node_Id) return Boolean; -- Flag12
-
function Has_Init_Expression
(N : Node_Id) return Boolean; -- Flag14
procedure Set_Has_Dynamic_Length_Check
(N : Node_Id; Val : Boolean := True); -- Flag10
- procedure Set_Has_Dynamic_Range_Check
- (N : Node_Id; Val : Boolean := True); -- Flag12
-
procedure Set_Has_Init_Expression
(N : Node_Id; Val : Boolean := True); -- Flag14
pragma Inline (Has_Created_Identifier);
pragma Inline (Has_Dereference_Action);
pragma Inline (Has_Dynamic_Length_Check);
- pragma Inline (Has_Dynamic_Range_Check);
pragma Inline (Has_Init_Expression);
pragma Inline (Has_Local_Raise);
pragma Inline (Has_Self_Reference);
pragma Inline (Set_Has_Created_Identifier);
pragma Inline (Set_Has_Dereference_Action);
pragma Inline (Set_Has_Dynamic_Length_Check);
- pragma Inline (Set_Has_Dynamic_Range_Check);
pragma Inline (Set_Has_Init_Expression);
pragma Inline (Set_Has_Local_Raise);
pragma Inline (Set_Has_No_Elaboration_Code);
Print_Eol;
end if;
- if Has_Dynamic_Range_Check (N) then
- Print_Str (Prefix_Str_Char);
- Print_Str ("Has_Dynamic_Range_Check = True");
- Print_Eol;
- end if;
-
if Is_Controlling_Actual (N) then
Print_Str (Prefix_Str_Char);
Print_Str ("Is_Controlling_Actual = True");
projects / gcc.git / commitdiff