|
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: 21504 (0x5400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Expression_Utilities, seg_004628
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Io;
with Diana;
with Declarations;
with Ada_Program;
with Universal;
with Names_And_Expressions;
package body Expression_Utilities is
package Expressions renames Names_And_Expressions;
function Static_Value (Expression : Ada_Program.Expression)
return Long_Integer is
Exp : Diana.Tree := Ada_Program.Conversion.Convert (Expression);
Li : Long_Integer;
begin
case Diana.Kind (Diana.Sm_Value (Exp)) is
when Diana.Integer_Valued =>
Li := Universal.Convert (Diana.Integer_Value
(Diana.Sm_Value (Exp)));
return Li;
when others =>
raise Not_Static;
end case;
exception
when others =>
raise Not_Static;
end Static_Value;
function Integer_Value (Integer_Expression : Ada_Program.Expression)
return Long_Integer s
Referenced_Decl : Ada_Program.Element;
Op_Kind : Operator_Kind;
Name_Reference_Value : Long_Integer;
Has_A_Value : Boolean;
begin
case Expressions.Kind (Integer_Expression) is
when Expressions.An_Integer_Literal =>
return Expressions.Static_Value (Integer_Expression);
when Expressions.A_Simple_Name | Expressions.A_Selected_Component =>
Referenced_Decl := Ada_Program.Definition (Integer_Expression);
case Declarations.Kind (Referenced_Decl) is
when Declarations.A_Constant_Declaration |
Declarations.An_Integer_Number_Declaration =>
return Integer_Value (Declarations.Initial_Value
(Referenced_Decl));
when others =>
Non_Static_Value (Integer_Expression,
Name_Reference_Value, Has_A_Value);
if Has_A_Value then
return Name_Reference_Value;
else
raise Not_Static;
end if;
end case;
when Expressions.A_Function_Call =>
Op_Kind := Expression_Operator (Integer_Expression);
case Op_Kind is
when Unary_Minus =>
return -Integer_Value (Left_Operand
(Integer_Expression));
when Unary_Plus =>
return Integer_Value (Left_Operand
(Integer_Expression));
when Plus =>
return Integer_Value (Left_Operand
(Integer_Expression)) +
Integer_Value (Right_Operand
(Integer_Expression));
when Minus =>
return Integer_Value (Left_Operand
(Integer_Expression)) -
Integer_Value (Right_Operand
(Integer_Expression));
when Times =>
return Integer_Value (Left_Operand
(Integer_Expression)) *
Integer_Value (Right_Operand
(Integer_Expression));
when Divide =>
return Integer_Value (Left_Operand
(Integer_Expression)) /
Integer_Value (Right_Operand
(Integer_Expression));
when others =>
raise Not_Static;
end case;
when others =>
raise Not_Static;
end case;
exception
when others =>
raise Not_Static;
end Integer_Value;
function Float_Value
(Float_Expression : Ada_Program.Expression) return Float is
Referenced_Decl : Ada_Program.Element;
Op_Kind : Operator_Kind;
Name_Reference_Value : Float;
Has_A_Value : Boolean;
begin
case Expressions.Kind (Float_Expression) is
when Expressions.A_Real_Literal =>
return Expressions.Static_Value (Float_Expression);
when Expressions.A_Simple_Name | Expressions.A_Selected_Component =>
Referenced_Decl := Ada_Program.Definition (Float_Expression);
case Declarations.Kind (Referenced_Decl) is
when Declarations.A_Constant_Declaration |
Declarations.A_Real_Number_Declaration =>
return Float_Value (Declarations.Initial_Value
(Referenced_Decl));
when others =>
Non_Static_Value (Float_Expression,
Name_Reference_Value, Has_A_Value);
if Has_A_Value then
return Name_Reference_Value;
else
raise Not_Static;
end if;
end case;
when Expressions.A_Function_Call =>
Op_Kind := Expression_Operator (Float_Expression);
case Op_Kind is
when Unary_Minus =>
return -Float_Value (Left_Operand (Float_Expression));
when Unary_Plus =>
return Float_Value (Left_Operand (Float_Expression));
when Plus =>
return Float_Value (Left_Operand (Float_Expression)) +
Float_Value (Right_Operand
(Float_Expression));
when Minus =>
return Float_Value (Left_Operand (Float_Expression)) -
Float_Value (Right_Operand
(Float_Expression));
when Times =>
return Float_Value (Left_Operand (Float_Expression)) *
Float_Value (Right_Operand
(Float_Expression));
when Divide =>
return Float_Value (Left_Operand (Float_Expression)) /
Float_Value (Right_Operand
(Float_Expression));
when others =>
raise Not_Static;
end case;
when others =>
raise Not_Static;
end case;
exception
when others =>
raise Not_Static;
end Float_Value;
function String_Value
(String_Expression : Ada_Program.Expression) return String is
Referenced_Decl : Ada_Program.Element;
Op_Kind : Operator_Kind;
Name_Reference_Value : String (1 .. 1024);
Last : Positive;
Has_A_Value : Boolean;
begin
case Expressions.Kind (String_Expression) is
when Expressions.A_String_Literal =>
return Expressions.Static_Value (String_Expression);
when Expressions.A_Simple_Name | Expressions.A_Selected_Component =>
Referenced_Decl := Ada_Program.Definition (String_Expression);
case Declarations.Kind (Referenced_Decl) is
when Declarations.A_Constant_Declaration =>
return String_Value (Declarations.Initial_Value
(Referenced_Decl));
when others =>
Non_Static_Value (String_Expression,
Name_Reference_Value,
Last, Has_A_Value);
if Has_A_Value then
return Name_Reference_Value
(Name_Reference_Value'First .. Last);
else
raise Not_Static;
end if;
end case;
when Expressions.A_Function_Call =>
Op_Kind := Expression_Operator (String_Expression);
case Op_Kind is
when Concatenate =>
return String_Value (Left_Operand (String_Expression)) &
String_Value (Right_Operand
(String_Expression));
when others =>
raise Not_Static;
end case;
when others =>
raise Not_Static;
end case;
exception
when others =>
raise Not_Static;
end String_Value;
function Number_Of_Parameters (Node : Diana.Tree) return Natural is
Count : Natural := 0;
Params : Diana.Seq_Type;
begin
Params := Diana.As_List (Diana.As_Param_Assoc_S (Node));
while not Diana.Is_Empty (Diana.Head (Params)) loop
Count := Count + 1;
Params := Diana.Tail (Params);
end loop;
return Count;
exception
when others =>
return 0;
end Number_Of_Parameters;
function Expression_Operator
(Expr : Ada_Program.Expression) return Operator_Kind is
Local : Diana.Tree := Ada_Program.Conversion.Convert (Expr);
Number_Of_Params : Natural := Number_Of_Parameters (Local);
begin
if Number_Of_Params = 0 then
return Not_An_Operator_Expression;
end if;
loop
case Diana.Kind (Local) is
when Diana.Dn_Function_Call =>
Local := Diana.As_Name (Local);
when Diana.Dn_Used_Bltn_Op =>
declare
Name : constant String := Diana.Image
(Diana.Lx_Symrep (Local));
begin
if Name = "&" then
return Concatenate;
elsif Name = "+" then
if Number_Of_Params = 1 then
return Unary_Plus;
else
return Plus;
end if;
elsif Name = "-" then
if Number_Of_Params = 1 then
return Unary_Minus;
else
return Minus;
end if;
elsif Name = "*" then
return Times;
elsif Name = "/" then
return Divide;
else
return Other_Operator;
end if;
end;
when others =>
return Not_An_Operator_Expression;
end case;
end loop;
end Expression_Operator;
function Left_Operand (Expr : Ada_Program.Expression)
return Ada_Program.Expression is
Params : Diana.Seq_Type :=
Diana.As_List (Diana.As_Param_Assoc_S
(Ada_Program.Conversion.Convert (Expr)));
begin
return Ada_Program.Conversion.Convert (Diana.Head (Params));
end Left_Operand;
function Right_Operand (Expr : Ada_Program.Expression)
return Ada_Program.Expression is
Params : Diana.Seq_Type :=
Diana.As_List (Diana.As_Param_Assoc_S
(Ada_Program.Conversion.Convert (Expr)));
begin
return Ada_Program.Conversion.Convert
(Diana.Head (Diana.Tail (Params)));
end Right_Operand;
function Is_Expression (Elem : Ada_Program.Element) return Boolean is
begin
return Names_And_Expressions.Kind (Elem) in
Names_And_Expressions.A_Simple_Name ..
Names_And_Expressions.A_Function_Call;
end Is_Expression;
end Expression_Utilities;
nblk1=14
nid=0
hdr6=28
[0x00] rec0=1e rec1=00 rec2=01 rec3=05e
[0x01] rec0=00 rec1=00 rec2=14 rec3=002
[0x02] rec0=17 rec1=00 rec2=02 rec3=018
[0x03] rec0=00 rec1=00 rec2=13 rec3=022
[0x04] rec0=13 rec1=00 rec2=03 rec3=04e
[0x05] rec0=10 rec1=00 rec2=04 rec3=08a
[0x06] rec0=1b rec1=00 rec2=05 rec3=02c
[0x07] rec0=00 rec1=00 rec2=12 rec3=022
[0x08] rec0=13 rec1=00 rec2=06 rec3=04c
[0x09] rec0=13 rec1=00 rec2=07 rec3=036
[0x0a] rec0=1c rec1=00 rec2=08 rec3=09c
[0x0b] rec0=01 rec1=00 rec2=11 rec3=010
[0x0c] rec0=13 rec1=00 rec2=09 rec3=008
[0x0d] rec0=1e rec1=00 rec2=0a rec3=030
[0x0e] rec0=00 rec1=00 rec2=10 rec3=004
[0x0f] rec0=17 rec1=00 rec2=0b rec3=01a
[0x10] rec0=00 rec1=00 rec2=0f rec3=01c
[0x11] rec0=1a rec1=00 rec2=0c rec3=038
[0x12] rec0=16 rec1=00 rec2=0d rec3=02c
[0x13] rec0=02 rec1=00 rec2=0e rec3=000
tail 0x217002474815c65e4e572 0x42a00088462061e03