|
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: 18432 (0x4800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Enumeration_Facilities, package body Operators, package body Slot, seg_04a306, seg_04a9f2, seg_04b460
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
package body Slot is
function Value (I : Standard.Integer) return Object is
begin
return Object'(Kind => Integer, The_Integer => I);
end Value;
function Value (F : Standard.Float) return Object is
begin
return Object'(Kind => Float, The_Float => F);
end Value;
function Value (B : Standard.Boolean) return Object is
begin
return Object'(Kind => Boolean, The_Boolean => B);
end Value;
function Value (C : Standard.Character) return Object is
begin
return (Object'(Kind => Character, The_Character => C));
end Value;
function Value (D : Standard.Duration) return Object is
begin
return (Object'(Kind => Duration, The_Duration => D));
end Value;
function Value (S : Standard.String) return Object is
begin
return (Object'(Kind => String,
The_String => Constant_String.Value (S)));
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) return Standard.Float is
begin
return The_Object.The_Float;
end Get;
function Get (The_Object : Object) return Standard.Character is
begin
return The_Object.The_Character;
end Get;
function Get (The_Object : Object) return Standard.Duration is
begin
return The_Object.The_Duration;
end Get;
function Get (The_Object : Object) return Standard.String is
begin
return Constant_String.Image (The_Object.The_String);
end Get;
procedure Set (The_Object : in out Object; To : Standard.Integer) is
begin
The_Object := Value (To);
end Set;
procedure Set (The_Object : in out Object; To : Standard.Boolean) is
begin
The_Object := Value (To);
end Set;
procedure Set (The_Object : in out Object; To : Standard.Float) is
begin
The_Object := Value (To);
end Set;
procedure Set (The_Object : in out Object; To : Standard.Character) is
begin
The_Object := Value (To);
end Set;
procedure Set (The_Object : in out Object; To : Standard.Duration) is
begin
The_Object := Value (To);
end Set;
procedure Set (The_Object : in out Object; To : Standard.String) is
begin
The_Object := Value (To);
end Set;
function Have_Same_Type (Left, Right : Object) return Standard.Boolean is
begin
return Left.Kind = Right.Kind;
end Have_Same_Type;
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 Is_A_Reference (The_Object : Object) return Standard.Boolean is
begin
return The_Object.Kind = Reference;
end Is_A_Reference;
function Reference_Value
(The_Reference : Fact_Reference.Object) return Object is
begin
return (Object'(Kind => Reference,
The_Reference => The_Reference));
end Reference_Value;
function Get_Reference (From_Object : Object)
return Fact_Reference.Object is
begin
return From_Object.The_Reference;
end Get_Reference;
procedure Put (The_Object : Object; Where : Output_Stream.Object) is
use Output_Stream;
begin
case The_Object.Kind is
when Integer =>
Put (The_Object.The_Integer, Where);
when Boolean =>
Put (The_Object.The_Boolean, Where);
when Float =>
Put (The_Object.The_Float, Where);
when Character =>
Put (The_Object.The_Character, Where);
when Duration =>
Put (The_Object.The_Duration, Where);
when String =>
Constant_String.Put (The_Object.The_String, Where);
when Enumeration =>
Put (The_Object.The_Enumeration, Where);
when Reference =>
Fact_Reference.Put (The_Object.The_Reference, Where);
when Undefined =>
Put ("undefined slot value", Where);
end case;
end Put;
package body Operators is
function "<" (Left, Right : Object) return Standard.Boolean is
use Constant_String;
use Constant_String.Operators;
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 Float =>
return Left.The_Float < Right.The_Float;
when Character =>
return Left.The_Character < Right.The_Character;
when Duration =>
return Left.The_Duration < Right.The_Duration;
when String =>
return Left.The_String < Right.The_String;
when Enumeration =>
return Left.The_Enumeration < Right.The_Enumeration;
when Reference | Undefined =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "<";
function "<=" (Left, Right : Object) return Standard.Boolean is
use Constant_String;
use Constant_String.Operators;
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 Float =>
return Left.The_Float <= Right.The_Float;
when Character =>
return Left.The_Character <= Right.The_Character;
when Duration =>
return Left.The_Duration <= Right.The_Duration;
when String =>
return Left.The_String <= Right.The_String;
when Enumeration =>
return Left.The_Enumeration <= Right.The_Enumeration;
when Reference | Undefined =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "<=";
function ">" (Left, Right : Object) return Standard.Boolean is
use Constant_String;
use Constant_String.Operators;
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 Float =>
return Left.The_Float > Right.The_Float;
when Character =>
return Left.The_Character > Right.The_Character;
when Duration =>
return Left.The_Duration > Right.The_Duration;
when String =>
return Left.The_String > Right.The_String;
when Enumeration =>
return Left.The_Enumeration > Right.The_Enumeration;
when Reference | Undefined =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end ">";
function ">=" (Left, Right : Object) return Standard.Boolean is
use Constant_String;
use Constant_String.Operators;
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 Float =>
return Left.The_Float >= Right.The_Float;
when Character =>
return Left.The_Character >= Right.The_Character;
when Duration =>
return Left.The_Duration >= Right.The_Duration;
when String =>
return Left.The_String >= Right.The_String;
when Enumeration =>
return Left.The_Enumeration >= Right.The_Enumeration;
when Reference | Undefined =>
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 Float =>
return Value (Left.The_Float + Right.The_Float);
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 Float =>
return Value (Left.The_Float - Right.The_Float);
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 Float =>
return Value (Left.The_Float * Right.The_Float);
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 Float =>
return Value (Left.The_Float / Right.The_Float);
when others =>
raise Illegal_Operation;
end case;
else
raise Typing_Error;
end if;
end "/";
function "&" (Left, Right : Object) return Object is
S : Constant_String.Object := Constant_String.Null_Object;
use Constant_String;
begin
case Left.Kind is
when Character =>
case Right.Kind is
when Character =>
S := Value (Left.The_Character &
Right.The_Character);
return Object'(Kind => String, The_String => S);
when String =>
S := Value (Left.The_Character &
Image (Right.The_String));
return Object'(Kind => String, The_String => S);
when others =>
raise Illegal_Operation;
end case;
when String =>
case Right.Kind is
when Character =>
S := Value (Image (Left.The_String) &
Right.The_Character);
return Object'(Kind => String, The_String => S);
when String =>
S := Value (Image (Left.The_String) &
Image (Right.The_String));
return Object'(Kind => String, The_String => S);
when others =>
raise Illegal_Operation;
end case;
when others =>
raise Illegal_Operation;
end case;
end "&";
function "-" (Right : Object) return Object is
begin
case Right.Kind is
when Integer =>
return Value (-Right.The_Integer);
when Float =>
return Value (-Right.The_Float);
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 Float =>
return Value (abs Right.The_Float);
when others =>
raise Illegal_Operation;
end case;
end "abs";
end Operators;
package body Enumeration_Facilities is
function Value (Enumeration_Value : Enumeration_Values) return Object is
The_Value : Standard.Integer;
begin
The_Value := Enumeration_Values'Pos (Enumeration_Value);
return Object'(Kind => Enumeration, The_Enumeration => The_Value);
end Value;
function Get (The_Object : Object) return Enumeration_Values is
Result : Enumeration_Values;
begin
if The_Object.Kind = Enumeration then
return Enumeration_Values'Val (The_Object.The_Enumeration);
else
raise Constraint_Error;
end if;
end Get;
procedure Set (The_Object : in out Object; To : Enumeration_Values) is
begin
The_Object := Value (To);
end Set;
procedure Put (The_Object : Object; Where : Output_Stream.Object) is
use Output_Stream;
The_Value : Enumeration_Values;
begin
if The_Object.Kind = Enumeration then
The_Value := Enumeration_Values'Val
(The_Object.The_Enumeration);
Put (Enumeration_Values'Image (The_Value), Where);
else
raise Constraint_Error;
end if;
end Put;
end Enumeration_Facilities;
end Slot;
nblk1=11
nid=0
hdr6=22
[0x00] rec0=23 rec1=00 rec2=01 rec3=000
[0x01] rec0=28 rec1=00 rec2=02 rec3=004
[0x02] rec0=26 rec1=00 rec2=03 rec3=022
[0x03] rec0=23 rec1=00 rec2=04 rec3=014
[0x04] rec0=1a rec1=00 rec2=05 rec3=08a
[0x05] rec0=15 rec1=00 rec2=06 rec3=00a
[0x06] rec0=17 rec1=00 rec2=07 rec3=044
[0x07] rec0=18 rec1=00 rec2=08 rec3=022
[0x08] rec0=17 rec1=00 rec2=09 rec3=06e
[0x09] rec0=18 rec1=00 rec2=0a rec3=01a
[0x0a] rec0=18 rec1=00 rec2=0b rec3=032
[0x0b] rec0=1d rec1=00 rec2=0c rec3=03e
[0x0c] rec0=17 rec1=00 rec2=0d rec3=084
[0x0d] rec0=14 rec1=00 rec2=0e rec3=020
[0x0e] rec0=20 rec1=00 rec2=0f rec3=0a0
[0x0f] rec0=1e rec1=00 rec2=10 rec3=01a
[0x10] rec0=0a rec1=00 rec2=11 rec3=000
tail 0x2174ea0a4866e7c1b82a7 0x42a00088462063c03