如何在Ada中创建别名任务?

时间:2015-12-31 02:28:02

标签: ada multitasking

请考虑以下代码。如何通过MainTask类型使任务access具有可替换性并且可以访问?

 private with Ada.Text_IO;
 private with Interfaces.C;
 private with Interfaces.C.Strings;

 procedure Main is
    package Text_IO renames Ada.Text_IO;
    package C renames Interfaces.C;
    package CStrings renames Interfaces.C.Strings;

    function Puts(S : C.Char_Array) return C.Int;
    pragma Import (C, Puts, "puts");

    package WriteListener is
       type Object is task interface;

       procedure WriteDone (This : in Object; Result : C.Int) is abstract;
    end WriteListener;

    task type Writer (Receiver : access WriteListener.Object'Class) is
       entry Write (Str : in String);
    end Writer;


    task body Writer is
       Result : C.Int;
    begin
       loop
          select
             accept Write (Str : in String) do
                Result := Puts(C.To_C(Str));
             end Write;
             Receiver.WriteDone(Result);
          or
             terminate;
          end select;
       end loop;
    end Writer;

    task MainTask is new WriteListener.Object with
      entry WriteDone (Result : C.Int);
    end MainTask;

    task body MainTask is
       MyWriter :  Writer := new Writer (Receiver => MainTask'Access);
       R : C.Int;
    begin
       R := Puts(C.To_C("Starting asynchronous write"));

       MyWriter.Write("Hello, world!");

       EventLoop: loop
          declare
             TimeToExit : Boolean := False;
          begin

             accept WriteDone (Result : C.Int) do
                R := Puts(C.To_C("Asynchronous write completed"));
                TimeToExit := True;
             end WriteDone;

             exit EventLoop when TimeToExit;
          end;
       end loop EventLoop;
    end MainTask;
 begin
    null;
 end Main;

3 个答案:

答案 0 :(得分:2)

一个hacky解决方法是声明如下的任务类型。还有一种方法可以在没有堆分配的情况下构造编写器任务,但我不知道它的语法。

private with Ada.Text_IO;
private with Interfaces.C;
private with Interfaces.C.Strings;

procedure Main is
   package Text_IO renames Ada.Text_IO;
   package C renames Interfaces.C;
   package CStrings renames Interfaces.C.Strings;

   function Puts(S : C.Char_Array) return C.Int;
   pragma Import (C, Puts, "puts");

   package WriteListener is
      type Object is task interface;
      procedure WriteDone (This : in Object; Result : C.Int) is abstract;
   end WriteListener;

   task type Writer (Receiver : not null access WriteListener.Object'Class) is
      entry Write (Str : in String);
   end Writer;

   task body Writer is
      Result : C.Int;
   begin
      loop
         select
            accept Write (Str : in String) do
               Result := Puts(C.To_C(Str));
            end Write;
            Receiver.WriteDone(Result);
         or
            terminate;
         end select;
      end loop;
   end Writer;

   task type MainTask is new WriteListener.Object with
     entry WriteDone (Result : C.Int);
   end MainTask;

   MyMainTask : aliased MainTask;

   task body MainTask is
      MyWriter : not null access Writer := new Writer (Receiver => MyMainTask'Access);
      R : C.Int;
   begin
      R := Puts(C.To_C("Starting asynchronous write"));

      MyWriter.Write("Hello, world!");

      EventLoop: loop
          declare
             TimeToExit : Boolean := False;
          begin

             accept WriteDone (Result : C.Int) do
                R := Puts(C.To_C("Asynchronous write completed"));
                TimeToExit := True;
             end WriteDone;

             exit EventLoop when TimeToExit;
          end;
      end loop EventLoop;
   end MainTask;
begin
   null;
end Main;

答案 1 :(得分:2)

使Main_Task对象成为Main_Task_Type类型的别名对象。

也;不要在您的Writer任务上浪费堆分配。

还有一件事;每次调用时,请记得检查Puts的结果。

答案 2 :(得分:0)

有些人可能会觉得以这种方式实施模式会对语言产生一些折磨。但是,无论如何,如果需要一个别名 single_task_declaration 的别名任务单元,则没有,因为别名声明需要类型名称,而单个任务声明属于匿名类型。因此,所提出的解决方案使用了一种类型,并声明SomeMainTask属于该类型,并且具有别名。这实现了'Access

更广泛地解决要解决的问题,如果只有一个任务MainTask,那么所有调用者(有限多个)都可以简单地通过它的名称来引用它,从而避免指向它的需要。关键是 with 包含此单个任务的包,无论何时需要。

要考虑的另一个选择是通过ID互相引用的任务;例如,每个任务都可以将其ID提供给某个注册表。

但是如果由于其他原因需要某些命名类型的单例任务,则可以完成。一种方法是包装单个任务并在所有包装对象中使用 requeue 。但是,OTOH,如果这些任务应该实现同步接口,那么它们也需要成为任务,所以没有什么可以获得。

以下大纲重新使用原始程序来演示如何进行,尽管只强调单身,而不是强调沟通和控制的结构。更有可能产生类似Ada的解决方案的替代方案需要根据Ada的消息传递设施重新思考问题。

package Task_Singleton is
   type TaskWrapper is synchronized new WriteListener.Object with private;
private
   task type TaskWrapper is new WriteListener.Object with
      entry WriteDone (Result : C.Int);
   end TaskWrapper;
   task MainTask is new WriteListener.Object with
      entry WriteDone (Result : C.Int);
   end MainTask;
end Task_Singleton;

package body Task_Singleton is

   task body MainTask is
      R : C.Int;
   begin

   EventLoop: loop
         declare
            TimeToExit : Boolean := False;
         begin

            accept WriteDone (Result : C.Int) do
               R := Puts(C.To_C("Asynchronous write completed"));
               TimeToExit := True;
            end WriteDone;

            exit EventLoop when TimeToExit;
         end;
      end loop EventLoop;
   end MainTask;

   MainWrapper: aliased TaskWrapper;

   task body TaskWrapper is
      MyWriter :  Writer (Receiver => MainWrapper'Access);
      R : C.Int;
   begin
      R := Puts(C.To_C("Starting asynchronous write"));

      MyWriter.Write("Hello, world!");
      loop
         select
            accept WriteDone (Result : C.Int) do
               requeue MainTask.WriteDone;
            end WriteDone;
          or
            terminate;
         end select;
      end loop;

   end Taskwrapper;
end Task_Singleton;