|
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_┆