|
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: 19456 (0x4c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Integer_Class, seg_039306
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Block_Class;
with Boolean_Class;
with Bounded_String;
with Custom;
with Errors;
with Random;
with String_Class;
with String_Utilities;
package body Integer_Class is
type Unary_Message is (Nul, Au_Carre, Au_Cube, Absolu, Negatif,
Oppose, Au_Hasard, Secondes, En_Texte);
type Binary_Message is (Nul, Plus, Moins, Fois, Divise, Modulo, Egal,
Sup, Inf, Sup_Ou_Egal, Inf_Ou_Egal, Different);
type List_Message is (Nul, A_Repeter, Fois);
My_Handle : Random.Handle;
function Convert_To_Unary
(The_Message : Scanner.Lexeme) return Unary_Message is
begin
if Bounded_String.Image (The_Message) = "AU_CARRE" then
return Au_Carre;
elsif Bounded_String.Image (The_Message) = "AU_CUBE" then
return Au_Cube;
elsif Bounded_String.Image (The_Message) = "ABSOLU" then
return Absolu;
elsif Bounded_String.Image (The_Message) = "OPPOSE" then
return Oppose;
elsif Bounded_String.Image (The_Message) = "NEGATIF" then
return Negatif;
elsif Bounded_String.Image (The_Message) = "AU_HASARD" then
return Au_Hasard;
elsif Bounded_String.Image (The_Message) = "SECONDES" then
return Secondes;
elsif Bounded_String.Image (The_Message) = "EN_TEXTE" then
return En_Texte;
else
return Nul;
end if;
end Convert_To_Unary;
function Convert_To_Binary
(The_Message : Scanner.Lexeme) return Binary_Message is
begin
if Bounded_String.Image (The_Message) = "+" then
return Plus;
elsif Bounded_String.Image (The_Message) = "-" then
return Moins;
elsif Bounded_String.Image (The_Message) = "*" then
return Fois;
elsif Bounded_String.Image (The_Message) = "/" then
return Divise;
elsif Bounded_String.Image (The_Message) = "%" then
return Modulo;
elsif Bounded_String.Image (The_Message) = "=" then
return Egal;
elsif Bounded_String.Image (The_Message) = ">" then
return Sup;
elsif Bounded_String.Image (The_Message) = "<" then
return Inf;
elsif Bounded_String.Image (The_Message) = ">=" then
return Sup_Ou_Egal;
elsif Bounded_String.Image (The_Message) = "<=" then
return Inf_Ou_Egal;
elsif Bounded_String.Image (The_Message) = "<>" then
return Different;
else
return Nul;
end if;
end Convert_To_Binary;
procedure Convert_To_List (The_Message : in out Message.Selector;
Back : out List_Message) is
begin
Back := Nul;
case Message.Arg_Number (The_Message) is
when 1 =>
Message.Init (The_Message);
if Bounded_String.Image (Message.Value (The_Message)) =
"FOIS:" then
Back := Fois;
end if;
when 2 =>
Message.Init (The_Message);
if Bounded_String.Image (Message.Value (The_Message)) =
"A:" then
Message.Next (The_Message);
if Bounded_String.Image (Message.Value (The_Message)) =
"REPETER:" then
Back := A_Repeter;
end if;
end if;
when others =>
null;
end case;
end Convert_To_List;
function Create (Value : Integer) return Object.Reference is
Class_Id : Object.Class := Object.Entier;
begin
return (Object.Create (Class_Id, Value));
end Create;
function Send (To_Object : Object.Reference; The_Message : Scanner.Lexeme)
return Object.Reference is
Current_Message : Unary_Message := Nul;
Random_Max : Natural;
begin
Current_Message := Convert_To_Unary (The_Message);
case Current_Message is
when Nul =>
raise Errors.Unknown_Message_For_Integer;
when Au_Carre =>
return Create (Object.Get_Id (To_Object) ** 2);
when Au_Cube =>
return Create (Object.Get_Id (To_Object) ** 3);
when Absolu =>
return Create (abs (Object.Get_Id (To_Object)));
when Negatif =>
return Create (-abs (Object.Get_Id (To_Object)));
when Oppose =>
return Create (-Object.Get_Id (To_Object));
when Au_Hasard =>
Random_Max := Random.Natural_Value
(My_Handle, Natural
(Object.Get_Id (To_Object)));
return Create (Integer (Random_Max));
when Secondes =>
delay (Duration (Object.Get_Id (To_Object)));
return Object.Void_Reference;
when En_Texte =>
return String_Class.Create (String_Utilities.Number_To_String
((Object.Get_Id (To_Object))));
end case;
end Send;
function Send (To_Object : Object.Reference;
The_Message : Scanner.Lexeme;
With_Object : Object.Reference) return Object.Reference is
Current_Message : Binary_Message := Nul;
begin
case Object.Get_Class (With_Object) is
when Object.Entier =>
Current_Message := Convert_To_Binary (The_Message);
case Current_Message is
when Nul =>
raise Errors.Unknown_Message_For_Integer;
when Plus =>
return Create ((Object.Get_Id (To_Object) +
Object.Get_Id (With_Object)));
when Moins =>
return Create ((Object.Get_Id (To_Object) -
Object.Get_Id (With_Object)));
when Fois =>
return Create ((Object.Get_Id (To_Object) *
Object.Get_Id (With_Object)));
when Divise =>
if Object.Get_Id (With_Object) /= 0 then
return Create ((Object.Get_Id (To_Object) /
Object.Get_Id (With_Object)));
else
raise Errors.Division_By_Zero;
end if;
when Modulo =>
return Create ((Object.Get_Id (To_Object) mod
Object.Get_Id (With_Object)));
when Egal =>
return Boolean_Class.Create
(Object.Get_Id (To_Object) =
Object.Get_Id (With_Object));
when Sup =>
return Boolean_Class.Create
(Object.Get_Id (To_Object) >
Object.Get_Id (With_Object));
when Inf =>
return Boolean_Class.Create
(Object.Get_Id (To_Object) <
Object.Get_Id (With_Object));
when Sup_Ou_Egal =>
return Boolean_Class.Create
(Object.Get_Id (To_Object) >=
Object.Get_Id (With_Object));
when Inf_Ou_Egal =>
return Boolean_Class.Create
(Object.Get_Id (To_Object) <=
Object.Get_Id (With_Object));
when Different =>
return Boolean_Class.Create
(Object.Get_Id (To_Object) /=
Object.Get_Id (With_Object));
end case;
when others =>
raise Errors.Integer_Object_Required_As_Argument;
end case;
end Send;
procedure Send (To_Object : Object.Reference;
The_Message : in out Message.Selector;
With_Arguments : in out Parameters.List;
Back_Object : out Object.Reference) is
Obj1, Obj2 : Object.Reference;
Result : Object.Reference;
Current_Selector : List_Message;
Interpret_Yourself : Scanner.Lexeme :=
Bounded_String.Value ("VALEUR", Custom.String_Max_Length);
Interpret_Yourself_With : Scanner.Lexeme :=
Bounded_String.Value ("VALEUR:", Custom.String_Max_Length);
begin
Convert_To_List (The_Message, Current_Selector);
case Current_Selector is
when Nul =>
raise Errors.Unknown_Message_For_Integer;
when A_Repeter =>
Parameters.Init (With_Arguments);
Obj1 := Parameters.Value (With_Arguments);
case Object.Get_Class (Obj1) is
when Object.Entier =>
Parameters.Next (With_Arguments);
Obj2 := Parameters.Value (With_Arguments);
case Object.Get_Class (Obj2) is
when Object.Bloc =>
Message.Free (The_Message);
Message.Insert
(Interpret_Yourself_With, The_Message);
if Object.Get_Id (To_Object) <=
Object.Get_Id (Obj1) then
for I in Object.Get_Id (To_Object) ..
Object.Get_Id (Obj1) loop
Parameters.Free (With_Arguments);
Parameters.Insert
(Create (I), With_Arguments);
Block_Class.Send
(Obj2, The_Message,
With_Arguments, Result);
Back_Object := Result;
end loop;
else
for I in reverse
Object.Get_Id (Obj1) ..
Object.Get_Id (To_Object) loop
Parameters.Free (With_Arguments);
Parameters.Insert
(Create (I), With_Arguments);
Block_Class.Send
(Obj2, The_Message,
With_Arguments, Result);
Back_Object := Result;
end loop;
end if;
when others =>
raise Errors.
Block_Argument_Required_For_Integer;
end case;
when others =>
raise Errors.Integer_Object_Required_As_Argument;
end case;
when Fois =>
Parameters.Init (With_Arguments);
Obj1 := Parameters.Value (With_Arguments);
case Object.Get_Class (Obj1) is
when Object.Bloc =>
for I in 1 .. Object.Get_Id (To_Object) loop
Back_Object := Block_Class.Send
(Obj1, Interpret_Yourself);
end loop;
when others =>
raise Errors.Block_Argument_Required_For_Integer;
end case;
end case;
Parameters.Free (With_Arguments);
end Send;
begin
Random.Initialize (My_Handle);
end Integer_Class;
nblk1=12
nid=d
hdr6=20
[0x00] rec0=1e rec1=00 rec2=01 rec3=03a
[0x01] rec0=00 rec1=00 rec2=09 rec3=032
[0x02] rec0=1a rec1=00 rec2=07 rec3=014
[0x03] rec0=19 rec1=00 rec2=11 rec3=056
[0x04] rec0=0c rec1=00 rec2=05 rec3=006
[0x05] rec0=1c rec1=00 rec2=0c rec3=012
[0x06] rec0=15 rec1=00 rec2=02 rec3=048
[0x07] rec0=01 rec1=00 rec2=12 rec3=00e
[0x08] rec0=13 rec1=00 rec2=0a rec3=010
[0x09] rec0=0d rec1=00 rec2=10 rec3=03e
[0x0a] rec0=12 rec1=00 rec2=06 rec3=076
[0x0b] rec0=17 rec1=00 rec2=08 rec3=052
[0x0c] rec0=11 rec1=00 rec2=0e rec3=04e
[0x0d] rec0=10 rec1=00 rec2=0f rec3=03e
[0x0e] rec0=13 rec1=00 rec2=0b rec3=054
[0x0f] rec0=0d rec1=00 rec2=04 rec3=000
[0x10] rec0=00 rec1=00 rec2=00 rec3=000
[0x11] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21532349484ec4c76558b 0x42a00088462060003
Free Block Chain:
0xd: 0000 00 03 00 0a 80 07 20 20 20 20 20 20 20 07 65 61 ┆ ea┆
0x3: 0000 00 00 00 22 80 01 6e 01 00 1b 20 20 20 20 20 20 ┆ " n ┆