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

⟦5a85714e4⟧ Ada Source

    Length: 9216 (0x2400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Rpc_Conventions, seg_020bda, separate Rpc_Io

Derivation

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

with Lrm_Utilities;

separate (Rpc_Io)
package body Rpc_Conventions is

    function Formal_Name (Iter : Analysis.Parameter_Iterator) return String is
    begin
        return Analysis.Formals_Image (Iter);
    end Formal_Name;

    function Type_Name (Iter : Analysis.Parameter_Iterator) return String is
    begin
        return Analysis.Reference (Analysis.Formals_Type_Decl (Iter));
    end Type_Name;

    function Mode (Iter : Analysis.Parameter_Iterator) return String is
    begin
        case Analysis.Mode (Iter) is
            when Decls.Default_In_Parameter =>
                return "";
            when Decls.In_Parameter =>
                return "in ";
            when Decls.Out_Parameter =>
                return "out ";
            when Decls.In_Out_Parameter =>
                return "in out ";
            when Decls.Not_A_Parameter =>
                return "";
        end case;
    end Mode;

    function Is_Constrained (Type_Decl : Ada.Element) return Boolean is
        Type_Def : Ada.Element := Decls.Type_Specification (Type_Decl);
    begin
        case Types.Kind (Type_Def) is
            when Types.An_Array_Type_Definition =>
                return Types.Is_Constrained_Array (Type_Def);
            when Types.A_Record_Type_Definition =>
                return not (Types.Is_Discriminated (Type_Def));
            when others =>
                return True;
        end case;
    end Is_Constrained;

    function Is_Predefined (Type_Decl : Ada.Element) return Boolean is
        Type_Def : Ada.Element := Types.Ground_Type
                                     (Decls.Type_Specification (Type_Decl));
    begin
        return Types.Is_Predefined (Type_Def);
    end Is_Predefined;

    function Is_Duration (Type_Decl : Ada.Element) return Boolean is
    begin
        if Is_Predefined (Type_Decl) then
            case Types.Kind (Decls.Type_Specification (Type_Decl)) is
                when Types.A_Fixed_Type_Definition =>
                    if String_Utilities.Equal ("Duration",
                                               Decls.Name (Type_Decl)) then
                        return True;
                    else
                        return False;
                    end if;
                when others =>
                    return False;
            end case;
        else
            return False;
        end if;

    end Is_Duration;

    function Predefined_Interchange_Conversion
                (Type_Decl : Ada.Element) return String is
        Ground : Ada.Element := Types.Ground_Type
                                   (Decls.Type_Specification (Type_Decl));
    begin
        if Is_Predefined (Type_Decl) then
            case Types.Kind (Ground) is
                when Types.An_Integer_Type_Definition =>
                    return "Interchange.Integer";
                when Types.A_Float_Type_Definition =>
                    return "Interchange.Float";
                when Types.A_Fixed_Type_Definition =>
                    if Is_Duration (Type_Decl) then
                        return "Interchange.Convert";
                    else
                        return "";
                    end if;
                when others =>
                    return "";
            end case;
        else
            return "";
        end if;
    end Predefined_Interchange_Conversion;

    function Is_String (Type_Decl : Ada.Declaration) return Boolean is
    begin
        return Lrm_Utilities."=" (Lrm_Utilities.Get_Kind
                                     (Decls.Type_Specification (Type_Decl)),
                                  Lrm_Utilities.A_String_Type);

    end Is_String;

    function Make_Interchange_Call (Data_Name : String;
                                    Data_Conversion : String;
                                    Stream_Name : String := "Stream";
                                    Root_Name : String;
                                    Data_Type : Ada.Element;
                                    Kind : Interchange_Kind) return String is
        Call        : Unbounded.Variable_String;
        Predefined  : Boolean := Is_Predefined (Data_Type);
        Constrained : Boolean := Is_Constrained (Data_Type);

        function Convert return String is
        begin
            if Data_Conversion = "" then
                return Data_Name;
            else
                return Data_Conversion & "(" & Data_Name & ")";
            end if;
        end Convert;
    begin
        if Predefined then
            Unbounded.Append (Call, "Transport_Interchange");
        else
            Unbounded.Append (Call, Rpc_Names.Interchange_Package (Root_Name));
        end if;

        case Kind is
            when Put =>
                if Is_String (Data_Type) then
                    Unbounded.Append (Call,
                                      ".Put_String (Into => " & Stream_Name);
                else
                    Unbounded.Append (Call, ".Put (Into => " & Stream_Name);
                end if;
                Unbounded.Append (Call, ", Data => " & Convert & ");");

            when Get =>
                if Is_String (Data_Type) then
                    Unbounded.Append (Call,
                                      ".Get_String (From => " & Stream_Name);
                else
                    Unbounded.Append (Call, ".Get (From => " & Stream_Name);
                end if;

                if not Constrained then
                    Unbounded.Append (Call, ")");
                elsif Is_Duration (Data_Type) then
                    Unbounded.Append (Call, ", Data => " & Data_Name & ");");
                else
                    Unbounded.Append (Call, ", Data => " & Convert & ");");
                end if;
        end case;

        return Unbounded.Image (Call);
    end Make_Interchange_Call;

    function Return_Name (Type_Decl : Ada.Declaration) return String is
    begin
        return "return_" & Analysis.Name (Type_Decl);
    end Return_Name;
end Rpc_Conventions;

    nblk1=8
    nid=0
    hdr6=10
        [0x00] rec0=21 rec1=00 rec2=01 rec3=042
        [0x01] rec0=18 rec1=00 rec2=02 rec3=016
        [0x02] rec0=1a rec1=00 rec2=03 rec3=014
        [0x03] rec0=1a rec1=00 rec2=04 rec3=016
        [0x04] rec0=1a rec1=00 rec2=05 rec3=01a
        [0x05] rec0=00 rec1=00 rec2=08 rec3=010
        [0x06] rec0=18 rec1=00 rec2=06 rec3=008
        [0x07] rec0=07 rec1=00 rec2=07 rec3=001
    tail 0x2171d30ce838d457e82d5 0x42a00088462061e03