DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦c4fcca9de⟧ TextFile

    Length: 2210 (0x8a2)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Bounded_String;

package body Class_Block is

    function Send (This_Message : Object.Keyword; To : Object.Reference)
                  return Object.Reference is
        Mess : Object.Keyword := This_Message;
        Ident : Object.Unary := Block.Get_Ident (Table (Object.Get (To)).Node);
    begin
        Object.Init (This => Mess);
        Object.Init (This => Ident);
        while not Object.Is_Done (This_Message) loop
            Block.Put_Table (This_Object => Object.Get (Mess),
                             Named => Object.Get (Ident),
                             Into => Table (Object.Get (To)).Node);
            Object.Next (Mess);
            Object.Next (Ident);
        end loop;
        return Block.Interpret (N => Table (Object.Get (To)).Node);
    end Send;


    function Send (This_Message : Object.Binary; To : Object.Reference)
                  return Object.Reference is
    begin
        return Object.Void_Reference;
    end Send;

    function Send (This_Message : Object.Unary; To : Object.Reference)
                  return Object.Reference is
        type Message is (En_Texte, Valeur);

        Token : Message;

        package Bs renames Bounded_String;

    begin
        if Bs.Length (Object.Get (This_Message)) /= 0 then
            begin
                Token := Message'Value (Bs.Image (Object.Get (This_Message)));
                case Token is
                    when En_Texte =>
                        return To;
                    when Valeur =>
                        return Block.Interpret
                                  (N => Table (Object.Get (To)).Node);
                end case;
            exception
                when Constraint_Error =>
                    return Object.Void_Reference;
            end;
        end if;
    end Send;

    function Create (Node : Block.Node := Block.Empty_Node)
                    return Object.Reference is
        use Object;
    begin
        Last := Last + 1;
        Table (Last).Node := Node;
        return Object.Create (Class => Object.Block_Class, Object => Last);
    end Create;


    function How_Many return Object.Index is
    begin
        return Last;
    end How_Many;

end Class_Block;