⟦96c2b69ec⟧

E3 Source Code



with System;
with Screen_Io;
use Screen_Io;
package body First_Task is
    subtype Same_Ex is Ex;

    task Census is
        -- keeps track of the number of active exploring tasks.
        entry Update (Del : Integer);
    end Census;

    task body Census is
        Population : Integer := 1;
    begin
        loop
            select
                accept Update (Del : Integer) do
                    Population := Population + Del;
                    Putsn ("active tasks: ", Population, 1, 1);
                end Update;
            or
                terminate;
            end select;
        end loop;
    end Census;

    task body Ex is
        -- A new exploring task is created whenever an active exploring task
        -- finds an unexplored cell to the right or left of its current pos.
        -- Each such task has a pointer to itself and to its parent. When it
        -- reaches a dead end, it waits for a report from each son, and then
        -- reports in turn to its parent. The first task to read the goal re-
        -- ports success to its parent, and the successful path is retraced.


        Pos, New_Pos, Start_Pos : Position;
        Dir : Direction;
        Found : Boolean := False;
        Self, Pop : Explore;
        Progeny : Integer := 0;

        procedure Try_Turn (New_Dir : Direction) is
            -- see if path exists to right or left of current position.
            New_Pos : Position := Next_Pos (Pos, New_Dir);
            Son : Explore;
        begin
            if Open (New_Pos) then
                -- This test and the corresponding spawn should be a critical
                -- section. As it stands, the program is clearly erroneous,
                -- as  the shared variable -dist-  is being accessed
                -- without explicit synchronization.
                --  The algorithm works in any case, and the benign rare
                -- condition here is left to allow for greater parallelism,
                --  at the possible expense of additional (short-lived
                -- and superflouous) tasks.

                Son := new Same_Ex;
                Progeny := Progeny + 1;
                Census.Update (1);
                Son.Start (Pos, New_Dir, Son, Self);
            end if;
        end Try_Turn;

        procedure Retrace (There, Here : Position) is
            -- mark the path to success, in reverse.
            Bck : Direction := Back_Of (Dir);
            Pos : Position := There;
            Ch : Character;
        begin
            -- case System.System_Name is
            -- when System.Pc_Dos =>
            --         Ch := Ascii.Eot;
            --     when others =>
            Ch := '+';
            --  end case;
            while Pos /= Here loop
                Putcb (Ch, Pos.Row, Pos.Col);
                Pos := Next_Pos (Pos, Bck);
            end loop;
        end Retrace;

    begin
        -- upon creation, get identity from creator, and current location.
        accept Start (P : Position; D : Direction; Me, Parent : Explore) do
            Start_Pos := P;
            Pos := Next_Pos (P, D);
            Dir := D;
            Self := Me;
            Pop := Parent;
        end Start;

        Putc ('O', Pos.Row, Pos.Col);           -- hatch.
        Putc ('o', Pos.Row, Pos.Col);

        begin
            loop
                Mark (Pos, Dir);
                Dist (Pos.Row, Pos.Col) := 0;           -- we've been here.
                Try_Turn (Right_Of (Dir));               -- look both ways.
                Try_Turn (Left_Of (Dir));
                New_Pos := Next_Pos (Pos, Dir); -- and proceed.
                exit when New_Pos = Goal or not Open (New_Pos);
                Pos := New_Pos;
            end loop;
        exception
            when Storage_Error | Program_Error =>
                Puts ("unable to create new tasks. Try simpler maze.", 23, 1);
        end;

        if New_Pos = Goal then
            Putc (Ascii.Bel, Goal.Row, Goal.Col);        -- bingo!
            Found := True;
        else
            for I in 1 .. Progeny loop            -- anyone got there?
                accept Report (Success : Boolean; Where : Position) do
                    Found := Success;
                    Pos := Where;
                end Report;
                exit when Found;
            end loop;
        end if;
        if Found then
            Retrace (Pos, Start_Pos);
        end if;
        if Pop /= Self then                     -- not true for first task.
            if Pop'Callable then
                Pop.Report (Found, Start_Pos);
            end if;
        elsif not Found then
            Puts ("no  way from here to there      ", 23, 1);
        end if;

        Census.Update (-1);                     -- exit discretely.
    end Ex;

end First_Task;
DataMuseum.dk

Rational R1000/400

⟦96c2b69ec⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
