|
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 - metrics - download
Length: 17408 (0x4400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Class_Integer, seg_038702
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Class_Block;
with Class_String;
with Class_Printer;
with Bounded_String;
with String_Utilities;
with Text_Io;
with Random;
with Bug_Report;
package body Class_Integer is
function Send (This_Message : Message.Unary; To : Object.Reference)
return Object.Reference is
type E_Message is (Moins, Entexte, Image, Attend, Auhasard);
Token : E_Message;
A_Handle : Random.Handle;
package Bs renames Bounded_String;
package Su renames String_Utilities;
use Object;
begin
Token := E_Message'Value (Bs.Image (Message.Get (This_Message)));
case Token is
when Entexte =>
Put (To);
return To;
when Image =>
return Class_String.Create
(Bs.Value
(Su.Number_To_String
(Value =>
Integer (Object.Get (Index_From => To))),
80));
when Moins =>
return Create (-Object.Index'(Object.Get (Index_From => To)));
when Attend =>
delay (Duration (Object.Index'(Object.Get (Index_From => To))));
return To;
when Auhasard =>
Random.Initialize (The_Handle => A_Handle);
return Create
(Object.Index
(Random.Natural_Value
(The_Handle => A_Handle,
Max => Natural
(Object.Get (Index_From => To)))));
end case;
exception
when Constraint_Error =>
raise Bug_Report.Unknown_Unary_Message;
end Send;
function Send (This_Message : Message.Binary; To : Object.Reference)
return Object.Reference is
type E_Message is (Plus, Moins, Mul, Div, Egal, Diff,
Sup, Sup_Egal, Inf, Inf_Egal);
Token : E_Message;
package Bs renames Bounded_String;
use Object;
begin
if Object.Get (Class_From =>
Message.Get (Argument_From => This_Message)) =
Object.Integer_Class then
begin
Token := E_Message'Value (Bs.Image
(Message.Get (This_Message)));
case Token is
when Plus =>
return Create (Object.Get (Index_From => To) +
Object.Get (Index_From =>
Message.Get
(Argument_From =>
This_Message)));
when Moins =>
return Create (Object.Get (Index_From => To) -
Object.Get (Index_From =>
Message.Get
(Argument_From =>
This_Message)));
when Mul =>
return Create (Object.Get (Index_From => To) *
Object.Get (Index_From =>
Message.Get
(Argument_From =>
This_Message)));
when Div =>
if Object.Get
(Index_From =>
Message.Get (Argument_From => This_Message)) =
0 then
raise Bug_Report.Divide_By_Zero;
end if;
return Create (Object.Get (Index_From => To) /
Object.Get (Index_From =>
Message.Get
(Argument_From =>
This_Message)));
when Egal =>
if Object.Index'(Object.Get (Index_From => To)) =
Object.Get (Index_From =>
Message.Get (Argument_From =>
This_Message)) then
return Object.Create (Object.Boolean_Class, 1);
else
return Object.Create (Object.Boolean_Class, 0);
end if;
when Diff =>
if Object.Index'(Object.Get (Index_From => To)) /=
Object.Get (Index_From =>
Message.Get (Argument_From =>
This_Message)) then
return Object.Create (Object.Boolean_Class, 1);
else
return Object.Create (Object.Boolean_Class, 0);
end if;
when Sup =>
if Object.Index'(Object.Get (Index_From => To)) >
Object.Get (Index_From =>
Message.Get (Argument_From =>
This_Message)) then
return Object.Create (Object.Boolean_Class, 1);
else
return Object.Create (Object.Boolean_Class, 0);
end if;
when Sup_Egal =>
if Object.Index'(Object.Get (Index_From => To)) >=
Object.Get (Index_From =>
Message.Get (Argument_From =>
This_Message)) then
return Object.Create (Object.Boolean_Class, 1);
else
return Object.Create (Object.Boolean_Class, 0);
end if;
when Inf =>
if Object.Index'(Object.Get (Index_From => To)) <
Object.Get (Index_From =>
Message.Get (Argument_From =>
This_Message)) then
return Object.Create (Object.Boolean_Class, 1);
else
return Object.Create (Object.Boolean_Class, 0);
end if;
when Inf_Egal =>
if Object.Index'(Object.Get (Index_From => To)) <=
Object.Get (Index_From =>
Message.Get (Argument_From =>
This_Message)) then
return Object.Create (Object.Boolean_Class, 1);
else
return Object.Create (Object.Boolean_Class, 0);
end if;
end case;
exception
when Constraint_Error =>
raise Bug_Report.Unknown_Binary_Message;
end;
else
raise Bug_Report.Integer_Bad_Type;
end if;
end Send;
function Send (This_Message : Message.Keyword; To : Object.Reference)
return Object.Reference is
type E_Message is (Fois, Repeter, Puissance);
Token : E_Message;
Mess : Message.Keyword := This_Message;
Unar : Message.Unary;
Kwd : Message.Keyword;
Val : Object.Tiny_String;
package Bs renames Bounded_String;
package Su renames String_Utilities;
begin
Bs.Copy (Val, Bs.Value ("Valeur"));
Message.Init (Mess);
declare
Result : Object.Reference;
Block : Object.Reference;
A, B : Object.Index;
use Object;
begin
Token := E_Message'Value (Bs.Image (Message.Get (Mess)));
case Token is
when Fois =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Block_Class then
Message.Put (This_Name => Val, Into => Unar);
for I in 1 .. Object.Get (Index_From => To) loop
Result := Class_Block.Send
(Unar, Message.Get
(Argument_From => Mess));
end loop;
if Object.Get (Index_From => To) < 1 then
return To;
else
return Result;
end if;
else
raise Bug_Report.Integer_Bad_Type;
end if;
when Repeter =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Block_Class then
Block := Message.Get (Argument_From => Mess);
Message.Next (Mess);
if Su.Equal (Bs.Image (Message.Get (Name_From => Mess)),
"a", True) then
A := Object.Get (Index_From => To);
B := Object.Get
(Index_From => Message.Get
(Argument_From => Mess));
if A < B then
for I in A .. B loop
Message.Free (This => Kwd);
Message.Put (This_Name => Val, Into => Kwd);
Message.Put (This_Argument =>
Create (Value => I),
Into => Kwd);
Result := Class_Block.Send (Kwd, Block);
end loop;
else
for I in reverse B .. A loop
Message.Free (This => Kwd);
Message.Put (This_Name => Val, Into => Kwd);
Message.Put (This_Argument =>
Create (Value => I),
Into => Kwd);
Result := Class_Block.Send (Kwd, Block);
end loop;
end if;
else
raise Bug_Report.Unknown_Keyword_Message;
end if;
return Result;
else
raise Bug_Report.Integer_Bad_Type;
end if;
when Puissance =>
if Object.Get (Class_From =>
Message.Get (Argument_From => Mess)) =
Object.Integer_Class then
return Create (Object.Index
(Integer (Object.Get
(Index_From => To)) **
Integer (Object.Get
(Index_From =>
Message.Get
(Argument_From =>
Mess)))));
else
raise Bug_Report.Integer_Bad_Type;
end if;
end case;
exception
when Constraint_Error =>
raise Bug_Report.Unknown_Keyword_Message;
end;
end Send;
function Create (Value : Object.Index := 0) return Object.Reference is
begin
return Object.Create (Object.Integer_Class, Value);
end Create;
procedure Put (An_Object : Object.Reference) is
begin
Class_Printer.Put ("Objet Entier { Valeur =>" &
Object.Index'Image (Object.Get (An_Object)) & " }");
Class_Printer.New_Line (2);
end Put;
end Class_Integer;
nblk1=10
nid=e
hdr6=1c
[0x00] rec0=24 rec1=00 rec2=01 rec3=02a
[0x01] rec0=17 rec1=00 rec2=07 rec3=034
[0x02] rec0=12 rec1=00 rec2=0b rec3=020
[0x03] rec0=0f rec1=00 rec2=0c rec3=074
[0x04] rec0=11 rec1=00 rec2=08 rec3=046
[0x05] rec0=14 rec1=00 rec2=04 rec3=04a
[0x06] rec0=13 rec1=00 rec2=09 rec3=036
[0x07] rec0=13 rec1=00 rec2=0a rec3=03c
[0x08] rec0=22 rec1=00 rec2=02 rec3=046
[0x09] rec0=16 rec1=00 rec2=0d rec3=028
[0x0a] rec0=13 rec1=00 rec2=0f rec3=05e
[0x0b] rec0=10 rec1=00 rec2=06 rec3=00c
[0x0c] rec0=14 rec1=00 rec2=03 rec3=06e
[0x0d] rec0=1d rec1=00 rec2=10 rec3=000
[0x0e] rec0=1d rec1=00 rec2=10 rec3=001
[0x0f] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x2153195a684e768e76dd8 0x42a00088462060003
Free Block Chain:
0xe: 0000 00 05 03 fc 80 0d 65 74 75 72 6e 20 52 65 73 75 ┆ eturn Resu┆
0x5: 0000 00 00 01 a1 80 28 20 20 20 20 20 20 72 61 69 73 ┆ ( rais┆