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

⟦47c76a194⟧ Ada Source

    Length: 20480 (0x5000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Integer_Class, seg_037ee9

Derivation

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

with Arguments;
with Block_Class;
with Boolean_Class;
with Message;
with Msg_Report;
with Object;
with Random;
with Scanner;
with String_Class;
with String_Utilities;

package body Integer_Class is

    function Is_Equal_String
                (Str1 : String; Str2 : String; Ignore_Case : Boolean := True)
                return Boolean renames String_Utilities.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, Object3 : Object.Reference;

        Args : Arguments.List;

        Msg : Message.Selector := Message.Void_Selector;


    begin  
        Object1 := To_Object;

        Args := With_Arguments;

        case Arguments.How_Many (Args) is

            when 0 =>

                if Is_Equal_String (Message.Image (The_Message), "AuCarre") then

                    Msg_Report.Information ("Message is AuCarre ");
                    Result := Square (Object1);

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

                    Msg_Report.Information ("Message is AuCube ");
                    Result := Cubic (Object1);

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

                    Msg_Report.Information ("Message is EnTexte ");
                    Result := String_Class.Create (In_Text (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 := Object1 - Object2;


                elsif 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 := Object1 / Object2;

                elsif 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 := Object1 > Object2;

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

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

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

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

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

                    Msg_Report.Information ("Message is <>");  
                    Result := Is_Not_Equal (Object1, Object2);

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

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

                elsif Is_Equal_String
                         (Message.Format (The_Message), "Fois") then

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

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

                    raise Incorrect_Method;

                end if;


            when 2 =>

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

                if Is_Equal_String
                      (Message.Format (The_Message), "Arepeter") then
                    Msg_Report.Information ("Message is A: Repeter:");
                    Result := Repeat_To_Limit (Object1, Object2, Object3);

                else
                    Msg_Report.Interpret_Error
                       ("Incorrect 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;

    function Create (Value : Integer) return Object.Reference is  
    begin
        return Object.Create (Object.C_Integer, Value);
    end Create;

    function Delete (The_Integer : Object.Reference) return Object.Reference is  
    begin
        return Object.Void_Reference;
    end Delete;


    function In_Text (The_Integer : Object.Reference) return String is

    begin
        return Integer'Image (Object.Identificator (The_Integer));
    end In_Text;


    function Square (The_Integer : Object.Reference) return Object.Reference is
        Op_Result : Integer;
    begin
        Op_Result := Object.Identificator (The_Integer);
        Op_Result := Op_Result * Op_Result;
        return Object.Create (Object.C_Integer, Op_Result);

    end Square;


    function Cubic (The_Integer : Object.Reference) return Object.Reference is
        Op_Result : Integer;  
    begin  
        Op_Result := Object.Identificator (The_Integer);
        Op_Result := Op_Result * Op_Result * Op_Result;
        return Object.Create (Object.C_Integer, Op_Result);  
    end Cubic;


    function Repeat_To_Limit (The_Start : Object.Reference;
                              The_Limit : Object.Reference;
                              The_Block : Object.Reference)
                             return Object.Reference is

        Args_List : Arguments.List;  
        Argument, Result : Object.Reference;
        Msg : Message.Selector;

    begin  
        Message.Copy (Msg, Block_Class.Keyword_Evaluate_Msg);
        for I in Object.Identificator (The_Start) ..
                    Object.Identificator (The_Limit) loop
            Argument := Create (I);
            Args_List := Arguments.Void_Arguments;
            Arguments.Write (Args_List, Argument);

            Msg_Report.Information ("The_block is ");
            Msg_Report.Continue
               ("class = " & Object.Class'Image (Object.The_Class (The_Block)) &
                " ident = " & Integer'Image (Object.Identificator (The_Block)));  
            Msg_Report.Information ("Message is " & Message.Image (Msg));

            Arguments.Image (Args_List);

            Result := Block_Class.Send (The_Block, Msg, Args_List);
        end loop;

        return Result;
    end Repeat_To_Limit;


    function N_Time (Nb_Time : Object.Reference; The_Block : Object.Reference)
                    return Object.Reference is

        Msg : Message.Selector := Message.Void_Selector;
        I : Integer;
        Result : Object.Reference;

    begin

        Message.Copy (Msg, Block_Class.Evaluate_Msg);

        for I in 1 .. Object.Identificator (Nb_Time) loop  
            Result := Block_Class.Send (The_Block, Msg);
        end loop;

        return Result;

    end N_Time;


    function "+" (First_Integer : Object.Reference;
                  Second_Integer : Object.Reference) return Object.Reference is
        Op_Result : Integer;
    begin
        Op_Result := Object.Identificator (First_Integer) +
                        Object.Identificator (Second_Integer);
        return Object.Create (Object.C_Integer, Op_Result);
    end "+";


    function "-" (First_Integer : Object.Reference;
                  Second_Integer : Object.Reference) return Object.Reference is
        Op_Result : Integer;
    begin
        Op_Result := Object.Identificator (First_Integer) -
                        Object.Identificator (Second_Integer);
        return Object.Create (Object.C_Integer, Op_Result);
    end "-";


    function "*" (First_Integer : Object.Reference;
                  Second_Integer : Object.Reference) return Object.Reference is  
        Op_Result : Integer;
    begin
        Op_Result := Object.Identificator (First_Integer) *
                        Object.Identificator (Second_Integer);
        return Object.Create (Object.C_Integer, Op_Result);  
    end "*";


    function "/" (First_Integer : Object.Reference;
                  Second_Integer : Object.Reference) return Object.Reference is  
        Op_Result : Integer;
    begin
        Op_Result := Object.Identificator (First_Integer) /
                        Object.Identificator (Second_Integer);
        return Object.Create (Object.C_Integer, Op_Result);
    end "/";


    function "<" (First_Integer : Object.Reference;
                  Second_Integer : Object.Reference) return Object.Reference is
        Result : Object.Reference := Object.Void_Reference;

    begin  
        if Object.Identificator (First_Integer) <
           Object.Identificator (Second_Integer) then
            Result := Boolean_Class.Create (True);
        else
            Result := Boolean_Class.Create (False);
        end if;
        return Result;
    end "<";


    function ">" (First_Integer : Object.Reference;
                  Second_Integer : Object.Reference) return Object.Reference is  
        Result : Object.Reference := Object.Void_Reference;

    begin  
        if Object.Identificator (First_Integer) >
           Object.Identificator (Second_Integer) then
            Result := Boolean_Class.Create (True);
        else
            Result := Boolean_Class.Create (False);
        end if;
        return Result;
    end ">";


    function Is_Less_Or_Equal (First_Integer : Object.Reference;
                               Second_Integer : Object.Reference)
                              return Object.Reference is  
        Result : Object.Reference := Object.Void_Reference;

    begin  
        if Object.Identificator (First_Integer) <=
           Object.Identificator (Second_Integer) then
            Result := Boolean_Class.Create (True);
        else
            Result := Boolean_Class.Create (False);
        end if;
        return Result;
    end Is_Less_Or_Equal;


    function Is_Great_Or_Equal
                (First_Integer : Object.Reference;
                 Second_Integer : Object.Reference) return Object.Reference is  
        Result : Object.Reference := Object.Void_Reference;

    begin  
        if Object.Identificator (First_Integer) >=
           Object.Identificator (Second_Integer) then
            Result := Boolean_Class.Create (True);
        else
            Result := Boolean_Class.Create (False);
        end if;
        return Result;  
    end Is_Great_Or_Equal;


    function Is_Equal (First_Integer : Object.Reference;
                       Second_Integer : Object.Reference)
                      return Object.Reference is
        Result : Object.Reference := Object.Void_Reference;

    begin  
        if Object.Identificator (First_Integer) =
           Object.Identificator (Second_Integer) then
            Result := Boolean_Class.Create (True);
        else
            Result := Boolean_Class.Create (False);
        end if;
        return Result;  
    end Is_Equal;


    function Is_Not_Equal (First_Integer : Object.Reference;
                           Second_Integer : Object.Reference)
                          return Object.Reference is  
        Result : Object.Reference := Object.Void_Reference;

    begin  
        if Object.Identificator (First_Integer) /=
           Object.Identificator (Second_Integer) then
            Result := Boolean_Class.Create (True);
        else
            Result := Boolean_Class.Create (False);
        end if;
        return Result;  
    end Is_Not_Equal;

end Integer_Class;

    nblk1=13
    nid=5
    hdr6=22
        [0x00] rec0=28 rec1=00 rec2=01 rec3=05c
        [0x01] rec0=00 rec1=00 rec2=02 rec3=042
        [0x02] rec0=1e rec1=00 rec2=11 rec3=042
        [0x03] rec0=1c rec1=00 rec2=12 rec3=03c
        [0x04] rec0=1a rec1=00 rec2=03 rec3=01e
        [0x05] rec0=1c rec1=00 rec2=13 rec3=02c
        [0x06] rec0=1f rec1=00 rec2=10 rec3=03e
        [0x07] rec0=1d rec1=00 rec2=07 rec3=03a
        [0x08] rec0=1a rec1=00 rec2=0c rec3=028
        [0x09] rec0=03 rec1=00 rec2=0f rec3=016
        [0x0a] rec0=1f rec1=00 rec2=0a rec3=078
        [0x0b] rec0=03 rec1=00 rec2=08 rec3=042
        [0x0c] rec0=1b rec1=00 rec2=0d rec3=004
        [0x0d] rec0=1d rec1=00 rec2=06 rec3=06a
        [0x0e] rec0=1b rec1=00 rec2=04 rec3=010
        [0x0f] rec0=1d rec1=00 rec2=0e rec3=02e
        [0x10] rec0=0b rec1=00 rec2=09 rec3=000
        [0x11] rec0=1d rec1=00 rec2=0e rec3=02e
        [0x12] rec0=0b rec1=00 rec2=09 rec3=000
    tail 0x21531423a84e65104b484 0x42a00088462060003
Free Block Chain:
  0x5: 0000  00 0b 00 04 00 01 20 01 3d 3e 04 00 3e 20 20 20  ┆        =>  >   ┆
  0xb: 0000  00 00 00 2c 00 19 20 20 20 20 20 20 20 20 20 20  ┆   ,            ┆