|
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 - downloadIndex: ┃ B T ┃
Length: 9674 (0x25ca)
Types: TextFile
Names: »B«
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦this⟧
-- with Class_Block;
with Bounded_String;
with Object;
with String_Utilities;
with Text_Io;
package body Class_Integer is
function Send (This_Message : Object.Unary; To : Object.Reference)
return Object.Reference is
type Message is (Moins, En_Texte);
Token : Message;
package Bs renames Bounded_String;
package Su renames String_Utilities;
begin
if Bs.Length (This_Message) /= 0 then
declare
use Object;
An_Object : Object.Reference := To;
begin
Token := Message'Value (Bs.Image (This_Message));
case Token is
when En_Texte =>
Text_Io.Put ("Objet Integer (");
Text_Io.New_Line;
Text_Io.Put (" Classe =>");
Text_Io.Put (Object.E_Class'Image (Object.Get (To)));
Text_Io.New_Line;
Text_Io.Put (" Objet =>");
Text_Io.Put (Object.Index'Image (Object.Get (To)));
Text_Io.New_Line;
Text_Io.Put (" )");
Text_Io.New_Line (2);
when Moins =>
Object.Put (-Object.Index'(Object.Get (An_Object)),
An_Object);
return An_Object;
end case;
exception
when Constraint_Error =>
return Object.Void_Reference;
end;
end if;
end Send;
function Send (This_Message : Object.Binary; To : Object.Reference)
return Object.Reference is
type Message is (Prendre, Plus, Moins, Mul, Div, Egal,
Diff, Sup, Sup_Egal, Inf, Inf_Egal);
Token : Message;
package Bs renames Bounded_String;
package Su renames String_Utilities;
begin
if Bs.Length (Object.Get (This_Message)) /= 0 then
declare
use Object;
An_Object : Object.Reference := To;
Value : Object.Index;
begin
Token := Message'Value (Bs.Image (Object.Get (This_Message)));
case Token is
when Prendre =>
Value := Object.Get (Object.Get (This_Message));
Object.Put (Value, An_Object);
return An_Object;
when Plus =>
Object.Put (Object.Get (An_Object) +
Object.Get (Object.Get (This_Message)),
An_Object);
return An_Object;
when Moins =>
Object.Put (Object.Get (An_Object) -
Object.Get (Object.Get (This_Message)),
An_Object);
return An_Object;
when Mul =>
Object.Put (Object.Get (An_Object) *
Object.Get (Object.Get (This_Message)),
An_Object);
return An_Object;
when Div =>
Object.Put (Object.Get (An_Object) /
Object.Get (Object.Get (This_Message)),
An_Object);
return An_Object;
when Egal =>
if Object.Get (An_Object) =
Object.Index'(Object.Get
(Object.Get (This_Message))) then
return Object.Create (Class => Object.Boolean_Class,
Object => 1);
else
return Object.Create (Class => Object.Boolean_Class,
Object => 0);
end if;
when Diff =>
if Object.Get (An_Object) /=
Object.Index'(Object.Get
(Object.Get (This_Message))) then
return Object.Create (Class => Object.Boolean_Class,
Object => 1);
else
return Object.Create (Class => Object.Boolean_Class,
Object => 0);
end if;
when Sup =>
if Object.Get (An_Object) >
Object.Index'(Object.Get
(Object.Get (This_Message))) then
return Object.Create (Class => Object.Boolean_Class,
Object => 1);
else
return Object.Create (Class => Object.Boolean_Class,
Object => 0);
end if;
when Sup_Egal =>
if Object.Get (An_Object) >=
Object.Index'(Object.Get
(Object.Get (This_Message))) then
return Object.Create (Class => Object.Boolean_Class,
Object => 1);
else
return Object.Create (Class => Object.Boolean_Class,
Object => 0);
end if;
when Inf =>
if Object.Get (An_Object) <
Object.Index'(Object.Get
(Object.Get (This_Message))) then
return Object.Create (Class => Object.Boolean_Class,
Object => 1);
else
return Object.Create (Class => Object.Boolean_Class,
Object => 0);
end if;
when Inf_Egal =>
if Object.Get (An_Object) <=
Object.Index'(Object.Get
(Object.Get (This_Message))) then
return Object.Create (Class => Object.Boolean_Class,
Object => 1);
else
return Object.Create (Class => Object.Boolean_Class,
Object => 0);
end if;
end case;
exception
when Constraint_Error =>
return Object.Void_Reference;
end;
end if;
end Send;
function Send (This_Message : Object.Keyword; To : Object.Reference)
return Object.Reference is
type Message is (Fois, A_Repeter);
Token : Message;
package Bs renames Bounded_String;
package Su renames String_Utilities;
begin
if Bs.Length (Object.Get (This_Message)) /= 0 then
declare
Value : Object.Reference;
begin
Token := Message'Value (Bs.Image (Object.Get (This_Message)));
case Token is
when Fois =>
for I in 1 .. Object.Get (To) loop
null;
-- Value := Block_Class.Send (This_Message, To);
end loop;
return Value;
when A_Repeter =>
-- for I in Object.Get (To) ..
-- Object.Get (Object.Get (This_Message)) loop
null;
-- Value := Block_Class.Send (This_Message, To);
-- end loop;
return Value;
end case;
exception
when Constraint_Error =>
return Object.Void_Reference;
end;
end if;
end Send;
function Create (Value : Object.Index := 0) return Object.Reference is
An_Object : Object.Reference;
begin
Object.Put (Object.Integer_Class, An_Object);
Object.Put (Value, An_Object);
return An_Object;
end Create;
function Image (Objet : Object.Reference) return Object.Tiny_String is
use Object;
Chaine : Object.Tiny_String;
Valeur : Object.Index;
begin
Valeur := Object.Get (Objet);
Bounded_String.Copy (Chaine, String_Utilities.Number_To_String
(Value => Integer (Valeur)));
return Chaine;
end Image;
function Value (Chaine : Object.Tiny_String) return Object.Reference is
An_Object : Object.Reference;
Bool : Boolean;
Entier : Integer;
begin
String_Utilities.String_To_Number
(Source => Bounded_String.Image (Chaine),
Worked => Bool,
Target => Entier);
Object.Put (Object.Integer_Class, An_Object);
Object.Put (Object.Index (Entier), An_Object);
return An_Object;
end Value;
end Class_Integer;