|
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 Integer_Class, seg_0363a4
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Object, Argument, Message, Bounded_String, Random,
Block_Class, Boolean_Class, String_Class, Counter, Bug;
package body Integer_Class is
package Bs renames Bounded_String;
type Integer_Keyword_Message is (Fois, Repeter, A);
type Integer_Unary_Message is
(Entexte, Image, Aucube, Moins, Aleatoire, Attend);
function Create (Value : Integer) return Object.Reference is
Obj : Object.Reference;
begin
Obj := Object.Create (Object.Integer_Class, Value);
return (Obj);
end Create;
function Fois (Indice, Blk : Object.Reference) return Object.Reference is
Obj : Object.Reference;
The_Message_Valeur : Message.Tiny_String;
use Object;
begin
if (Object.Get_Class (Blk) /= Object.Block_Class) then
raise Bug.Mismatch_Type;
end if;
Bs.Copy (The_Message_Valeur, Block_Class.Message_Valeur);
for I in 1 .. Object.Get_Value (Indice) loop
Obj := Block_Class.Send (Blk, The_Message_Valeur);
end loop;
return (Obj);
end Fois;
function Repeter (Min, Max, Blk : Object.Reference)
return Object.Reference is
Obj : Object.Reference;
Arg : Argument.List;
Mess : Message.List;
The_Value_Message : Message.Tiny_String;
use Object;
begin
if (Object.Get_Class (Blk) /= Object.Block_Class) or
(Object.Get_Class (Min) /= Object.Integer_Class) or
(Object.Get_Class (Max) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
Bs.Copy (The_Value_Message, Block_Class.Message_Valeur);
if (Object.Get_Value (Min) > Object.Get_Value (Max)) then
for I in reverse Object.Get_Value (Max) ..
Object.Get_Value (Min) loop
Message.Init (Mess);
Mess := Message.Put (Mess, The_Value_Message);
Obj := Create (I);
Argument.Init (Arg);
Arg := Argument.Put (Arg, Obj);
Obj := Block_Class.Send (Blk, Mess, Arg);
end loop;
else
for I in Object.Get_Value (Min) .. Object.Get_Value (Max) loop
Message.Init (Mess);
Mess := Message.Put (Mess, The_Value_Message);
Obj := Create (I);
Argument.Init (Arg);
Arg := Argument.Put (Arg, Obj);
Obj := Block_Class.Send (Blk, Mess, Arg);
end loop;
end if;
return (Obj);
end Repeter;
function "+" (A, B : Object.Reference) return Object.Reference is
Obj : Object.Reference;
use Object;
begin
if (Object.Get_Class (A) /= Object.Integer_Class) or
(Object.Get_Class (B) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
Obj := Create (Object.Get_Value (A) + Object.Get_Value (B));
return (Obj);
end "+";
function "-" (A, B : Object.Reference) return Object.Reference is
Obj : Object.Reference;
use Object;
begin
if (Object.Get_Class (A) /= Object.Integer_Class) or
(Object.Get_Class (B) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
Obj := Create (Object.Get_Value (A) - Object.Get_Value (B));
return (Obj);
end "-";
function "*" (A, B : Object.Reference) return Object.Reference is
Obj : Object.Reference;
use Object;
begin
if (Object.Get_Class (A) /= Object.Integer_Class) or
(Object.Get_Class (B) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
Obj := Create (Object.Get_Value (A) * Object.Get_Value (B));
return (Obj);
end "*";
function "/" (A, B : Object.Reference) return Object.Reference is
Obj : Object.Reference;
use Object;
begin
if (Object.Get_Class (A) /= Object.Integer_Class) or
(Object.Get_Class (B) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
Obj := Create (Object.Get_Value (A) / Object.Get_Value (B));
return (Obj);
end "/";
function Randomize (A : Object.Reference) return Object.Reference is
Obj : Object.Reference;
A_Handle : Random.Handle;
Value : Integer;
begin
Random.Initialize (A_Handle);
Value := Object.Get_Value (A);
if (Value > 0) then
Obj := Create (Random.Natural_Value (A_Handle, Natural (Value)));
else
Obj := Create (Random.Natural_Value
(A_Handle, Natural (-1 * Value)));
end if;
return (Obj);
end Randomize;
function Wait (A : Object.Reference) return Object.Reference is
begin
if Object.Get_Value (A) > 0 then
delay (Duration (Object.Get_Value (A)));
end if;
return (A);
end Wait;
function Au_Cube (A : Object.Reference) return Object.Reference is
Obj : Object.Reference;
Value : Integer;
begin
Value := Object.Get_Value (A);
Obj := Create (Value * Value * Value);
return (Obj);
end Au_Cube;
function Greater_Than (A, B : Object.Reference) return Object.Reference is
Obj : Object.Reference;
use Object;
begin
if (Object.Get_Class (A) /= Object.Integer_Class) or
(Object.Get_Class (B) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
if Object.Get_Value (A) > Object.Get_Value (B) then
Obj := Boolean_Class.True;
else
Obj := Boolean_Class.False;
end if;
return (Obj);
end Greater_Than;
function Lower_Than (A, B : Object.Reference) return Object.Reference is
Obj : Object.Reference;
use Object;
begin
if (Object.Get_Class (A) /= Object.Integer_Class) or
(Object.Get_Class (B) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
if Object.Get_Value (A) < Object.Get_Value (B) then
Obj := Boolean_Class.True;
else
Obj := Boolean_Class.False;
end if;
return (Obj);
end Lower_Than;
function Greater_Or_Equal (A, B : Object.Reference)
return Object.Reference is
Obj : Object.Reference;
use Object;
begin
if (Object.Get_Class (A) /= Object.Integer_Class) or
(Object.Get_Class (B) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
if Object.Get_Value (A) >= Object.Get_Value (B) then
Obj := Boolean_Class.True;
else
Obj := Boolean_Class.False;
end if;
return (Obj);
end Greater_Or_Equal;
function Lower_Or_Equal (A, B : Object.Reference) return Object.Reference is
Obj : Object.Reference;
use Object;
begin
if (Object.Get_Class (A) /= Object.Integer_Class) or
(Object.Get_Class (B) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
if Object.Get_Value (A) <= Object.Get_Value (B) then
Obj := Boolean_Class.True;
else
Obj := Boolean_Class.False;
end if;
return (Obj);
end Lower_Or_Equal;
function Equal (A, B : Object.Reference) return Object.Reference is
Obj : Object.Reference;
use Object;
begin
if (Object.Get_Class (A) /= Object.Integer_Class) or
(Object.Get_Class (B) /= Object.Integer_Class) then
raise Bug.Mismatch_Type;
end if;
if Object.Get_Value (A) = Object.Get_Value (B) then
Obj := Boolean_Class.True;
else
Obj := Boolean_Class.False;
end if;
return (Obj);
end Equal;
function Minus (I : Object.Reference) return Object.Reference is
begin
return Create (-Object.Get_Value (I));
end Minus;
function Image (I : Object.Reference) return Object.Reference is
Valeur : Message.Tiny_String;
Result : Object.Reference;
begin
Bs.Copy (Valeur, Bs.Value (Integer'Image (Object.Get_Value (I))));
Result := String_Class.Create (Valeur);
return (Result);
end Image;
procedure In_Text (I : Object.Reference) is
begin
Object.In_Text (I);
end In_Text;
function Send (To_Object : Object.Reference;
The_Message : Message.Selector;
With_Arguments : Argument.List) return Object.Reference is
Obj, Arg1 : Object.Reference;
Args : Argument.List;
begin
Args := With_Arguments;
Arg1 := Argument.Get (Args);
Counter.Increase (Object.Integer_Class);
case The_Message is
when Message.Plus =>
Obj := To_Object + Arg1;
when Message.Moins =>
Obj := To_Object - Arg1;
when Message.Multiplier =>
Obj := To_Object * Arg1;
when Message.Diviser =>
Obj := To_Object / Arg1;
when Message.Inferieur =>
Obj := Lower_Than (To_Object, Arg1);
when Message.Superieur =>
Obj := Greater_Than (To_Object, Arg1);
when Message.Inferieur_Egal =>
Obj := Lower_Or_Equal (To_Object, Arg1);
when Message.Superieur_Egal =>
Obj := Greater_Or_Equal (To_Object, Arg1);
when Message.Egal =>
Obj := Equal (To_Object, Arg1);
when others =>
raise Bug.Unknown_Integer_Message;
end case;
Counter.Stop_Time (Object.Integer_Class);
return (Obj);
end Send;
function Send (To_Object : Object.Reference;
The_Messages : Message.List;
With_Arguments : Argument.List) return Object.Reference is
Result, Arg1, Arg2 : Object.Reference := Object.Void_Reference;
Args : Argument.List;
Mess : Message.List;
A_Message : Message.Tiny_String;
Talk : Integer_Keyword_Message;
begin
Args := With_Arguments;
Mess := The_Messages;
A_Message := Message.Get (Mess);
Talk := Integer_Keyword_Message'Value (Bs.Image (V => A_Message));
Counter.Increase (Object.Integer_Class);
case Talk is
when Fois =>
if Message.How_Many (Mess) > 1 then
raise Bug.Too_Many_Keywords;
end if;
Arg1 := Argument.Get (With_Arguments);
Result := Fois (To_Object, Arg1);
when Repeter =>
Message.Next (Mess, A_Message);
if Integer_Keyword_Message'Value (Bs.Image (V => A_Message)) /=
A then
raise Bug.Unknown_Integer_Message;
end if;
Arg1 := Argument.Get (With_Arguments);
Argument.Next (L => Args, Obj => Arg2);
Result := Repeter (To_Object, Arg2, Arg1);
when others =>
raise Bug.Unknown_Integer_Message;
end case;
Counter.Stop_Time (Object.Integer_Class);
return (Result);
exception
when Constraint_Error =>
raise Bug.Unknown_Integer_Message;
end Send;
function Send (To_Object : Object.Reference;
The_Message : Message.Tiny_String) return Object.Reference is
Result : Object.Reference := Object.Void_Reference;
Talk : Integer_Unary_Message;
begin
Talk := Integer_Unary_Message'Value (Bs.Image (V => The_Message));
Counter.Increase (Object.Integer_Class);
case Talk is
when Entexte =>
In_Text (To_Object);
Result := To_Object;
when Image =>
Result := Image (To_Object);
when Aucube =>
Result := Au_Cube (To_Object);
when Moins =>
Result := Minus (To_Object);
when Aleatoire =>
Result := Randomize (To_Object);
when Attend =>
Result := Wait (To_Object);
end case;
Counter.Stop_Time (Object.Integer_Class);
return (Result);
exception
when Constraint_Error =>
raise Bug.Unknown_Integer_Message;
end Send;
end Integer_Class;
nblk1=11
nid=2
hdr6=1e
[0x00] rec0=1d rec1=00 rec2=01 rec3=04e
[0x01] rec0=18 rec1=00 rec2=03 rec3=042
[0x02] rec0=1a rec1=00 rec2=0a rec3=038
[0x03] rec0=1c rec1=00 rec2=05 rec3=018
[0x04] rec0=1e rec1=00 rec2=06 rec3=002
[0x05] rec0=00 rec1=00 rec2=07 rec3=012
[0x06] rec0=1d rec1=00 rec2=09 rec3=010
[0x07] rec0=1d rec1=00 rec2=0b rec3=036
[0x08] rec0=1d rec1=00 rec2=0f rec3=042
[0x09] rec0=1f rec1=00 rec2=0c rec3=064
[0x0a] rec0=1f rec1=00 rec2=11 rec3=01a
[0x0b] rec0=1c rec1=00 rec2=0e rec3=000
[0x0c] rec0=1a rec1=00 rec2=04 rec3=00c
[0x0d] rec0=1e rec1=00 rec2=0d rec3=028
[0x0e] rec0=09 rec1=00 rec2=10 rec3=000
[0x0f] rec0=1f rec1=00 rec2=0d rec3=000
[0x10] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21732108a84d95c8b8b45 0x42a00088462060003
Free Block Chain:
0x2: 0000 00 08 00 87 80 01 3b 01 00 0f 20 20 20 20 20 20 ┆ ; ┆
0x8: 0000 00 00 00 e2 80 2e 20 20 20 20 43 6f 75 6e 74 65 ┆ . Counte┆