From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,550291bc2bbf5019
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2001-09-18 14:26:27 PST
Path: 
 archiver1.google.com!newsfeed.google.com!sn-xit-02!supernews.com!newsfeed.direct.ca!look.ca!newshub2.rdc1.sfba.home.com!news.home.com!news1.rdc1.sfba.home.com.POSTED!not-for-mail
From: tmoran@acm.org
Newsgroups: comp.lang.ada
Subject: Re: Multiple task bodies for one task type?
References: <3BA799F7.BE0EE6FD@adaworks.com>
X-Newsreader: Tom's custom newsreader
Message-ID: <6_Op7.20277$L%5.16274098@news1.rdc1.sfba.home.com>
Date: Tue, 18 Sep 2001 21:26:26 GMT
NNTP-Posting-Host: 24.7.82.199
X-Complaints-To: abuse@home.net
X-Trace: news1.rdc1.sfba.home.com 1000848386 24.7.82.199 (Tue,
 18 Sep 2001 14:26:26 PDT)
NNTP-Posting-Date: Tue, 18 Sep 2001 14:26:26 PDT
Organization: Excite@Home - The Leader in Broadband http://home.com/faster
Xref: archiver1.google.com comp.lang.ada:13167
Date: 2001-09-18T21:26:26+00:00
List-Id: <comp.lang.ada>

  Another approach is that "multiple bodies for the same
procedure spec" suggests tagged types.  Create a task with the
desired set of "entry"s, "select"s, loops, etc.  Give it an
access discriminant that points to a tagged type class.  Make
the changeable parts of the code do calls on primitive functions
of that tagged type.  That will make the task body's execution
dependent on its discriminant parameter.  Any time you want a
new task, of the same spec as the old one but executing new code
in its body, just create a new child of the tagged type with
new primitive procedures to be called by the task.
  If you want an array of these tasks, each with a different
discriminant, you'll of course need to make an array of pointers
to the task type.
  Here's a trivial, but working, example:
package root is  -- blanks to be filled in by actual code

  type task_bodies is abstract tagged null record;
  procedure entrya(t : task_bodies) is abstract;
  procedure continuea(t : task_bodies) is abstract;
  procedure entryb(t : task_bodies; i : in out integer) is abstract;
  procedure continueb(t : task_bodies) is abstract;
  procedure entryc(t : task_bodies; c : in character) is abstract;
  procedure continuec(t : task_bodies) is abstract;

  type task_body_access is access task_bodies'class;

end root;

with root;
package task_interface is    -- define the single task spec

  task type schizo(p : root.task_body_access) is
    entry a;
    entry b(i : in out integer);
    entry c(c : in character);
  end schizo;

end task_interface;

package body task_interface is  -- the common code of the task

  task body schizo is
  begin
    select
      accept a do
        root.entrya(p.all);
      end a;
      root.continuea(p.all);
    or
      accept b(i : in out integer) do
        root.entryb(p.all,i);
      end b;
      root.continueb(p.all);
    or
      accept c(c : in character) do
        root.entryc(p.all,c);
      end c;
      root.continuec(p.all);
    end select;
  end schizo;

end task_interface;

with root;
package test12 is   -- two different sets of body code

  type kind1 is new root.task_bodies with null record;
  procedure entrya(t : kind1);
  procedure continuea(t : kind1);
  procedure entryb(t : kind1; i : in out integer);
  procedure continueb(t : kind1);
  procedure entryc(t : kind1; c : in character);
  procedure continuec(t : kind1);

  type kind2 is new root.task_bodies with null record;
  procedure entrya(t : kind2);
  procedure continuea(t : kind2);
  procedure entryb(t : kind2; i : in out integer);
  procedure continueb(t : kind2);
  procedure entryc(t : kind2; c : in character);
  procedure continuec(t : kind2);
end test12;

with ada.text_io;
package body test12 is

  procedure entrya(t : kind1) is
  begin
    ada.text_io.put('1');
  end entrya;
  procedure continuea(t : kind1) is
  begin
    null;
  end continuea;
  procedure entryb(t : kind1; i : in out integer) is
  begin
    null;
  end entryb;
  procedure continueb(t : kind1) is
  begin
    null;
  end continueb;
  procedure entryc(t : kind1; c : in character) is
  begin
    null;
  end entryc;
  procedure continuec(t : kind1) is
  begin
    null;
  end continuec;

  procedure entrya(t : kind2) is
  begin
    ada.text_io.put('2');
  end entrya;
  procedure continuea(t : kind2) is
  begin
    null;
  end continuea;
  procedure entryb(t : kind2; i : in out integer) is
  begin
    null;
  end entryb;
  procedure continueb(t : kind2) is
  begin
    null;
  end continueb;
  procedure entryc(t : kind2; c : in character) is
  begin
    null;
  end entryc;
  procedure continuec(t : kind2) is
  begin
    null;
  end continuec;

end test12;

with root,
     task_interface,
     test12;
procedure test is

  type task_access is access all task_interface.schizo;
  worker : array(1 .. 4) of task_access;

  first_kind : root.task_body_access := new test12.kind1;
  second_kind : root.task_body_access := new test12.kind2;

begin
  -- start up array of tasks of different kinds
  worker(1) := new task_interface.schizo(first_kind);   -- kind 1
  worker(2) := new task_interface.schizo(second_kind);  --      2
  worker(3) := new task_interface.schizo(first_kind);   --      1
  worker(4) := new task_interface.schizo(first_kind);   --      1

  for i in worker'range loop   -- exercise the tasks
    worker(i).a;
  end loop;

end test;