|
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: 13312 (0x3400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Class_Integer, seg_0328c0
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
-- with Block_Class;
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 (Object.Get (This_Message)) /= 0 then
declare
use Object;
An_Object : Object.Reference := To;
begin
Token := Message'Value (Bs.Image (Object.Get (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 (" Valeur =>");
Text_Io.Put (Object.Index'Image (Object.Get (To)));
Text_Io.New_Line;
Text_Io.Put (")");
Text_Io.New_Line (2);
return An_Object;
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 =>
null;
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 =>
Value := Object.Get (Object.Get (This_Message));
Object.Put (Value, An_Object);
return An_Object;
when Diff =>
if Object.Index'(Object.Get
(Object.Get (This_Message))) /=
Object.Get (An_Object) 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.Index'(Object.Get
(Object.Get (This_Message))) >
Object.Get (An_Object) 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.Index'(Object.Get
(Object.Get (This_Message))) >=
Object.Get (An_Object) 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.Index'(Object.Get
(Object.Get (This_Message))) <
Object.Get (An_Object) 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.Index'(Object.Get
(Object.Get (This_Message))) <=
Object.Get (An_Object) 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 Bounded_String.Variable_String is
use Object;
Chaine : Bounded_String.Variable_String (25);
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;
nblk1=c
nid=b
hdr6=16
[0x00] rec0=1f rec1=00 rec2=01 rec3=080
[0x01] rec0=19 rec1=00 rec2=02 rec3=044
[0x02] rec0=04 rec1=00 rec2=0c rec3=012
[0x03] rec0=17 rec1=00 rec2=09 rec3=018
[0x04] rec0=13 rec1=00 rec2=06 rec3=014
[0x05] rec0=11 rec1=00 rec2=04 rec3=050
[0x06] rec0=11 rec1=00 rec2=08 rec3=028
[0x07] rec0=17 rec1=00 rec2=07 rec3=024
[0x08] rec0=19 rec1=00 rec2=03 rec3=01a
[0x09] rec0=21 rec1=00 rec2=05 rec3=002
[0x0a] rec0=10 rec1=00 rec2=0a rec3=000
[0x0b] rec0=7f rec1=00 rec2=00 rec3=000
tail 0x2172dbbde84c893693dd5 0x42a00088462060003
Free Block Chain:
0xb: 0000 00 00 00 3b 80 0b 20 49 6e 66 5f 45 67 61 6c 29 ┆ ; Inf_Egal)┆