DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦82504373e⟧ Ada Source

    Length: 13312 (0x3400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body String_Class, seg_037f25, seg_038ad6

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

with Boolean_Class;
with Bounded_String;
with Integer_Class;
with Msg_Report;
with Object;
with Scanner;
with String_Utilities;


package body String_Class is

    function Bs_Image (A_String : Scanner.B_String) return String
        renames Bounded_String.Image;

    procedure Bs_Init (A_String : in out Scanner.B_String)
        renames Bounded_String.Free;

    procedure Bs_Copy (A_String : in out Scanner.B_String; A_Value : String)
        renames Bounded_String.Copy;

    procedure Bs_Cat (Target : in out Scanner.B_String;
                      Source : Scanner.B_String) renames Bounded_String.Append;

    function Bs_Length (A_String : Scanner.B_String) return Natural
        renames Bounded_String.Length;


    function Is_Equal_String
                (Str1 : String; Str2 : String; Ignore_Case : Boolean := True)
                return Boolean renames String_Utilities.Equal;

    function Su_Lower (A_String : String) return String
        renames String_Utilities.Lower_Case;

    function Su_Upper (A_String : String) return String
        renames String_Utilities.Upper_Case;

    function Su_Capitalize (A_String : String) return String
        renames String_Utilities.Capitalize;


    Max : constant := 100;

    Instance_Table : array (1 .. Max) of Struct_Table;


    function First_Free return Natural is
        Pos : Natural := 0;

    begin
        for I in Instance_Table'Range loop
            if Instance_Table (I).Indic = Unused then
                Pos := I;
                exit;
            end if;
        end loop;

        if Pos /= 0 then
            return Pos;
        else  
            Msg_Report.Interpret_Error ("sorry, string instance table is full");
            raise Instance_Table_Full;
        end if;

    end First_Free;


    function Create (Value : String) return Object.Reference is
        Pos : Natural;  
        A_String : Scanner.B_String;
        The_Class : Object.Class := Object.C_String;

    begin  
        Bs_Init (A_String);
        Bs_Copy (A_String, Value);

        Pos := First_Free;
        Instance_Table (Pos).Indic := Used;
        Instance_Table (Pos).Value := A_String;  
        return Object.Create (The_Class, Pos);  
    end Create;


    function Delete (The_String : Object.Reference) return Object.Reference is  
    begin  
        Instance_Table (Object.Identificator (The_String)).Indic := Unused;
        return Object.Void_Reference;
    end Delete;


    function Size (The_String : Object.Reference) return Natural is  
    begin
        return Bs_Length
                  (Instance_Table (Object.Identificator (The_String)).Value);
    end Size;


    function In_Text (The_String : Object.Reference) return String is  
    begin
        return Bs_Image
                  (Instance_Table (Object.Identificator (The_String)).Value);
    end In_Text;


    function Lower_Case (The_String : Object.Reference)
                        return Object.Reference is
        Result : Object.Reference;

    begin  
        Result := Delete (The_String);
        Result :=
           Create (Su_Lower
                      (Bs_Image
                          (Instance_Table (Object.Identificator (The_String)).
                           Value)));
        return Result;
    end Lower_Case;


    function Upper_Case (The_String : Object.Reference)
                        return Object.Reference is
        Result : Object.Reference;
    begin  
        Result := Delete (The_String);
        Result :=
           Create (Su_Upper
                      (Bs_Image
                          (Instance_Table (Object.Identificator (The_String)).
                           Value)));
        return Result;  
    end Upper_Case;


    function Capitalize (The_String : Object.Reference)
                        return Object.Reference is
        Result : Object.Reference;
    begin  
        Result := Delete (The_String);
        Result :=
           Create (Su_Capitalize
                      (Bs_Image
                          (Instance_Table (Object.Identificator (The_String)).
                           Value)));
        return Result;
    end Capitalize;



    function "+" (First_String : Object.Reference;
                  Second_String : Object.Reference) return Object.Reference is  
        Source, Target : Scanner.B_String;
        Result : Object.Reference;

    begin  
        Source := Instance_Table (Object.Identificator (Second_String)).Value;
        Target := Instance_Table (Object.Identificator (First_String)).Value;

        Bs_Cat (Target, Source);
        Result := Delete (First_String);
        Result := Create (Bs_Image (Target));
        return Result;
    end "+";


    function Is_Equal (First_String : Object.Reference;
                       Second_String : Object.Reference)
                      return Object.Reference is  
    begin  
        return Boolean_Class.Create
                  (Bs_Image
                      (Instance_Table (Object.Identificator (First_String)).
                       Value) =
                   Bs_Image
                      (Instance_Table (Object.Identificator (Second_String)).
                       Value));  
    end Is_Equal;


    function Send (To_Object : Object.Reference;
                   The_Message : Message.Selector;
                   With_Arguments : Arguments.List := Arguments.Void_Arguments)
                  return Object.Reference is

        Result, Object1, Object2 : Object.Reference;

        Args : Arguments.List;

    begin

        Object1 := To_Object;

        Args := With_Arguments;

        case Arguments.How_Many (Args) is

            when 0 =>

                if Is_Equal_String
                      (Message.Image (The_Message), "Capitalise") then
                    Msg_Report.Information ("message is Capitalise ");
                    Result := Capitalize (Object1);

                elsif Is_Equal_String
                         (Message.Image (The_Message), "TaTaille") then
                    Msg_Report.Information ("message is TaTaille ");
                    Result := Integer_Class.Create (Integer (Size (Object1)));

                elsif Is_Equal_String
                         (Message.Image (The_Message), "EnMajuscule") then

                    Msg_Report.Information ("message is enmajuscule ");
                    Result := Upper_Case (Object1);

                elsif Is_Equal_String
                         (Message.Image (The_Message), "EnMinuscule") then

                    Msg_Report.Information ("message is enminuscule ");
                    Result := Lower_Case (Object1);
                else


                    Msg_Report.Interpret_Error
                       ("Incorrect unary method " &
                        Message.Image (The_Message) &
                        " for object " & In_Text (Object1));

                    raise Incorrect_Method;
                end if;
            when 1 =>

                Arguments.First (Args);
                Arguments.Read (Args, Object2);

                if Message.Image (The_Message) = "+" then

                    Msg_Report.Information ("Message is +");  
                    Result := Object1 + Object2;

                elsif Message.Image (The_Message) = "=" then

                    Msg_Report.Information ("Message is =");
                    Result := Is_Equal (Object1, Object2);

                else
                    Msg_Report.Interpret_Error
                       ("Incorrect binary method " &
                        Message.Image (The_Message) &
                        " for object " & In_Text (Object1));
                    raise Incorrect_Method;  
                end if;


            when others =>

                Msg_Report.Interpret_Error
                   ("Incorrect nb of arguments for method " &
                    Message.Image (The_Message) &
                    " to object " & In_Text (Object1));
                raise Incorrect_Nb_Args;

        end case;

        return Result;
    end Send;

end String_Class;

    nblk1=c
    nid=6
    hdr6=14
        [0x00] rec0=21 rec1=00 rec2=01 rec3=06e
        [0x01] rec0=26 rec1=00 rec2=07 rec3=032
        [0x02] rec0=01 rec1=00 rec2=08 rec3=016
        [0x03] rec0=22 rec1=00 rec2=04 rec3=018
        [0x04] rec0=1e rec1=00 rec2=03 rec3=05c
        [0x05] rec0=1f rec1=00 rec2=0a rec3=030
        [0x06] rec0=20 rec1=00 rec2=02 rec3=012
        [0x07] rec0=15 rec1=00 rec2=0c rec3=024
        [0x08] rec0=1d rec1=00 rec2=09 rec3=03a
        [0x09] rec0=16 rec1=00 rec2=05 rec3=000
        [0x0a] rec0=0a rec1=00 rec2=05 rec3=000
        [0x0b] rec0=7e rec1=00 rec2=00 rec3=000
    tail 0x21531491484e663e91004 0x42a00088462060003
Free Block Chain:
  0x6: 0000  00 0b 01 3a 80 19 73 20 53 74 72 69 6e 67 5f 55  ┆   :  s String_U┆
  0xb: 0000  00 00 00 41 80 0a 74 72 69 6e 67 29 29 3b 20 20  ┆   A  tring));  ┆