|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 13312 (0x3400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Case_Analysis, seg_00461c
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Statements;
with Lrm_Utilities;
with Bounds_Utilities;
with Lrm_Renames;
use Lrm_Renames;
package body Case_Analysis is
function Kind (Case_Expression : Ada_Program.Type_Definition)
return Case_Expression_Kind is
begin
case Types.Kind (Types.Ground_Type (Case_Expression)) is
when Types.An_Integer_Type_Definition =>
return An_Integer;
when Types.An_Enumeration_Type_Definition =>
return An_Enumeration;
when others =>
raise Ada.Inappropriate_Program_Element;
end case;
end Kind;
function Expression_Kind (For_Case_Statement : Ada_Program.Statement)
return Case_Expression_Kind is
Expression_Type : Ada.Element :=
Exprs.Expression_Type (Statements.Case_Expression
(For_Case_Statement));
begin
return Kind (Expression_Type);
end Expression_Kind;
function Get_Literal (Position : Long_Integer;
Type_Def : Ada_Program.Type_Definition)
return Ada.Element is
Lits : Ada.Element_Iterator := Types.Enumeration_Literals (Type_Def);
Position_Number : Long_Integer := 0;
Lit : Ada.Element;
begin
while not Ada.Done (Lits) loop
Lit := Ada.Value (Lits);
if Position_Number = Position then
return Lit;
end if;
Position_Number := Position_Number + 1;
Ada.Next (Lits);
end loop;
raise Program_Error;
end Get_Literal;
procedure Get_Bounds (For_Choice : Ada.Element;
Lower_Pos, Upper_Pos : in out Long_Integer) is
Upper, Lower : Ada.Element;
Constraint : Ada.Element;
Id, Id_Def : Ada.Element;
Success, Static : Boolean;
begin
case Types.Choice_Kind (For_Choice) is
when Types.A_Simple_Expression =>
Lower_Pos := Lrm_Utilities.Static_Value
(Types.Choice_Expression (For_Choice));
Upper_Pos := Lower_Pos;
when Types.A_Discrete_Range =>
Bounds_Utilities.Find_Range
(Types.Choice_Range (For_Choice), Lower_Pos,
Upper_Pos, Static, Lower, Upper);
when Types.An_Identifier_Reference =>
Id := Types.Choice_Identifier (For_Choice);
Id_Def := Ada.Definition (Id);
Lower_Pos := Lrm_Utilities.Static_Value (Id);
Upper_Pos := Lower_Pos;
when others =>
raise Ada.Inappropriate_Program_Element;
end case;
end Get_Bounds;
procedure Init (Iter : in out Value_Iterator) is
Hole_Low, Hole_High : Long_Integer := 0;
begin
if Iter.Is_Others_Iterator then
if Discrete_Hole_Manager.More_Holes (Iter.Holes) then
Discrete_Hole_Manager.Next_Hole
(Iter.Holes, Hole_Low, Hole_High);
Iter.Current_Lower := Hole_Low;
Iter.Current_Upper := Hole_High;
Iter.Current_Value := Hole_Low;
else
Iter.Is_Done := True;
end if;
else
Discrete_Value_Manager.Init_Iteration (Iter.Values);
if Discrete_Value_Manager.More_Values (Iter.Values) then
Discrete_Value_Manager.Next_Range
(Iter.Values, Hole_Low, Hole_High);
Iter.Current_Lower := Hole_Low;
Iter.Current_Upper := Hole_High;
Iter.Current_Value := Hole_Low;
else
Iter.Is_Done := True;
end if;
end if;
end Init;
function Values (For_Case_Arm : Ada_Program.Element)
return Value_Iterator is
Case_Statement : Ada.Statement := Ada.Parent (For_Case_Arm);
Expression_Type : Ada.Element :=
Exprs.Expression_Type (Statements.Case_Expression (Case_Statement));
Return_Iter : Value_Iterator;
Arms : Ada.Element_Iterator := Stmts.Case_Arms_List (Case_Statement);
An_Arm : Ada.Element;
Choices : Ada.Element_Iterator;
A_Choice : Ada.Element;
Lower, Upper : Ada.Element;
Hole_Low, Hole_High : Long_Integer := 0;
Lower_Pos, Upper_Pos : Long_Integer;
Success, Static : Boolean;
begin
Return_Iter.Kind := Kind (Expression_Type);
Return_Iter.Ground_Type_Def := Types.Ground_Type (Expression_Type);
Return_Iter.Arm := For_Case_Arm;
Bounds_Utilities.Get_Constraints
(Expression_Type, Lower_Pos, Upper_Pos, Static);
-- fill up the lists
if Stmts.Is_When_Others (For_Case_Arm) then
Discrete_Hole_Manager.Init_Holes
(Return_Iter.Holes, Lower_Pos, Upper_Pos);
Return_Iter.Is_Others_Iterator := True;
while not Ada.Done (Arms) loop
An_Arm := Ada.Value (Arms);
if not Stmts.Is_When_Others (An_Arm) then
Choices := Stmts.Case_Alternative_Choices (An_Arm);
while not Ada.Done (Choices) loop
A_Choice := Ada.Value (Choices);
Get_Bounds (A_Choice, Lower_Pos, Upper_Pos);
Discrete_Hole_Manager.Delete_Hole
(Return_Iter.Holes, Lower_Pos, Upper_Pos, Success);
Ada.Next (Choices);
end loop;
end if;
Ada.Next (Arms);
end loop;
else
Discrete_Value_Manager.Init_Values
(Return_Iter.Values, Lower_Pos, Upper_Pos);
Return_Iter.Is_Others_Iterator := False;
Choices := Stmts.Case_Alternative_Choices (For_Case_Arm);
while not Ada.Done (Choices) loop
A_Choice := Ada.Value (Choices);
Get_Bounds (A_Choice, Lower_Pos, Upper_Pos);
Discrete_Value_Manager.Add_Value_Range
(Return_Iter.Values, Lower_Pos, Upper_Pos, Success);
Ada.Next (Choices);
end loop;
end if;
Init (Return_Iter);
return Return_Iter;
end Values;
procedure Reset (Iter : in out Value_Iterator) is
begin
Iter := Values (Iter.Arm);
end Reset;
function Done (Iter : Value_Iterator) return Boolean is
begin
return Iter.Is_Done;
end Done;
function Integer_Value (Iter : Value_Iterator) return Long_Integer is
begin
case Iter.Kind is
when An_Enumeration =>
raise Bad_Kind;
when An_Integer =>
return Iter.Current_Value;
end case;
end Integer_Value;
function Enumeration_Literal (Iter : Value_Iterator)
return Ada_Program.Element is
begin
case Iter.Kind is
when An_Enumeration =>
return Get_Literal (Iter.Current_Value, Iter.Ground_Type_Def);
when An_Integer =>
raise Bad_Kind;
end case;
end Enumeration_Literal;
procedure Next (Iter : in out Value_Iterator) is
Low, High : Long_Integer;
begin
if Iter.Current_Value = Iter.Current_Upper then
if Iter.Is_Others_Iterator then
if Discrete_Hole_Manager.More_Holes (Iter.Holes) then
Discrete_Hole_Manager.Next_Hole (Iter.Holes, Low, High);
Iter.Current_Lower := Low;
Iter.Current_Upper := High;
Iter.Current_Value := Low;
else
Iter.Is_Done := True;
end if;
else
if Discrete_Value_Manager.More_Values (Iter.Values) then
Discrete_Value_Manager.Next_Range (Iter.Values, Low, High);
Iter.Current_Lower := Low;
Iter.Current_Upper := High;
Iter.Current_Value := Low;
else
Iter.Is_Done := True;
end if;
end if;
else
Iter.Current_Value := Iter.Current_Value + 1;
end if;
end Next;
procedure Value_Range (Iter : Value_Iterator;
Low, High : out Long_Integer) is
begin
Low := Iter.Current_Lower;
High := Iter.Current_Upper;
end Value_Range;
procedure Next_Range (Iter : in out Value_Iterator) is
Low, High : Long_Integer;
begin
if Iter.Is_Others_Iterator then
if Discrete_Hole_Manager.More_Holes (Iter.Holes) then
Discrete_Hole_Manager.Next_Hole (Iter.Holes, Low, High);
Iter.Current_Lower := Low;
Iter.Current_Upper := High;
else
Iter.Is_Done := True;
end if;
else
if Discrete_Value_Manager.More_Values (Iter.Values) then
Discrete_Value_Manager.Next_Range (Iter.Values, Low, High);
Iter.Current_Lower := Low;
Iter.Current_Upper := High;
else
Iter.Is_Done := True;
end if;
end if;
end Next_Range;
end Case_Analysis;
nblk1=c
nid=0
hdr6=18
[0x00] rec0=1c rec1=00 rec2=01 rec3=04a
[0x01] rec0=1e rec1=00 rec2=02 rec3=040
[0x02] rec0=1a rec1=00 rec2=03 rec3=052
[0x03] rec0=00 rec1=00 rec2=0c rec3=008
[0x04] rec0=1e rec1=00 rec2=04 rec3=010
[0x05] rec0=1a rec1=00 rec2=05 rec3=048
[0x06] rec0=02 rec1=00 rec2=0b rec3=00c
[0x07] rec0=19 rec1=00 rec2=06 rec3=040
[0x08] rec0=20 rec1=00 rec2=07 rec3=012
[0x09] rec0=1d rec1=00 rec2=08 rec3=03e
[0x0a] rec0=20 rec1=00 rec2=09 rec3=00e
[0x0b] rec0=1d rec1=00 rec2=0a rec3=000
tail 0x21700245c815c65c7283d 0x42a00088462061e03