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 - metrics - download

⟦e757af00f⟧ Ada Source

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

Derivation

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

with Object, String_Utilities, Bounded_String, Scanner,
     Msg_Report, Integer_Class, Boolean_Class;
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 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 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 First_Free return Natural is
        Pos : Natural;

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

    exception

        when others =>
            raise Instance_Table_Full;

    end First_Free;


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

        type Unary_Msg is (Capitalise, Tataille, Enmajuscule, Enminuscule);

        type Binary_Msg is (Plus, Equal);

        Result, Object1, Object2 : Object.Reference;

        Args : Arguments.List;

        Msg : Message.Selector := Message.Void_Selector;

        An_Unary_Msg : Unary_Msg;
        A_Binary_Msg : Binary_Msg;

    begin

        Object1 := To_Object;

        Args := With_Arguments;

        case Arguments.How_Many (Args) is

            when 0 =>

                An_Unary_Msg := Unary_Msg'Value (Message.Image (The_Message));

                case An_Unary_Msg is

                    when Capitalise =>
                        Msg_Report.Information ("message is Capitalise ");
                        Result := Capitalize (Object1);

                    when Tataille =>
                        Msg_Report.Information ("message is tataille ");
                        Result := Integer_Class.Create
                                     (Integer (Size (Object1)));
                    when Enmajuscule =>
                        Msg_Report.Information ("message is enmajuscule ");
                        Result := Upper_Case (Object1);

                    when Enminuscule =>
                        Msg_Report.Information ("message is enminuscule ");
                        Result := Lower_Case (Object1);

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

                        raise Incorrect_Method;
                end case;

            when 1 =>

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

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

                    Msg_Report.Information ("Message is +");  
                    A_Binary_Msg := Plus;

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

                    Msg_Report.Information ("Message is =");  
                    A_Binary_Msg := Equal;

                end if;


                case A_Binary_Msg is

                    when Plus =>  
                        Result := Object1 + Object2;

                    when Equal =>  
                        Result := Is_Equal (Object1, Object2);

                    when others =>
                        Msg_Report.Interpret_Error
                           ("Incorrect binary method " &
                            Message.Image (The_Message) &
                            " for object " & In_Text (Object1));
                        raise Incorrect_Method;

                end case;

            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;


    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;
end String_Class;

    nblk1=c
    nid=b
    hdr6=16
        [0x00] rec0=1e rec1=00 rec2=01 rec3=070
        [0x01] rec0=09 rec1=00 rec2=03 rec3=062
        [0x02] rec0=27 rec1=00 rec2=04 rec3=07a
        [0x03] rec0=23 rec1=00 rec2=08 rec3=06c
        [0x04] rec0=02 rec1=00 rec2=0a rec3=000
        [0x05] rec0=1b rec1=00 rec2=02 rec3=000
        [0x06] rec0=1f rec1=00 rec2=06 rec3=014
        [0x07] rec0=23 rec1=00 rec2=07 rec3=026
        [0x08] rec0=1f rec1=00 rec2=09 rec3=024
        [0x09] rec0=1e rec1=00 rec2=0c rec3=004
        [0x0a] rec0=0a rec1=00 rec2=05 rec3=000
        [0x0b] rec0=7e rec1=00 rec2=00 rec3=000
    tail 0x2152e41de84d952ac3cb0 0x42a00088462060003
Free Block Chain:
  0xb: 0000  00 00 00 41 80 0a 74 72 69 6e 67 29 29 3b 20 20  ┆   A  tring));  ┆