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

⟦61e545d09⟧ Ada Source

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

Derivation

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

with Class_Integer;
with Class_Boolean;
with Class_String;
with Class_Block;
with Class_Pen;
with Class_Turtle;
with Class_Window;

package body Message is

    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 (Name_From : Keyword) return Object.Tiny_String is
    begin
        return Message_Name.Value (Name_From.Iter_Name);
    end Get;

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

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

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

    procedure Put (This_Argument : Object.Reference; Into : in out Keyword) is
    begin  
        Into.Argument := Message_Argument.Make (This_Argument, 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 (Name_From : Binary) return Object.Tiny_String is
    begin
        return Name_From.Name;
    end Get;

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

    procedure Put (This_Argument : Object.Reference;
                   Named : Object.Tiny_String;
                   Into : in out Binary) is
    begin
        Into.Name := Named;
        Into.Argument := This_Argument;
    end Put;

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

    procedure Put (This_Argument : Object.Reference; Into : out Binary) is
    begin
        Into.Argument := This_Argument;
    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_Name : Object.Tiny_String; Into : in out Unary) is
    begin
        Into.Name := Message_Name.Make (This_Name, Into.Name);
        Message_Name.Init (Into.Iter, Into.Name);
    end Put;

    function Get (Name_From : Unary) return Object.Tiny_String is
    begin  
        return Message_Name.Value (Name_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 : Object.Reference)
                  return Object.Reference is
    begin
        case Object.Get (Class_From => To) is
            when Object.Integer_Class =>
                return Class_Integer.Send (This_Message, To);
            when Object.Boolean_Class =>
                return Class_Boolean.Send (This_Message, To);
            when Object.String_Class =>
                return Class_String.Send (This_Message, To);
            when Object.Turtle_Class =>
                return Class_Turtle.Send (This_Message, To);
            when Object.Pen_Class =>
                return Class_Pen.Send (This_Message, To);
            when Object.Block_Class =>
                return Class_Block.Send (This_Message, To);
            when Object.Window_Class =>
                return Class_Window.Send (This_Message, To);
            when Object.Void_Class =>
                return To;
        end case;
    end Send;

    function Send (This_Message : Binary; To : Object.Reference)
                  return Object.Reference is
    begin
        case Object.Get (Class_From => To) is
            when Object.Integer_Class =>
                return Class_Integer.Send (This_Message, To);
            when Object.Boolean_Class =>
                return Class_Boolean.Send (This_Message, To);
            when Object.String_Class =>
                return Class_String.Send (This_Message, To);
            when Object.Turtle_Class =>
                return Class_String.Send (This_Message, To);
            when Object.Pen_Class =>
                return Class_Pen.Send (This_Message, To);
            when Object.Block_Class =>
                return Class_Block.Send (This_Message, To);
            when Object.Window_Class =>
                return Class_Window.Send (This_Message, To);
            when Object.Void_Class =>
                return To;
        end case;
    end Send;

    function Send (This_Message : Unary; To : Object.Reference)
                  return Object.Reference is
    begin
        case Object.Get (Class_From => To) is
            when Object.Integer_Class =>
                return Class_Integer.Send (This_Message, To);
            when Object.Boolean_Class =>
                return Class_Boolean.Send (This_Message, To);
            when Object.String_Class =>
                return Class_String.Send (This_Message, To);
            when Object.Turtle_Class =>
                return Class_Turtle.Send (This_Message, To);
            when Object.Pen_Class =>
                return Class_Pen.Send (This_Message, To);
            when Object.Block_Class =>
                return Class_Block.Send (This_Message, To);
            when Object.Window_Class =>
                return Class_Window.Send (This_Message, To);
            when Object.Void_Class =>
                return To;
        end case;
    end Send;
end Message;

    nblk1=b
    nid=6
    hdr6=14
        [0x00] rec0=27 rec1=00 rec2=01 rec3=012
        [0x01] rec0=02 rec1=00 rec2=08 rec3=026
        [0x02] rec0=1c rec1=00 rec2=05 rec3=05a
        [0x03] rec0=24 rec1=00 rec2=0b rec3=020
        [0x04] rec0=09 rec1=00 rec2=0a rec3=060
        [0x05] rec0=23 rec1=00 rec2=07 rec3=052
        [0x06] rec0=19 rec1=00 rec2=02 rec3=036
        [0x07] rec0=17 rec1=00 rec2=04 rec3=03e
        [0x08] rec0=17 rec1=00 rec2=09 rec3=048
        [0x09] rec0=07 rec1=00 rec2=03 rec3=000
        [0x0a] rec0=5b rec1=48 rec2=f0 rec3=000
    tail 0x217343dfa84e17e21ce15 0x42a00088462060003
Free Block Chain:
  0x6: 0000  00 00 00 0d 80 0a 67 75 6d 65 6e 74 2e 69 6e 69  ┆      gument.ini┆