|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 13276 (0x33dc)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─⟦129cab021⟧ »DATA«
└─⟦this⟧
with Object, Scanner, Message, Arguments, Msg_Report,
Boolean_Class, Block_Class, String_Class;
package body Integer_Class is
function Send (To_Object : Object.Reference;
The_Message : Message.Selector;
With_Arguments : Arguments.List := Arguments.Void_Arguments)
return Object.Reference is
type Unary_Msg is (Aucube, Aucarre, Entexte);
type Msg_1_Arg is (Plus, Minus, Mult, Div, Less, Great,
Less_Equal, Great_Equal, Diff, Equal, Fois);
type Msg_2_Arg is (Arepeter);
Result, Object1, Object2, Object3 : Object.Reference;
Args : Arguments.List;
Msg : Message.Selector := Message.Void_Selector;
An_Unary_Msg : Unary_Msg;
A_Msg_1_Arg : Msg_1_Arg;
A_Msg_2_Arg : Msg_2_Arg;
begin
Object1 := To_Object;
Args := With_Arguments;
case Arguments.How_Many (Args) is
when 0 =>
An_Unary_Msg := Unary_Msg'Value (Message.Image (The_Message));
case An_Unary_Msg is
when Aucarre =>
Msg_Report.Information ("message is AuCarre ");
Result := Square (Object1);
when Aucube =>
Msg_Report.Information ("Message is AuCube ");
Result := Cubic (Object1);
when Entexte =>
Msg_Report.Information ("Message is AuCube ");
Result := String_Class.Create (In_Text (Object1));
when others =>
Msg_Report.Interpret_Error
("Incorrect unary method " &
Message.Image (The_Message) &
" for object " & In_Text (Object1));
raise Incorrect_Method;
end case;
when 1 =>
Arguments.First (Args);
Arguments.Read (Args, Object2);
if Message.Image (The_Message) = "+" then
Msg_Report.Information ("Message is +");
A_Msg_1_Arg := Plus;
elsif Message.Image (The_Message) = "-" then
Msg_Report.Information ("Message is -");
A_Msg_1_Arg := Minus;
elsif Message.Image (The_Message) = "*" then
Msg_Report.Information ("Message is *");
A_Msg_1_Arg := Mult;
elsif Message.Image (The_Message) = "/" then
Msg_Report.Information ("Message is / ");
A_Msg_1_Arg := Div;
elsif Message.Image (The_Message) = "<" then
Msg_Report.Information ("Message is <");
A_Msg_1_Arg := Less;
elsif Message.Image (The_Message) = ">" then
Msg_Report.Information ("Message is >");
A_Msg_1_Arg := Great;
elsif Message.Image (The_Message) = "<=" then
Msg_Report.Information ("Message is <=");
A_Msg_1_Arg := Less_Equal;
elsif Message.Image (The_Message) = ">=" then
Msg_Report.Information ("Message is >=");
A_Msg_1_Arg := Great_Equal;
elsif Message.Image (The_Message) = "<>" then
Msg_Report.Information ("Message is <>");
A_Msg_1_Arg := Diff;
elsif Message.Image (The_Message) = "=" then
Msg_Report.Information ("Message is =");
A_Msg_1_Arg := Equal;
else
A_Msg_1_Arg := Msg_1_Arg'Value
(Message.Image (The_Message));
end if;
case A_Msg_1_Arg is
when Plus =>
Result := Object1 + Object2;
when Minus =>
Result := Object1 - Object2;
when Mult =>
Result := Object1 * Object2;
when Div =>
Result := Object1 / Object2;
when Less =>
Result := Object1 < Object2;
when Great =>
Result := Object1 > Object2;
when Less_Equal =>
Result := Is_Less_Or_Equal (Object1, Object2);
when Great_Equal =>
Result := Is_Great_Or_Equal (Object1, Object2);
when Diff =>
Result := Is_Not_Equal (Object1, Object2);
when Equal =>
Result := Is_Equal (Object1, Object2);
when Fois =>
Result := N_Time (Object1, Object2);
when others =>
Msg_Report.Interpret_Error
("Incorrect method " & Message.Image (The_Message) &
" for object " & In_Text (Object1));
raise Incorrect_Method;
end case;
when 2 =>
Arguments.First (Args);
Arguments.Read (Args, Object2);
Arguments.Read (Args, Object3);
A_Msg_2_Arg := Msg_2_Arg'Value (Message.Image (The_Message));
case A_Msg_2_Arg is
when Arepeter =>
Result := Repeat_To_Limit (Object1, Object2, Object3);
when others =>
Msg_Report.Interpret_Error
("Incorrect method " & Message.Image (The_Message) &
" for object " & In_Text (Object1));
raise Incorrect_Method;
end case;
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;
Msg : Message.Selector := Message.Void_Selector;
I : Integer;
Argument, Result : Object.Reference;
begin
Message.Copy (Msg, "Valeur");
for I in Object.Identificator (The_Start) ..
Object.Identificator (The_Limit) loop
Argument := Create (I);
Arguments.Write (Args_List, Argument);
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, "Valeur");
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;