|
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: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Class_String, seg_0329a6
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Bounded_String;
with String_Utilities;
with Text_Io;
package body Class_String is
function Send (This_Message : Object.Unary; To : Object.Reference)
return Object.Reference is
type Message is (En_Texte, En_Majuscules, En_Minuscules,
Avec_Capitales, Ta_Longueur);
Token : Message;
package Bs renames Bounded_String;
package Su renames String_Utilities;
begin
if Bs.Length (Object.Get (This_Message)) /= 0 then
begin
Token := Message'Value (Bs.Image (Object.Get (This_Message)));
case Token is
when En_Texte =>
Text_Io.Put ("Objet String (");
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 (Bs.Image (Table (Object.Get (To))));
Text_Io.New_Line;
Text_Io.Put (" )");
Text_Io.New_Line (2);
when En_Majuscules =>
Table (Object.Get (To)) :=
Bs.Value (Su.Upper_Case
(Bs.Image (Table (Object.Get (To)))));
return To;
when En_Minuscules =>
Table (Object.Get (To)) :=
Bs.Value (Su.Lower_Case
(Bs.Image (Table (Object.Get (To)))));
return To;
when Avec_Capitales =>
Table (Object.Get (To)) :=
Bs.Value (Su.Capitalize
(Bs.Image (Table (Object.Get (To)))));
return To;
when Ta_Longueur =>
return Object.Create
(Class => Object.Integer_Class,
Object => Object.Index
(Bs.Length
(Table (Object.Get (To)))));
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, Sup, Inf, Sup_Egal, Inf_Egal, Egal);
Token : Message;
package Bs renames Bounded_String;
package Su renames String_Utilities;
begin
if Bs.Length (Object.Get (This_Message)) /= 0 then
declare
An_Object : Object.Reference := To;
Chaine : Object.Tiny_String;
begin
Token := Message'Value (Bs.Image (Object.Get (This_Message)));
case Token is
when Prendre =>
Table (Object.Get (To)) := Object.Get (This_Message);
return An_Object;
when Plus =>
Bs.Copy (Chaine, Bs.Image (Table (Object.Get (To))));
Bs.Append (Chaine, Bs.Image
(Object.Get (This_Message)));
return Class_String.Create (Chaine);
when Sup =>
if Bs.Image (Table (Object.Get (To))) >
Bs.Image (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 Bs.Image (Table (Object.Get (To))) <
Bs.Image (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 Bs.Image (Table (Object.Get (To))) >=
Bs.Image (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 Bs.Image (Table (Object.Get (To))) <=
Bs.Image (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 Egal =>
if Bs.Image (Table (Object.Get (To))) =
Bs.Image (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
begin
return Object.Void_Reference;
end Send;
function Create return Object.Reference is
use Object;
begin
Last := Last + 1;
return Object.Create (Class => Object.String_Class, Object => Last);
end Create;
function Create (Str : Object.Tiny_String) return Object.Reference is
use Object;
begin
Last := Last + 1;
Table (Last) := Str;
return Object.Create (Class => Object.String_Class, Object => Last);
end Create;
function How_Many return Object.Index is
begin
return Last;
end How_Many;
end Class_String;
nblk1=a
nid=3
hdr6=12
[0x00] rec0=1e rec1=00 rec2=01 rec3=010
[0x01] rec0=13 rec1=00 rec2=07 rec3=082
[0x02] rec0=1b rec1=00 rec2=02 rec3=072
[0x03] rec0=0c rec1=00 rec2=04 rec3=03c
[0x04] rec0=10 rec1=00 rec2=0a rec3=07c
[0x05] rec0=02 rec1=00 rec2=08 rec3=074
[0x06] rec0=11 rec1=00 rec2=06 rec3=034
[0x07] rec0=18 rec1=00 rec2=09 rec3=014
[0x08] rec0=1d rec1=00 rec2=05 rec3=000
[0x09] rec0=1d rec1=00 rec2=05 rec3=001
tail 0x2152b3e7284ca578e322e 0x42a00088462060003
Free Block Chain:
0x3: 0000 00 00 00 1a 80 17 20 20 20 42 73 2e 61 70 70 65 ┆ Bs.appe┆