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

⟦63e093d7c⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Classbehavior, seg_00dc65, separate Expertsystem

Derivation

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

with Expertsystem, Instancecounter;

separate (Expertsystem)

package body Classbehavior is

    type Cellelement is
        record
            Cell : Element;
            Free : Boolean := True;
            Masked : Boolean := False;
        end record;

    type Eltarray is array (1 .. Taille) of Cellelement;

    type Classset is
        record
            Classarray : Eltarray;
            Count : Natural := 0;
        end record;

    Localclass : Idc := 1;
    Contents : Classset;
    Thevisiblecollection : Collection.Object;
    Thecompletecollection : Collection.Object;

    function Allocate (Initvalue : Element) return Expertsystem.Reference is
        Ref : Expertsystem.Reference;
    begin
        if Contents.Count + 1 = Contents.Classarray'Last then
            raise Classfull;
        end if;
        for I in Contents.Classarray'Range loop
            if Contents.Classarray (I).Free then
                Contents.Count := Contents.Count + 1;
                Contents.Classarray (I) :=
                   Cellelement'(Initvalue, False, False);
                Ref.Idobject := I;
                exit;
            end if;
        end loop;
        Ref.Idclass := Localclass;
        Ref.Date := Instancecounter.Newobject;
        Collection.Add (Thevisiblecollection, Ref);
        Collection.Add (Thecompletecollection, Ref);
        return Ref;
    end Allocate;

    procedure Allocate (Initvalue : Element) is
        R : Expertsystem.Reference;
    begin
        R := Allocate (Initvalue);
    end Allocate;

    procedure Dispose (Aref : Expertsystem.Reference) is
    begin
        if Aref.Idclass /= Localclass then
            raise Badclass;
        end if;
        if Contents.Classarray (Aref.Idobject).Free then
            raise Badreference;
        end if;
        Contents.Classarray (Aref.Idobject).Free := True;
        Contents.Classarray (Aref.Idobject).Masked := False;
        Contents.Count := Contents.Count - 1;
        Collection.Remove (Thevisiblecollection, Aref);
        Collection.Remove (Thecompletecollection, Aref);
    end Dispose;

    procedure Clear is
    begin
        for I in Contents.Classarray'Range loop
            Contents.Classarray (I).Free := True;
            Contents.Classarray (I).Masked := False;
        end loop;
        Collection.Clear (Thevisiblecollection);
        Collection.Clear (Thecompletecollection);
    end Clear;

    procedure Mask (Aref : Expertsystem.Reference) is
    begin
        if Aref.Idclass /= Localclass then
            raise Badclass;
        end if;
        if Contents.Classarray (Aref.Idobject).Free then
            raise Badreference;
        end if;
        if Contents.Classarray (Aref.Idobject).Masked = False then
            Contents.Classarray (Aref.Idobject).Masked := True;
            Collection.Update (Thecompletecollection, Aref);
            Collection.Remove (Thevisiblecollection, Aref);
        end if;
    end Mask;

    procedure Maskall is
    begin
        for I in Contents.Classarray'Range loop
            Contents.Classarray (I).Masked := True;
        end loop;
        Collection.Updateall (Thecompletecollection);
        Collection.Clear (Thevisiblecollection);
    end Maskall;

    procedure Unmask (Aref : Expertsystem.Reference) is
        Sameref : Expertsystem.Reference;
        Adate : Long_Integer;
    begin
        if Aref.Idclass /= Localclass then
            raise Badclass;
        end if;
        if Contents.Classarray (Aref.Idobject).Free then
            raise Badreference;
        end if;
        if Contents.Classarray (Aref.Idobject).Masked = True then
            Contents.Classarray (Aref.Idobject).Masked := False;
            Adate := Instancecounter.Newobject;
            Collection.Update (Thecompletecollection, Aref, Adate);
            Sameref := Aref;
            Sameref.Date := Adate;
            Collection.Add (Thevisiblecollection, Sameref);
        end if;
    end Unmask;

    procedure Unmaskall is
    begin
        for I in Contents.Classarray'Range loop
            Contents.Classarray (I).Masked := False;
        end loop;
        Collection.Updateall (Thecompletecollection);
        Thevisiblecollection := Thecompletecollection;
    end Unmaskall;

    function Instances return Collection.Object is
    begin
        return Thevisiblecollection;
    end Instances;

    function Allinstances return Collection.Object is
    begin
        return Thecompletecollection;
    end Allinstances;

    function Cardinality return Natural is
    begin
        return Contents.Count;
    end Cardinality;

    function Get (Aref : Expertsystem.Reference) return Element is
    begin
        if Aref.Idclass /= Localclass then
            raise Badclass;
        end if;
        if Contents.Classarray (Aref.Idobject).Free then
            raise Badreference;
        end if;
        return Contents.Classarray (Aref.Idobject).Cell;
    end Get;

    procedure Set (Aref : Expertsystem.Reference; Withvalue : Element) is
        Adate : Long_Integer;
    begin
        if Aref.Idclass /= Localclass then
            raise Badclass;
        end if;
        if Contents.Classarray (Aref.Idobject).Free then
            raise Badreference;
        end if;
        Contents.Classarray (Aref.Idobject).Cell := Withvalue;
        Adate := Instancecounter.Newobject;
        Collection.Update (Thecompletecollection, Aref, Adate);
        Collection.Update (Thevisiblecollection, Aref, Adate);
    end Set;

    function Name return Classname is
    begin
        return Surname;
    end Name;

    function Name (Aref : Expertsystem.Reference) return Objectname is
    begin
        return Refname (Aref);
    end Name;

begin
    Localclass := Instancecounter.Newclass (Surname);
end Classbehavior;

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=24 rec1=00 rec2=01 rec3=03e
        [0x01] rec0=1d rec1=00 rec2=02 rec3=062
        [0x02] rec0=1b rec1=00 rec2=03 rec3=012
        [0x03] rec0=1b rec1=00 rec2=04 rec3=038
        [0x04] rec0=23 rec1=00 rec2=05 rec3=02e
        [0x05] rec0=20 rec1=00 rec2=06 rec3=034
        [0x06] rec0=02 rec1=00 rec2=07 rec3=000
    tail 0x21509b2c2821a489e19d4 0x42a00088462060003