|
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: 10240 (0x2800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body String_Class, seg_036b10, seg_037034
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with String_Utilities;
with Object;
with Error_Broadcaster;
with Bounded_String;
with String_Class;
package body String_Class is
type Unary_Message is (Talongueur, Entexte);
type Binary_Message is (Plus, Equal, Less, Greater, Different);
procedure Init (Iter : out Iterator; Coll : in Collection) is
begin
Iter := Iterator'First;
end Init;
procedure Next (Iter : in out Iterator) is
begin
Iter := Iter + 1;
end Next;
function Done (Iter : in Iterator) return Boolean is
begin
return (Iterator'Last = Iter);
end Done;
function Value (Iter : in Iterator) return Index is
begin
return Iter;
end Value;
function Create (Value : Object.Message) return Object.Reference is
begin
Next (String_Collection.Iter);
Bounded_String.Copy
(String_Collection.Table (String_Collection.Iter), Value);
return (Object.Tiny_String, String_Collection.Iter);
end Create;
function Translate_To_Binary_Message
(The_Message : Object.Message) return Binary_Message is
begin
if String_Utilities.Equal
(Bounded_String.Image (The_Message), "=", True) then
return (Equal);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), "<", True) then
return (Less);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), ">", True) then
return (Greater);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), "<>", True) then
return (Different);
end if;
if String_Utilities.Equal
(Bounded_String.Image (The_Message), "+", True) then
return (Plus);
end if;
if True then
raise Error_Broadcaster.Unknown_Binary_Message;
end if;
end Translate_To_Binary_Message;
function Send (To_Object : Object.Reference; The_Message : Object.Message)
return String is
Message : Unary_Message;
begin
Message := Unary_Message'Value (Bounded_String.Image (The_Message));
case Message is
when Entexte =>
return Bounded_String.Image
(String_Collection.Table (To_Object.Identity));
when Talongueur =>
return "";
end case;
end Send;
function Send (To_Object : Object.Reference; The_Message : Object.Message)
return Object.Reference is
Message : Unary_Message;
Obj : Object.Reference;
begin
Message := Unary_Message'Value (Bounded_String.Image (The_Message));
case Message is
when Talongueur =>
Obj.Identity := Bounded_String.Length (String_Collection.Table
(To_Object.Identity));
Obj.Class := Object.Tiny_Integer;
when Entexte =>
Obj.Identity := To_Object.Identity;
Obj := To_Object;
end case;
return (Obj);
exception
when Constraint_Error =>
raise Error_Broadcaster.Unknown_Unary_Message;
end Send;
function Send (To_Object : Object.Reference;
The_Message : Object.Message;
The_Argument : Object.Reference) return Object.Reference is
Message : Binary_Message;
Obj : Object.Reference;
begin
if Object.Class_Id'Pos (The_Argument.Class) =
Object.Class_Id'Pos (Object.Tiny_String) then
Message := Translate_To_Binary_Message (The_Message);
case Message is
when Plus =>
Obj := To_Object;
Bounded_String.Append
(String_Collection.Table (To_Object.Identity),
String_Collection.Table (The_Argument.Identity));
when Equal =>
Obj.Class := Object.Tiny_Boolean;
if String_Utilities.Equal
(Bounded_String.Image
(String_Collection.Table (To_Object.Identity)),
Bounded_String.Image
(String_Collection.Table
(The_Argument.Identity))) then
Obj.Identity := 1;
else
Obj.Identity := 0;
end if;
when Less =>
Obj.Class := Object.Tiny_Boolean;
if String_Utilities.Less_Than
(Bounded_String.Image
(String_Collection.Table (To_Object.Identity)),
Bounded_String.Image
(String_Collection.Table
(The_Argument.Identity))) then
Obj.Identity := 1;
else
Obj.Identity := 0;
end if;
when Greater =>
Obj.Class := Object.Tiny_Boolean;
if String_Utilities.Greater_Than
(Bounded_String.Image
(String_Collection.Table (To_Object.Identity)),
Bounded_String.Image
(String_Collection.Table
(The_Argument.Identity))) then
Obj.Identity := 1;
else
Obj.Identity := 0;
end if;
when Different =>
Obj.Class := Object.Tiny_Boolean;
if String_Utilities.Equal
(Bounded_String.Image
(String_Collection.Table (To_Object.Identity)),
Bounded_String.Image
(String_Collection.Table
(The_Argument.Identity))) then
Obj.Identity := 0;
else
Obj.Identity := 1;
end if;
end case;
else
raise Error_Broadcaster.String_Bad_Type;
end if;
return Obj;
exception
when Error_Broadcaster.Unknown_Binary_Message =>
raise Error_Broadcaster.String_Bad_Type;
when Constraint_Error =>
raise Error_Broadcaster.Tiny_String_Overflow;
end Send;
end String_Class;
nblk1=9
nid=8
hdr6=10
[0x00] rec0=24 rec1=00 rec2=01 rec3=042
[0x01] rec0=1d rec1=00 rec2=07 rec3=048
[0x02] rec0=18 rec1=00 rec2=05 rec3=086
[0x03] rec0=17 rec1=00 rec2=03 rec3=058
[0x04] rec0=15 rec1=00 rec2=06 rec3=034
[0x05] rec0=14 rec1=00 rec2=02 rec3=026
[0x06] rec0=1a rec1=00 rec2=04 rec3=006
[0x07] rec0=06 rec1=00 rec2=09 rec3=000
[0x08] rec0=90 rec1=4b rec2=80 rec3=004
tail 0x215302a2684e053a2b4b4 0x42a00088462060003
Free Block Chain:
0x8: 0000 00 00 00 18 80 15 54 72 61 6e 73 6c 61 74 65 5f ┆ Translate_┆