|
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 Enumeration_Facilities, package body Operators, package body Slot, seg_02d0ad, seg_02d141
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦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;
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 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 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 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 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 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 "-" (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=17
nid=8
hdr6=1e
[0x00] rec0=25 rec1=00 rec2=01 rec3=004
[0x01] rec0=00 rec1=00 rec2=02 rec3=002
[0x02] rec0=26 rec1=00 rec2=07 rec3=010
[0x03] rec0=23 rec1=00 rec2=12 rec3=038
[0x04] rec0=1b rec1=00 rec2=06 rec3=01c
[0x05] rec0=16 rec1=00 rec2=10 rec3=000
[0x06] rec0=14 rec1=00 rec2=0c rec3=076
[0x07] rec0=18 rec1=00 rec2=0e rec3=05c
[0x08] rec0=18 rec1=00 rec2=0a rec3=040
[0x09] rec0=18 rec1=00 rec2=14 rec3=02c
[0x0a] rec0=11 rec1=00 rec2=11 rec3=04e
[0x0b] rec0=1d rec1=00 rec2=0b rec3=040
[0x0c] rec0=1d rec1=00 rec2=17 rec3=020
[0x0d] rec0=1d rec1=00 rec2=04 rec3=014
[0x0e] rec0=18 rec1=00 rec2=03 rec3=000
[0x0f] rec0=0b rec1=00 rec2=03 rec3=000
[0x10] rec0=18 rec1=00 rec2=16 rec3=01e
[0x11] rec0=18 rec1=00 rec2=02 rec3=044
[0x12] rec0=1b rec1=00 rec2=03 rec3=06a
[0x13] rec0=1a rec1=00 rec2=0f rec3=010
[0x14] rec0=0c rec1=00 rec2=05 rec3=000
[0x15] rec0=0e rec1=00 rec2=0d rec3=000
[0x16] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x215260a20841544963f5f 0x42a00088462060003
Free Block Chain:
0x8: 0000 00 13 01 e3 80 0a 75 72 61 74 69 6f 6e 20 3d 3e ┆ uration =>┆
0x13: 0000 00 0f 00 80 80 1c 20 20 20 20 20 72 61 69 73 65 ┆ raise┆
0xf: 0000 00 05 03 fc 00 15 20 20 20 20 20 20 20 20 20 20 ┆ ┆
0x5: 0000 00 0d 03 fa 80 12 20 20 20 20 77 68 65 6e 20 6f ┆ when o┆
0xd: 0000 00 16 00 06 80 03 20 20 20 03 20 20 06 73 65 09 ┆ se ┆
0x16: 0000 00 15 02 c8 00 2b 20 20 20 20 20 20 20 20 20 20 ┆ + ┆
0x15: 0000 00 09 01 48 00 46 20 20 20 20 20 20 20 20 20 20 ┆ H F ┆
0x9: 0000 00 00 02 d8 80 2c 20 20 20 20 20 20 20 20 20 77 ┆ , w┆