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

⟦3bbe84a02⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Make_Bottom_Left_Place_Free_Rule, seg_04bbe3, separate Decision_System.Fruit_Rule_Bundle

Derivation

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

separate (Decision_System.Fruit_Rule_Bundle)

package body Make_Bottom_Left_Place_Free_Rule is

    function Premiss return Fact_Queries is  
        use Fruit_Frames;
    begin
        return (Markers.Exist ((Name => Is_Equal (Model_Marker_Name))),
                Markers.Exist ((Name => Is_Equal (Selected_Block_Marker_Name))),
                Markers.Exist ((Name => Is_Equal (Top_Block_Marker_Name))),
                Markers.Absent ((Name => Is_Equal
                                            (Top_Copied_Model_Marker_Name))));
    end Premiss;


    procedure Action (Objects : Fact_Collection) is  
        use Visual_System;
        use Fruit_Frames;
        Model_Marker          : Fact_Name renames Objects (1);
        Selected_Block_Marker : Fact_Name renames Objects (2);
        Top_Block_Marker      : Fact_Name renames Objects (3);  
        Moving_Possible       : Boolean := True;


        procedure Move_To_Next_Place is
        begin
            Moving_Possible := True;
            Moving_Possible := Move (On_Table_Marker_Id, Left);
            if not Moving_Possible then
                -- go on upper level
                Moving_Possible := Move (On_Table_Marker_Id, Up);
                Moving_Possible := True;
                while Moving_Possible loop
                    Moving_Possible := Move (On_Table_Marker_Id, Right);
                end loop;
            end if;
        end Move_To_Next_Place;


        procedure Place_Table_Marker_On_The_Bottom_Right is
        begin
            Moving_Possible := True;
            while Moving_Possible loop
                Moving_Possible := Move (On_Table_Marker_Id, Down);
            end loop;
            Moving_Possible := True;
            while Moving_Possible loop
                Moving_Possible := Move (On_Table_Marker_Id, Right);
            end loop;
        end Place_Table_Marker_On_The_Bottom_Right;


        function Is_Table_Marker
                    (In_Column_Marked_With : Marker_Ids) return Boolean is
            Level     : Integer := 0;
            Moving    : Boolean := True;  
            In_Column : Boolean := False;
        begin  
            while Moving loop  
                if Is_Same (In_Column_Marked_With, On_Table_Marker_Id)  
                    then
                    In_Column := True;
                end if;
                Moving := Move (On_Table_Marker_Id, Down);  
                Level  := Level + 1;
            end loop;

            --replace on_table_marker on initial place
            for I in 1 .. Level - 1 loop
                Moving := Move (On_Table_Marker_Id, Up);
            end loop;

            return In_Column;
        end Is_Table_Marker;


        procedure Move_Top_Block_On_Free_Place is  
            Moving_Down : Boolean := True;
        begin  
            while (Get_Label (On_Table_Marker_Id) /= Null_Label) loop
                Move_To_Next_Place;
            end loop;

            -- is the free block in the column where the selected_block is ?
            if Is_Table_Marker (In_Column_Marked_With =>
                                   Top_Block_Marker_Id) then
                Move_To_Next_Place;
                Move_Top_Block_On_Free_Place;
            else
                Put_Block (Block_Marked_With_Id    => Top_Block_Marker_Id,
                           On_Marked_Place_With_Id => On_Table_Marker_Id);
                Markers.Delete (Top_Block_Marker);  
                Markers.Delete (Selected_Block_Marker);
            end if;
        end Move_Top_Block_On_Free_Place;


    begin
        -- to search a free place:place first table_marker on bottom right
        -- of the table
        Place_Table_Marker_On_The_Bottom_Right;
        Move_Top_Block_On_Free_Place;
        if Is_Same (Selected_Block_Marker_Id, Top_Block_Marker_Id) then
            -- when the selected block is on the top of a stack

            Markers.Delete (Selected_Block_Marker);
            Markers.Delete (Top_Block_Marker);

            Markers.Add ((Name => Top_Copied_Model_Marker_Name));

        else

            Markers.Delete (Top_Block_Marker);
        end if;
    end Action;


end Make_Bottom_Left_Place_Free_Rule;

    nblk1=7
    nid=2
    hdr6=c
        [0x00] rec0=1c rec1=00 rec2=01 rec3=008
        [0x01] rec0=1a rec1=00 rec2=06 rec3=036
        [0x02] rec0=1c rec1=00 rec2=05 rec3=012
        [0x03] rec0=00 rec1=00 rec2=03 rec3=010
        [0x04] rec0=17 rec1=00 rec2=07 rec3=05a
        [0x05] rec0=0f rec1=00 rec2=04 rec3=000
        [0x06] rec0=06 rec1=00 rec2=02 rec3=001
    tail 0x21750e8ae868949620f0b 0x42a00088462063c03
Free Block Chain:
  0x2: 0000  00 00 00 75 80 1d 72 73 2e 44 65 6c 65 74 65 20  ┆   u  rs.Delete ┆