|
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: 24576 (0x6000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Binary_Expression, package body Generic_Expression, package body Primary_Expression, package body System_Defined, package body System_Defined_Expression, package body Unary_Expression, seg_03a575, seg_03b944, seg_03c0bb, seg_03c526, seg_03c6cd
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
package body Generic_Expression is
type Expression_Owners is (System, User);
package System_Defined is
type Operators is ('+', '-', '*', '/', '&', Abs_Op);
function Evaluate (Using_Operator : Operators; Right : Slot.Object)
return Slot.Object;
function Evaluate (Using_Operator : Operators;
Left, Right : Slot.Object) return Slot.Object;
function Image (Op : Operators) return String;
end System_Defined;
package Primary_Expression is
type Sub_Classes is (Alias_Value, Immediate_Value);
type Object (Kind : Sub_Classes := Immediate_Value) is
record
case Kind is
when Alias_Value =>
The_Alias : Alias.Name;
when Immediate_Value =>
The_Value : Slot.Object;
end case;
end record;
function Value (For_Object : Slot.Object) return Object;
function Value (For_Alias : Alias.Name) return Object;
procedure Put (The_Object : Object; Where : Output_Stream.Object);
function Evaluate (The_Object : Object) return Slot.Object;
end Primary_Expression;
package Unary_Expression is
type Object (Owner : Expression_Owners := System) is
record
The_Operand : Generic_Expression.Object;
case Owner is
when System =>
The_System_Operator : System_Defined.Operators;
when User =>
The_User_Operator : User_Defined_Operators;
end case;
end record;
function Make (The_Operator : System_Defined.Operators;
The_Operand : Generic_Expression.Object) return Object;
function Make (The_Operator : User_Defined_Operators;
The_Operand : Generic_Expression.Object) return Object;
procedure Put (The_Object : Object; Where : Output_Stream.Object);
function Evaluate (The_Object : Object) return Slot.Object;
end Unary_Expression;
package Binary_Expression is
type Object (Owner : Expression_Owners := System) is
record
The_Left_Operand : Generic_Expression.Object;
The_Right_Operand : Generic_Expression.Object;
case Owner is
when System =>
The_System_Operator : System_Defined.Operators;
when User =>
The_User_Operator : User_Defined_Operators;
end case;
end record;
function Make (The_Operator : System_Defined.Operators;
The_Left_Operand : Generic_Expression.Object;
The_Right_Operand : Generic_Expression.Object)
return Object;
function Make (The_Operator : User_Defined_Operators;
The_Left_Operand : Generic_Expression.Object;
The_Right_Operand : Generic_Expression.Object)
return Object;
procedure Put (The_Object : Object; Where : Output_Stream.Object);
function Evaluate (The_Object : Object) return Slot.Object;
end Binary_Expression;
type Object_Structure (Sub_Class : Sub_Classes) is
record
case Sub_Class is
when Primary =>
The_Primary_Code : Primary_Expression.Object;
when Unary =>
The_Unary_Code : Unary_Expression.Object;
when Binary =>
The_Binary_Code : Binary_Expression.Object;
when Undefined =>
null;
end case;
end record;
function New_Node (For_Code : Object_Structure) return Object is
Result : Object;
begin
Result := new Object_Structure (Sub_Class => For_Code.Sub_Class);
Result.all := For_Code;
return Result;
end New_Node;
function Value (For_Object : Slot.Object) return Object is
begin
return New_Node ((Sub_Class => Primary,
The_Primary_Code =>
Primary_Expression.Value (For_Object)));
end Value;
function Value (For_Integer : Integer) return Object is
The_Object : Slot.Object := Slot.Value (For_Integer);
begin
return New_Node ((Sub_Class => Primary,
The_Primary_Code =>
Primary_Expression.Value (The_Object)));
end Value;
function Value (For_Boolean : Boolean) return Object is
The_Object : Slot.Object := Slot.Value (For_Boolean);
begin
return New_Node ((Sub_Class => Primary,
The_Primary_Code =>
Primary_Expression.Value (The_Object)));
end Value;
function Value (For_Float : Float) return Object is
The_Object : Slot.Object := Slot.Value (For_Float);
begin
return New_Node ((Sub_Class => Primary,
The_Primary_Code =>
Primary_Expression.Value (The_Object)));
end Value;
function Value (For_Character : Character) return Object is
The_Object : Slot.Object := Slot.Value (For_Character);
begin
return New_Node ((Sub_Class => Primary,
The_Primary_Code =>
Primary_Expression.Value (The_Object)));
end Value;
function Value (For_Duration : Duration) return Object is
The_Object : Slot.Object := Slot.Value (For_Duration);
begin
return New_Node ((Sub_Class => Primary,
The_Primary_Code =>
Primary_Expression.Value (The_Object)));
end Value;
function Value (For_String : String) return Object is
The_Object : Slot.Object := Slot.Value (For_String);
begin
return New_Node ((Sub_Class => Primary,
The_Primary_Code =>
Primary_Expression.Value (The_Object)));
end Value;
function Value (For_Alias : Alias.Name) return Object is
begin
return New_Node ((Sub_Class => Primary,
The_Primary_Code =>
Primary_Expression.Value (For_Alias)));
end Value;
function Unary_User_Expression (Right : Object) return Object is
The_Code : Unary_Expression.Object;
begin
The_Code := Unary_Expression.Make (Operator, Right);
return New_Node (For_Code => (Sub_Class => Unary,
The_Unary_Code => The_Code));
end Unary_User_Expression;
function Binary_User_Expression (Left, Right : Object) return Object is
The_Code : Binary_Expression.Object;
begin
The_Code := Binary_Expression.Make (Operator, Left, Right);
return New_Node (For_Code => (Sub_Class => Binary,
The_Binary_Code => The_Code));
end Binary_User_Expression;
function Evaluate (The_Expression : Object) return Slot.Object is
begin
if The_Expression = Null_Expression then
return Slot.Null_Object;
else
case The_Expression.Sub_Class is
when Primary =>
return Primary_Expression.Evaluate
(The_Expression.The_Primary_Code);
when Unary =>
return Unary_Expression.Evaluate
(The_Expression.The_Unary_Code);
when Binary =>
return Binary_Expression.Evaluate
(The_Expression.The_Binary_Code);
when Undefined =>
raise Illegal_Operation;
end case;
end if;
end Evaluate;
procedure Put (The_Object : Object; Where : Output_Stream.Object) is
use Output_Stream;
begin
if The_Object /= Null_Expression then
case The_Object.Sub_Class is
when Primary =>
Primary_Expression.Put (The_Object.The_Primary_Code, Where);
when Unary =>
Unary_Expression.Put (The_Object.The_Unary_Code, Where);
when Binary =>
Binary_Expression.Put (The_Object.The_Binary_Code, Where);
when Undefined =>
Put ("Undefined expression", Where);
end case;
end if;
end Put;
package body System_Defined is separate;
package body Primary_Expression is separate;
package body Unary_Expression is separate;
package body Binary_Expression is separate;
package body System_Defined_Expression is separate;
end Generic_Expression;
nblk1=17
nid=12
hdr6=18
[0x00] rec0=1b rec1=00 rec2=01 rec3=02e
[0x01] rec0=03 rec1=00 rec2=0e rec3=024
[0x02] rec0=14 rec1=00 rec2=16 rec3=07c
[0x03] rec0=00 rec1=00 rec2=0f rec3=016
[0x04] rec0=16 rec1=00 rec2=07 rec3=018
[0x05] rec0=1a rec1=00 rec2=15 rec3=01e
[0x06] rec0=1b rec1=00 rec2=05 rec3=00c
[0x07] rec0=18 rec1=00 rec2=0c rec3=012
[0x08] rec0=19 rec1=00 rec2=02 rec3=084
[0x09] rec0=19 rec1=00 rec2=11 rec3=03c
[0x0a] rec0=1b rec1=00 rec2=17 rec3=050
[0x0b] rec0=06 rec1=00 rec2=13 rec3=000
[0x0c] rec0=15 rec1=00 rec2=0d rec3=022
[0x0d] rec0=14 rec1=00 rec2=16 rec3=01e
[0x0e] rec0=19 rec1=00 rec2=0e rec3=00e
[0x0f] rec0=16 rec1=00 rec2=11 rec3=072
[0x10] rec0=15 rec1=00 rec2=15 rec3=03e
[0x11] rec0=17 rec1=00 rec2=17 rec3=00e
[0x12] rec0=11 rec1=00 rec2=0f rec3=000
[0x13] rec0=14 rec1=00 rec2=15 rec3=00e
[0x14] rec0=1a rec1=00 rec2=17 rec3=026
[0x15] rec0=05 rec1=00 rec2=0f rec3=000
[0x16] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21737bce485073d5d0e5a 0x42a00088462063c03
Free Block Chain:
0x12: 0000 00 08 00 49 80 01 3b 01 00 0e 20 20 20 20 65 6e ┆ I ; en┆
0x8: 0000 00 0d 00 73 80 0b 64 20 45 76 61 6c 75 61 74 65 ┆ s d Evaluate┆
0xd: 0000 00 0b 03 fc 80 47 20 20 20 20 20 20 20 20 20 20 ┆ G ┆
0xb: 0000 00 0a 00 07 80 04 64 5f 45 76 04 20 53 79 73 74 ┆ d_Ev Syst┆
0xa: 0000 00 03 00 94 80 2f 72 65 73 73 69 6f 6e 20 28 55 ┆ /ression (U┆
0x3: 0000 00 09 00 c4 80 19 64 69 63 61 74 65 20 72 65 74 ┆ dicate ret┆
0x9: 0000 00 10 03 fc 80 1d 68 74 20 3a 20 4f 62 6a 65 63 ┆ ht : Objec┆
0x10: 0000 00 06 03 1e 80 47 20 20 20 20 20 69 66 20 54 68 ┆ G if Th┆
0x6: 0000 00 04 00 0e 80 0b 65 5f 43 6f 64 65 73 20 28 31 ┆ e_Codes (1┆
0x4: 0000 00 14 00 55 00 40 20 20 20 20 20 20 20 20 66 75 ┆ U @ fu┆
0x14: 0000 00 00 03 fa 80 16 20 20 20 77 68 65 6e 20 41 6c ┆ when Al┆