Re: C/C++ programmer giving Ada95 a chance -- writing an emulator.

[Geoff Bull <geoff@research.canon.com.au>]

"James S. Rogers" wrote:
> 
> Ed Falis wrote in message ...
> >I guess what I don't understand about this conversation is why noone has
> >proposed the use of tagged types instead of manual procedure dispatching.
> 
> Although the original author of this thread used the term dispatching, his
> description of what he wants does not really want dispatching.
> 
> He wants to execute a procedure associated with a particular opcode value,
> not based upon a separate type. He also did not want to use any form of
> case statement to determine the procedure to execute. This rules out the
> use of a discriminated record.
> 
> The approach of a manually constructed dispatching table is valid in either
> C++ or Ada. The reason it is used in C++ is that he is not really using
> virtual functions there either. The C++ vtable will not work for him.
> 
> Show me how you will design a hierarchy of tagged types differentiated only
> by  values of discrete type. I have not yet seen that trick.
> 
> Jim Rogers

Here's one way to use dispatching on tagged types - but I still
need a "dispatch" table.
I don't think it is any clearer or better than my original.
The main loop, on a sparc with gnat 3.12p -gnatp -O3, is 9 instructions
instead of the 8 when using procedure access types - which would obviously
be insignificant in a real program.


with Ada.Text_IO; use  Ada.Text_IO;

procedure Example3 is

   package Foo is

      type Opcode is range 16#00# .. 16#FF#;

      type Op_Root is tagged null record;
      procedure Func (Op : Op_Root);

      subtype Op_U is Op_Root;
      type Op_00 is new Op_Root with null record;
      type Op_01 is new Op_Root with null record;
      type Op_02 is new Op_Root with null record;
      type Op_03 is new Op_Root with null record;

      procedure Func (Op : Op_00);
      procedure Func (Op : Op_01);
      procedure Func (Op : Op_02);
      procedure Func (Op : Op_03);

   end Foo;

   package body Foo is

      procedure Func (Op : Op_Root) is
      begin Put_Line ("undefined opcode"); end Func;

      procedure Func (Op : Op_00) is
      begin Put_Line ("opcode 00"); end Func;

      procedure Func (Op : Op_01) is
      begin Put_Line ("opcode 01"); end Func;

      procedure Func (Op : Op_02) is
      begin Put_Line ("opcode 02"); end Func;

      procedure Func (Op : Op_03) is
      begin Put_Line ("opcode 03"); end Func;

   end Foo;
   use Foo;

   OU : Op_U;
   O0 : Op_00;
   O1 : Op_01;
   O2 : Op_02;
   O3 : Op_03;

   Op_Table : array (Opcode) of Op_Root
    := (Op_Root (O0),
        Op_Root (O1),
        Op_Root (O2),
        Op_Root (O3),
        others => OU
        );

  Core : array (Natural range <>) of Opcode := (0, 1, 2, 3, 55);
  IR : Opcode;

begin

   for PA in Core'Range loop
      IR := Core (PA);
      Func (Op_Root'Class (Op_Table (IR)));
   end loop;

end Example3;