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

⟦4255aadc2⟧ Ada Source

    Length: 10240 (0x2800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Bloc_Class, seg_037815, seg_037bad, seg_038f42

Derivation

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

with Bounded_String;
with String_Utilities;  
with Error_Broadcaster;
package body Bloc_Class is




-- iterateur de la classe bloc_class

    procedure Init (Iter : out Iterator; Coll : in Collection) is
    begin
        Iter := Iterator'First;
    end Init;

    procedure Next (Iter : in out Iterator) is
    begin
        Iter := Iter + 1;
    end Next;

    function Done (Iter : in Iterator) return Boolean is
    begin
        return (Iterator'Last = Iter);
    end Done;

    function Value (Iter : in Iterator) return Index is
    begin
        return Iter;  
    end Value;
    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return String is
    begin
        return ("Bloc Numero: " &
                String_Utilities.Number_To_String (To_Object.Identity, 10, 2) &
                " Mon Bloc englobant: " &
                String_Utilities.Number_To_String
                   ((Bloc_Collection.Table (To_Object.Identity).
                     Enclosing.Identity), 10, 2));
    end Send;
    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return Object.Reference is
        Bloc_Node : Bloc.Node;
        Obj, Enclosing_Bloc : Object.Reference;

    begin
        Bloc_Node := Bloc_Collection.Table (To_Object.Identity).Node;
        Enclosing_Bloc := Current_Bloc;
        Current_Bloc := To_Object;
        Obj := Bloc.Interpret (Bloc_Node, The_Message);
        Current_Bloc := Enclosing_Bloc;
        return Obj;
    end Send;

    function Send (To_Object : Object.Reference;  
                   The_Argument : Object.Parameters.List)
                  return Object.Reference is
        Local_Argument : Object.Parameters.List := The_Argument;
        Bloc_Node : Bloc.Node;
        Obj, Enclosing_Bloc, Iteration_Object : Object.Reference;  
        The_Message : Object.Message;
    begin
        Bounded_String.Copy (The_Message, "valeur");
        Bloc_Node := Bloc_Collection.Table (To_Object.Identity).Node;

        Enclosing_Bloc := Current_Bloc;
        Current_Bloc := To_Object;
        if (String_Utilities.Equal
               (Bounded_String.Image
                   (Object.Parameters.Selector (Local_Argument)),
                "tantQueVrai:", True)) then
            Object.Parameters.Get (Local_Argument, Iteration_Object);
            while (Object.Send (To_Object, The_Message).Identity = 1) loop
                Obj := (Object.Send (Iteration_Object, The_Message));
            end loop;
            return Obj;
        elsif (String_Utilities.Equal
                  (Bounded_String.Image
                      (Object.Parameters.Selector (Local_Argument)),
                   "tantQueFaux:", True)) then
            Object.Parameters.Get (Local_Argument, Iteration_Object);
            while (Object.Send (To_Object, The_Message).Identity = 0) loop
                Obj := (Object.Send (Iteration_Object, The_Message));
            end loop;
            return Obj;
        else

            Bloc.Interpret (Bloc_Node, Local_Argument, Obj);
        end if;

        Current_Bloc := Enclosing_Bloc;
        return Obj;
    end Send;


    function Create (Value : Object.Message) return Object.Reference is
    begin
        Next (Bloc_Collection.Iter);
        return (Object.Tiny_Bloc, Bloc_Collection.Iter);
    end Create;

    procedure Set (Address : Bloc.Node) is
    begin
        Symbol.Create (Bloc_Collection.Table (Bloc_Collection.Iter).Table);
        Bloc_Collection.Table (Bloc_Collection.Iter) :=
           (Address, Bloc_Collection.Table (Bloc_Collection.Iter).Table,
            Current_Bloc);
        Current_Bloc := (Object.Tiny_Bloc, Bloc_Collection.Iter);
    end Set;

    procedure Close is
    begin
        Current_Bloc := Bloc_Collection.Table (Current_Bloc.Identity).Enclosing;
    end Close;
    function Already_Exist
                (Identifier : Object.Message; Bloc : Object.Reference)
                return Boolean is
        Item : Object.Reference;
    begin
        Item := Bloc;
        while ((not Symbol.Already_Exist
                       (Bounded_String.Image (Identifier),
                        Bloc_Collection.Table (Item.Identity).Table)) and
               (Item.Identity /= Bloc_Collection.Table (Item.Identity).
                                    Enclosing.Identity)) loop
            Item := Bloc_Collection.Table (Item.Identity).Enclosing;
        end loop;
        return Symbol.Already_Exist
                  (Bounded_String.Image (Identifier),
                   Bloc_Collection.Table (Item.Identity).Table);
    end Already_Exist;



    procedure Local_Put (Identifier : Object.Message) is
        Obj : Object.Reference;
    begin
        Symbol.Put (Bounded_String.Image (Identifier),
                    Bloc_Collection.Table (Current_Bloc.Identity).Table, Obj);
    end Local_Put;


    procedure Put (Identifier : Object.Message) is
        Obj : Object.Reference := (Object.Tiny_Void, 0);
    begin  
        if not Already_Exist (Identifier, Current_Bloc) then
            Symbol.Put
               (Bounded_String.Image (Identifier),
                Bloc_Collection.Table (Current_Bloc.Identity).Table, Obj);
        end if;  
    end Put;
    procedure Set (Identifier : Object.Message; Obj : Object.Reference) is
        Item : Object.Reference;

    begin
        Item := Current_Bloc;
        while (not Symbol.Already_Exist
                      (Bounded_String.Image (Identifier),
                       Bloc_Collection.Table (Item.Identity).Table)) and
              (Item.Identity /= Bloc_Collection.Table (Item.Identity).
                                   Enclosing.Identity) loop
            Item := Bloc_Collection.Table (Item.Identity).Enclosing;
        end loop;
        Symbol.Put (Bounded_String.Image (Identifier),
                    Bloc_Collection.Table (Item.Identity).Table, Obj);
    end Set;

    function Get (Identifier : Object.Message) return Object.Reference is
        Item : Object.Reference;

    begin
        Item := Current_Bloc;
        if (Already_Exist (Identifier, Current_Bloc)) then
            while (not Symbol.Already_Exist
                          (Bounded_String.Image (Identifier),
                           Bloc_Collection.Table (Item.Identity).Table)) and
                  (Item.Identity /= Bloc_Collection.Table (Item.Identity).
                                       Enclosing.Identity) loop
                Item := Bloc_Collection.Table (Item.Identity).Enclosing;
            end loop;
            return (Symbol.Get (Bounded_String.Image (Identifier),
                                Bloc_Collection.Table (Item.Identity).Table));
        else  
            raise Error_Broadcaster.Unknown_Variable;
        end if;
    exception
        when Error_Broadcaster.Unknown_Variable =>
            Error_Broadcaster.Unknownvariable (Identifier);
            raise Error_Broadcaster.Unknown_Variable;
    end Get;
begin
    Symbol.Create (Bloc_Collection.Table (0).Table);
    Bloc_Collection.Table (Bloc_Collection.Iter).Node := Bloc.Empty_Node;
    Current_Bloc := (Object.Tiny_Bloc, 0);
    Bloc_Collection.Table (Bloc_Collection.Iter).Enclosing := Current_Bloc;
    Bounded_String.Copy (Predifined_Symbol, "tortue");
    Local_Put (Predifined_Symbol);
    Set (Predifined_Symbol, (Object.Tiny_Turtle, 0));
    Bounded_String.Copy (Predifined_Symbol, "stylo");
    Local_Put (Predifined_Symbol);
    Set (Predifined_Symbol, (Object.Tiny_Pen, 0));
end Bloc_Class;

    nblk1=9
    nid=0
    hdr6=12
        [0x00] rec0=26 rec1=00 rec2=01 rec3=036
        [0x01] rec0=00 rec1=00 rec2=02 rec3=038
        [0x02] rec0=19 rec1=00 rec2=09 rec3=048
        [0x03] rec0=14 rec1=00 rec2=05 rec3=040
        [0x04] rec0=20 rec1=00 rec2=06 rec3=01c
        [0x05] rec0=18 rec1=00 rec2=03 rec3=070
        [0x06] rec0=19 rec1=00 rec2=08 rec3=030
        [0x07] rec0=16 rec1=00 rec2=04 rec3=004
        [0x08] rec0=11 rec1=00 rec2=07 rec3=001
    tail 0x21530c54e84e49bc4a32b 0x42a00088462060003