|
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: 20480 (0x5000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Integer_Class, seg_03651e
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Object, Scanner, Message, Arguments, Msg_Report,
Boolean_Class, Block_Class, String_Class, String_Utilities;
package body Integer_Class is
function Is_Equal_String
(Str1 : String; Str2 : String; Ignore_Case : Boolean := True)
return Boolean renames String_Utilities.Equal;
function Send (To_Object : Object.Reference;
The_Message : Message.Selector;
With_Arguments : Arguments.List := Arguments.Void_Arguments)
return Object.Reference is
Result, Object1, Object2, Object3 : Object.Reference;
Args : Arguments.List;
Msg : Message.Selector := Message.Void_Selector;
begin
Object1 := To_Object;
Args := With_Arguments;
case Arguments.How_Many (Args) is
when 0 =>
if Is_Equal_String (Message.Image (The_Message), "AuCarre") then
Msg_Report.Information ("Message is AuCarre ");
Result := Square (Object1);
elsif Is_Equal_String
(Message.Image (The_Message), "AuCube") then
Msg_Report.Information ("Message is AuCube ");
Result := Cubic (Object1);
elsif Is_Equal_String
(Message.Image (The_Message), "EnTexte") then
Msg_Report.Information ("Message is EnTexte ");
Result := String_Class.Create (In_Text (Object1));
else
Msg_Report.Interpret_Error
("Incorrect unary method " &
Message.Image (The_Message) &
" for object " & In_Text (Object1));
raise Incorrect_Method;
end if;
when 1 =>
Arguments.First (Args);
Arguments.Read (Args, Object2);
if Message.Image (The_Message) = "+" then
Msg_Report.Information ("Message is +");
Result := Object1 + Object2;
elsif Message.Image (The_Message) = "-" then
Msg_Report.Information ("Message is -");
Result := Object1 - Object2;
elsif Message.Image (The_Message) = "*" then
Msg_Report.Information ("Message is *");
Result := Object1 * Object2;
elsif Message.Image (The_Message) = "/" then
Msg_Report.Information ("Message is / ");
Result := Object1 / Object2;
elsif Message.Image (The_Message) = "<" then
Msg_Report.Information ("Message is <");
Result := Object1 < Object2;
elsif Message.Image (The_Message) = ">" then
Msg_Report.Information ("Message is >");
Result := Object1 > Object2;
elsif Message.Image (The_Message) = "<=" then
Msg_Report.Information ("Message is <=");
Result := Is_Less_Or_Equal (Object1, Object2);
elsif Message.Image (The_Message) = ">=" then
Msg_Report.Information ("Message is >=");
Result := Is_Great_Or_Equal (Object1, Object2);
elsif Message.Image (The_Message) = "<>" then
Msg_Report.Information ("Message is <>");
Result := Is_Not_Equal (Object1, Object2);
elsif Message.Image (The_Message) = "=" then
Msg_Report.Information ("Message is =");
Result := Is_Equal (Object1, Object2);
elsif Is_Equal_String
(Message.Format (The_Message), "Fois") then
Msg_Report.Information ("Message is Fois:");
Result := N_Time (Object1, Object2);
else
Msg_Report.Interpret_Error
("Incorrect method " & Message.Image (The_Message) &
" for object " & In_Text (Object1));
raise Incorrect_Method;
end if;
when 2 =>
Arguments.First (Args);
Arguments.Read (Args, Object2);
Arguments.Read (Args, Object3);
if Is_Equal_String
(Message.Format (The_Message), "Arepeter") then
Msg_Report.Information ("Message is A: Repeter:");
Result := Repeat_To_Limit (Object1, Object2, Object3);
else
Msg_Report.Interpret_Error
("Incorrect method " & Message.Image (The_Message) &
" for object " & In_Text (Object1));
raise Incorrect_Method;
end if;
when others =>
Msg_Report.Interpret_Error
("Incorrect nb of arguments for method " &
Message.Image (The_Message) &
" to object " & In_Text (Object1));
raise Incorrect_Nb_Args;
end case;
return Result;
end Send;
function Create (Value : Integer) return Object.Reference is
begin
return Object.Create (Object.C_Integer, Value);
end Create;
function Delete (The_Integer : Object.Reference) return Object.Reference is
begin
return Object.Void_Reference;
end Delete;
function In_Text (The_Integer : Object.Reference) return String is
begin
return Integer'Image (Object.Identificator (The_Integer));
end In_Text;
function Square (The_Integer : Object.Reference) return Object.Reference is
Op_Result : Integer;
begin
Op_Result := Object.Identificator (The_Integer);
Op_Result := Op_Result * Op_Result;
return Object.Create (Object.C_Integer, Op_Result);
end Square;
function Cubic (The_Integer : Object.Reference) return Object.Reference is
Op_Result : Integer;
begin
Op_Result := Object.Identificator (The_Integer);
Op_Result := Op_Result * Op_Result * Op_Result;
return Object.Create (Object.C_Integer, Op_Result);
end Cubic;
function Repeat_To_Limit (The_Start : Object.Reference;
The_Limit : Object.Reference;
The_Block : Object.Reference)
return Object.Reference is
Args_List : Arguments.List;
Argument, Result : Object.Reference;
Msg : Message.Selector;
begin
Message.Copy (Msg, Block_Class.Keyword_Evaluate_Msg);
for I in Object.Identificator (The_Start) ..
Object.Identificator (The_Limit) loop
Argument := Create (I);
Args_List := Arguments.Void_Arguments;
Arguments.Write (Args_List, Argument);
Msg_Report.Information ("The_block is ");
Msg_Report.Continue
("class = " & Object.Class'Image (Object.The_Class (The_Block)) &
" ident = " & Integer'Image (Object.Identificator (The_Block)));
Msg_Report.Information ("Message is " & Message.Image (Msg));
Arguments.Image (Args_List);
Result := Block_Class.Send (The_Block, Msg, Args_List);
end loop;
return Result;
end Repeat_To_Limit;
function N_Time (Nb_Time : Object.Reference; The_Block : Object.Reference)
return Object.Reference is
Msg : Message.Selector := Message.Void_Selector;
I : Integer;
Result : Object.Reference;
begin
Message.Copy (Msg, Block_Class.Evaluate_Msg);
for I in 1 .. Object.Identificator (Nb_Time) loop
Result := Block_Class.Send (The_Block, Msg);
end loop;
return Result;
end N_Time;
function "+" (First_Integer : Object.Reference;
Second_Integer : Object.Reference) return Object.Reference is
Op_Result : Integer;
begin
Op_Result := Object.Identificator (First_Integer) +
Object.Identificator (Second_Integer);
return Object.Create (Object.C_Integer, Op_Result);
end "+";
function "-" (First_Integer : Object.Reference;
Second_Integer : Object.Reference) return Object.Reference is
Op_Result : Integer;
begin
Op_Result := Object.Identificator (First_Integer) -
Object.Identificator (Second_Integer);
return Object.Create (Object.C_Integer, Op_Result);
end "-";
function "*" (First_Integer : Object.Reference;
Second_Integer : Object.Reference) return Object.Reference is
Op_Result : Integer;
begin
Op_Result := Object.Identificator (First_Integer) *
Object.Identificator (Second_Integer);
return Object.Create (Object.C_Integer, Op_Result);
end "*";
function "/" (First_Integer : Object.Reference;
Second_Integer : Object.Reference) return Object.Reference is
Op_Result : Integer;
begin
Op_Result := Object.Identificator (First_Integer) /
Object.Identificator (Second_Integer);
return Object.Create (Object.C_Integer, Op_Result);
end "/";
function "<" (First_Integer : Object.Reference;
Second_Integer : Object.Reference) return Object.Reference is
Result : Object.Reference := Object.Void_Reference;
begin
if Object.Identificator (First_Integer) <
Object.Identificator (Second_Integer) then
Result := Boolean_Class.Create (True);
else
Result := Boolean_Class.Create (False);
end if;
return Result;
end "<";
function ">" (First_Integer : Object.Reference;
Second_Integer : Object.Reference) return Object.Reference is
Result : Object.Reference := Object.Void_Reference;
begin
if Object.Identificator (First_Integer) >
Object.Identificator (Second_Integer) then
Result := Boolean_Class.Create (True);
else
Result := Boolean_Class.Create (False);
end if;
return Result;
end ">";
function Is_Less_Or_Equal (First_Integer : Object.Reference;
Second_Integer : Object.Reference)
return Object.Reference is
Result : Object.Reference := Object.Void_Reference;
begin
if Object.Identificator (First_Integer) <=
Object.Identificator (Second_Integer) then
Result := Boolean_Class.Create (True);
else
Result := Boolean_Class.Create (False);
end if;
return Result;
end Is_Less_Or_Equal;
function Is_Great_Or_Equal
(First_Integer : Object.Reference;
Second_Integer : Object.Reference) return Object.Reference is
Result : Object.Reference := Object.Void_Reference;
begin
if Object.Identificator (First_Integer) >=
Object.Identificator (Second_Integer) then
Result := Boolean_Class.Create (True);
else
Result := Boolean_Class.Create (False);
end if;
return Result;
end Is_Great_Or_Equal;
function Is_Equal (First_Integer : Object.Reference;
Second_Integer : Object.Reference)
return Object.Reference is
Result : Object.Reference := Object.Void_Reference;
begin
if Object.Identificator (First_Integer) =
Object.Identificator (Second_Integer) then
Result := Boolean_Class.Create (True);
else
Result := Boolean_Class.Create (False);
end if;
return Result;
end Is_Equal;
function Is_Not_Equal (First_Integer : Object.Reference;
Second_Integer : Object.Reference)
return Object.Reference is
Result : Object.Reference := Object.Void_Reference;
begin
if Object.Identificator (First_Integer) /=
Object.Identificator (Second_Integer) then
Result := Boolean_Class.Create (True);
else
Result := Boolean_Class.Create (False);
end if;
return Result;
end Is_Not_Equal;
end Integer_Class;
nblk1=13
nid=2
hdr6=20
[0x00] rec0=21 rec1=00 rec2=01 rec3=036
[0x01] rec0=1c rec1=00 rec2=11 rec3=042
[0x02] rec0=1c rec1=00 rec2=12 rec3=03c
[0x03] rec0=1a rec1=00 rec2=03 rec3=01e
[0x04] rec0=1c rec1=00 rec2=13 rec3=02c
[0x05] rec0=1f rec1=00 rec2=10 rec3=03e
[0x06] rec0=1d rec1=00 rec2=07 rec3=03a
[0x07] rec0=1a rec1=00 rec2=0c rec3=028
[0x08] rec0=03 rec1=00 rec2=0f rec3=016
[0x09] rec0=1f rec1=00 rec2=0a rec3=078
[0x0a] rec0=03 rec1=00 rec2=08 rec3=042
[0x0b] rec0=1b rec1=00 rec2=0d rec3=004
[0x0c] rec0=1d rec1=00 rec2=06 rec3=06a
[0x0d] rec0=1b rec1=00 rec2=04 rec3=010
[0x0e] rec0=1d rec1=00 rec2=0e rec3=02e
[0x0f] rec0=0b rec1=00 rec2=09 rec3=000
[0x10] rec0=1b rec1=00 rec2=04 rec3=010
[0x11] rec0=1d rec1=00 rec2=0e rec3=02e
[0x12] rec0=0b rec1=00 rec2=09 rec3=000
tail 0x2152fbc9084de763f434f 0x42a00088462060003
Free Block Chain:
0x2: 0000 00 05 00 04 80 01 20 01 20 20 20 20 20 20 20 20 ┆ ┆
0x5: 0000 00 0b 00 04 00 01 20 01 3d 3e 04 00 3e 20 20 20 ┆ => > ┆
0xb: 0000 00 00 00 2c 00 19 20 20 20 20 20 20 20 20 20 20 ┆ , ┆