|
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 - metrics - download
Length: 15360 (0x3c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Operators, package body Unconstrained_Array, seg_03afb0, seg_03b92b, seg_03c0a3, seg_03c50e, seg_03c6b5, seg_03c9ea, seg_04a9c1, seg_04b42f
└─⟦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 Unconstrained_Array is
type Object_Structure (Kind : Types := Integer; Size : Natural := 0) is
record
case Kind is
when Integer =>
The_Integer : Standard.Integer := 0;
when Boolean =>
The_Boolean : Standard.Boolean := Standard.False;
when Collection =>
The_Collection : Objects (1 .. Size) := Null_Objects;
when Undefined =>
null;
end case;
end record;
function Value (I : Standard.Integer) return Object is
begin
return new Object_Structure'(Kind => Integer,
Size => 0,
The_Integer => I);
end Value;
function Value (B : Standard.Boolean) return Object is
begin
return new Object_Structure'(Kind => Boolean,
Size => 0,
The_Boolean => B);
end Value;
function Value (The_Objects : Objects) return Object is
begin
return new Object_Structure'(Kind => Collection,
Size => The_Objects'
Last,
The_Collection => The_Objects);
end Value;
function Get (The_Object : Object) return Standard.Integer is
begin
return The_Object.The_Integer;
end Get;
function Get (The_Object : Object) return Standard.Boolean is
begin
return The_Object.The_Boolean;
end Get;
function Get (The_Object : Object; The_Position : Natural) return Object is
begin
return The_Object.The_Collection (The_Position);
end Get;
procedure Set (The_Object : in out Object; To : Standard.Integer) is
begin
The_Object.all := (Kind => Integer, Size => 0, The_Integer => To);
end Set;
procedure Set (The_Object : in out Object; To : Standard.Boolean) is
begin
The_Object.all := (Kind => Boolean, Size => 0, The_Boolean => To);
end Set;
procedure Set (The_Object : in out Object; To : Objects) is
begin
The_Object.all :=
(Kind => Collection, Size => To'Last, The_Collection => To);
end Set;
function Undefined_Value return Object is
begin
return Null_Object;
end Undefined_Value;
function Is_Undefined (The_Object : Object) return Standard.Boolean is
begin
return The_Object = Null_Object;
end Is_Undefined;
procedure Make_Undefined (The_Object : in out Object) is
begin
The_Object := Null_Object;
end Make_Undefined;
function Have_Same_Type (Left, Right : Object) return Standard.Boolean is
begin
return Left.Kind = Right.Kind;
end Have_Same_Type;
procedure Put (The_Objects : Objects; Where : Output_Stream.Object) is
begin
for I in The_Objects'Range loop
Put (The_Objects (I), Where);
end loop;
end Put;
procedure Put (The_Object : Object; Where : Output_Stream.Object) is
begin
case The_Object.Kind is
when Integer =>
Output_Stream.Put (The_Object.The_Integer, Where);
when Boolean =>
Output_Stream.Put (The_Object.The_Boolean, Where);
when Collection =>
Put (The_Object.The_Collection, Where);
when Undefined =>
Output_Stream.Put ("undefined slot value", Where);
end case;
end Put;
package body Operators is
function "=" (Left, Right : Object) return Standard.Boolean is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Left.The_Integer = Right.The_Integer;
when Boolean =>
return Left.The_Boolean = Right.The_Boolean;
when Collection =>
if Left.The_Collection'Length =
Right.The_Collection'Length then
for I in Left.The_Collection'Range loop
if not (Left.The_Collection (I) =
Right.The_Collection (I)) then
return Standard.False;
end if;
end loop;
end if;
when Undefined =>
null;
end case;
return Standard.True;
else
return Standard.False;
end if;
end "=";
function "<" (Left, Right : Object) return Standard.Boolean is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Left.The_Integer < Right.The_Integer;
when Boolean =>
return Left.The_Boolean < Right.The_Boolean;
when Undefined | Collection =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "<";
function "<=" (Left, Right : Object) return Standard.Boolean is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Left.The_Integer <= Right.The_Integer;
when Boolean =>
return Left.The_Boolean <= Right.The_Boolean;
when Undefined | Collection =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "<=";
function ">" (Left, Right : Object) return Standard.Boolean is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Left.The_Integer > Right.The_Integer;
when Boolean =>
return Left.The_Boolean > Right.The_Boolean;
when Undefined | Collection =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end ">";
function ">=" (Left, Right : Object) return Standard.Boolean is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Left.The_Integer >= Right.The_Integer;
when Boolean =>
return Left.The_Boolean >= Right.The_Boolean;
when Undefined | Collection =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end ">=";
function "+" (Left, Right : Object) return Object is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Value (Left.The_Integer + Right.The_Integer);
when others =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "+";
function "-" (Left, Right : Object) return Object is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Value (Left.The_Integer - Right.The_Integer);
when others =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "-";
function "*" (Left, Right : Object) return Object is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Value (Left.The_Integer * Right.The_Integer);
when others =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "*";
function "/" (Left, Right : Object) return Object is
begin
if Left.Kind = Right.Kind then
case Left.Kind is
when Integer =>
return Value (Left.The_Integer / Right.The_Integer);
when others =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "/";
function "-" (Right : Object) return Object is
begin
case Right.Kind is
when Integer =>
return Value (-Right.The_Integer);
when others =>
raise Illegal_Operation;
end case;
end "-";
function "abs" (Right : Object) return Object is
begin
case Right.Kind is
when Integer =>
return Value (abs Right.The_Integer);
when others =>
raise Illegal_Operation;
end case;
end "abs";
end Operators;
end Unconstrained_Array;
nblk1=e
nid=9
hdr6=18
[0x00] rec0=1d rec1=00 rec2=01 rec3=018
[0x01] rec0=20 rec1=00 rec2=04 rec3=070
[0x02] rec0=26 rec1=00 rec2=05 rec3=08c
[0x03] rec0=21 rec1=00 rec2=03 rec3=03c
[0x04] rec0=15 rec1=00 rec2=0e rec3=048
[0x05] rec0=05 rec1=00 rec2=0c rec3=05e
[0x06] rec0=18 rec1=00 rec2=0d rec3=058
[0x07] rec0=1c rec1=00 rec2=0b rec3=036
[0x08] rec0=1d rec1=00 rec2=0a rec3=01c
[0x09] rec0=1d rec1=00 rec2=08 rec3=050
[0x0a] rec0=1f rec1=00 rec2=06 rec3=014
[0x0b] rec0=08 rec1=00 rec2=02 rec3=000
[0x0c] rec0=24 rec1=00 rec2=0f rec3=011
[0x0d] rec0=80 rec1=00 rec2=00 rec3=002
tail 0x217383b788512661c6692 0x42a00088462063c03
Free Block Chain:
0x9: 0000 00 07 00 18 80 04 65 67 69 6e 04 00 0e 20 20 20 ┆ egin ┆
0x7: 0000 00 00 00 22 80 1f 20 4c 65 66 74 2e 54 68 65 5f ┆ " Left.The_┆