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

⟦67398f640⟧ Ada Source

    Length: 12288 (0x3000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Message, seg_0330e1

Derivation

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

with Class_Integer, Class_Boolean, Class_String, Class_Block;
with Bounded_String;

package body Message is

    function Create (Class : E_Class; Object : Index) return Reference is
    begin
        return Reference'(Id_Class => Class, Id_Object => Object);
    end Create;

    function Get (From : Reference) return E_Class is
    begin
        return From.Id_Class;
    end Get;

    function Get (From : Reference) return Index is
    begin
        return From.Id_Object;
    end Get;

    procedure Put (This : E_Class; Into : out Reference) is
    begin
        Into.Id_Class := This;
    end Put;

    procedure Put (This : Index; Into : out Reference) is
    begin
        Into.Id_Object := This;
    end Put;

    procedure Init (This : in out Keyword) is
    begin
        Message_Name.Init (This.Iter_Name, This.Name);
        Message_Argument.Init (This.Iter_Arg, This.Argument);

    end Init;

    function Create return Keyword is
        Mess : Keyword;
    begin
        Init (Mess);
        return Mess;
    end Create;

    function Get (From : Keyword) return Tiny_String is
    begin
        return Message_Name.Value (From.Iter_Name);
    end Get;

    function Get (From : Keyword) return Reference is
    begin
        return Message_Argument.Value (From.Iter_Arg);
    end Get;

    procedure Put (This : Tiny_String;
                   And_This : Reference;
                   Into : in out Keyword) is
    begin
        Into.Name := Message_Name.Make (This, Into.Name);
        Into.Argument := Message_Argument.Make (And_This, Into.Argument);
        Init (Into);
    end Put;

    procedure Put (This : Tiny_String; Into : in out Keyword) is
    begin
        Into.Name := Message_Name.Make (This, Into.Name);
        Message_Name.Init (Into.Iter_Name, Into.Name);
    end Put;

    procedure Put (This : Reference; Into : in out Keyword) is
    begin  
        Into.Argument := Message_Argument.Make (This, Into.Argument);
        Message_Argument.Init (Into.Iter_Arg, Into.Argument);
    end Put;

    procedure Next (From : in out Keyword) is
    begin
        Message_Name.Next (From.Iter_Name);
        Message_Argument.Next (From.Iter_Arg);
    end Next;

    function Is_Done (This : Keyword) return Boolean is
    begin
        return Message_Name.Done (This.Iter_Name) or
                  Message_Argument.Done (This.Iter_Arg);
    end Is_Done;

    function Is_Done_Name (This : Keyword) return Boolean is
    begin
        return Message_Name.Done (This.Iter_Name);
    end Is_Done_Name;

    function Is_Done_Argument (This : Keyword) return Boolean is
    begin
        return Message_Argument.Done (This.Iter_Arg);
    end Is_Done_Argument;

    procedure Free (This : in out Keyword) is
    begin
        Message_Name.Free (This.Name);
        Message_Argument.Free (This.Argument);
    end Free;

    function Create return Binary is
        Mess : Binary;
    begin
        return Mess;
    end Create;

    function Get (From : Binary) return Tiny_String is
    begin
        return From.Name;
    end Get;

    function Get (From : Binary) return Reference is
    begin
        return From.Argument;
    end Get;

    procedure Put (This : Tiny_String; Into : out Binary) is
    begin
        Into.Name := This;
    end Put;

    procedure Put (This : Reference; Into : out Binary) is
    begin
        Into.Argument := This;
    end Put;

    procedure Init (This : in out Unary) is
    begin
        Message_Name.Init (This.Iter, This.Name);
    end Init;

    function Create return Unary is
        Message : Unary;
    begin
        Message_Name.Init (Message.Iter, Message.Name);
        return Message;
    end Create;

    procedure Put (This : Tiny_String; Into : in out Unary) is
    begin
        Into.Name := Message_Name.Make (This, Into.Name);
        Message_Name.Init (Into.Iter, Into.Name);
    end Put;

    function Get (From : Object.Unary) return Object.Tiny_String is
    begin  
        return Message_Name.Value (From.Iter);
    end Get;

    procedure Next (From : in out Unary) is
    begin
        Message_Name.Next (From.Iter);
    end Next;

    function Is_Done (This : Unary) return Boolean is
    begin
        return Message_Name.Done (This.Iter);
    end Is_Done;

    procedure Free (This : in out Unary) is
    begin
        Message_Name.Free (This.Name);
    end Free;

    function Send (This_Message : Keyword; To : Reference) return Reference is
        package Name renames Object.Message_Name;
        package Argument renames Object.Message_Argument;
    begin
        case To.Id_Class is
            when Integer_Class =>
                return Class_Integer.Send (This_Message, To);
            when Boolean_Class =>
                return Class_Boolean.Send (This_Message, To);
            when String_Class =>
                return Class_String.Send (This_Message, To);
            when Turtle_Class =>
                null;
            when Pen_Class =>
                null;
            when Block_Class =>
                null;
            when Void_Class =>
                return To;
        end case;
    end Send;

    function Send (This_Message : Binary; To : Reference) return Reference is
    begin
        case To.Id_Class is
            when Integer_Class =>
                return Class_Integer.Send (This_Message, To);
            when Boolean_Class =>
                return Class_Boolean.Send (This_Message, To);
            when String_Class =>
                return Class_String.Send (This_Message, To);
            when Turtle_Class =>
                null;
            when Pen_Class =>
                null;
            when Block_Class =>
                null;
            when Void_Class =>
                return To;
        end case;
    end Send;

    function Send (This_Message : Unary; To : Reference) return Reference is
    begin
        case To.Id_Class is
            when Integer_Class =>
                return Class_Integer.Send (This_Message, To);
            when Boolean_Class =>
                return Class_Boolean.Send (This_Message, To);
            when String_Class =>
                return Class_String.Send (This_Message, To);
            when Turtle_Class =>
                null;
            when Pen_Class =>
                null;
            when Block_Class =>
                return Class_Block.Send (This_Message, To);
            when Void_Class =>
                return To;
        end case;
    end Send;
end Message;

    nblk1=b
    nid=2
    hdr6=10
        [0x00] rec0=27 rec1=00 rec2=01 rec3=03c
        [0x01] rec0=01 rec1=00 rec2=0b rec3=026
        [0x02] rec0=21 rec1=00 rec2=09 rec3=042
        [0x03] rec0=20 rec1=00 rec2=08 rec3=034
        [0x04] rec0=28 rec1=00 rec2=04 rec3=072
        [0x05] rec0=20 rec1=00 rec2=07 rec3=066
        [0x06] rec0=1e rec1=00 rec2=0a rec3=00c
        [0x07] rec0=19 rec1=00 rec2=05 rec3=000
        [0x08] rec0=13 rec1=00 rec2=02 rec3=001
        [0x09] rec0=f9 rec1=09 rec2=79 rec3=114
        [0x0a] rec0=5b rec1=48 rec2=f0 rec3=000
    tail 0x2152bc05484cd4b513615 0x42a00088462060003
Free Block Chain:
  0x2: 0000  00 03 02 5a 80 0c 2e 49 64 5f 43 6c 61 73 73 20  ┆   Z  .Id_Class ┆
  0x3: 0000  00 06 00 cd 80 18 20 20 20 20 20 77 68 65 6e 20  ┆           when ┆
  0x6: 0000  00 00 00 0d 80 0a 67 75 6d 65 6e 74 2e 69 6e 69  ┆      gument.ini┆