Re: procedural variables

[howard@esosun.css.gov (Howard Turner)]

	jduarte@ternes.ICS.UCI.EDU (J o s e D u a r t e ! ! !) writes:

		Since Ada does not provide for procedural variables, how
	do you/your associates handle the need for having a procedure or
	a task perform different duties depending on run-time circumstances?

Two methods come to mind immediately.  Since I am involved developing
an Ada/Xt and Ada/widget_set  I've had to solve this "problem".

The two methods are 

1) use tasks.  The prototype code for this is included at the end 
   of this posting.  This code has been compiled linked and run
   under several different hardware/compiler combinations and has
   always run correctly.

2) Call it from C.




howard
howard@esosun.css.gov

--------------------prototype code starts here

package subprogram_pointer is


  type func_ptr is private;
  procedure execute (the_obj : in func_ptr);

  generic
    type local_ptr is private;
    proc_id : in out local_ptr;
    with procedure user_specified;

  package proc_ptr is
  end proc_ptr;

private
  type func;
  type func_ptr is access func;

end subprogram_pointer;

--**************************
with text_io;
with unchecked_conversion;
package body Subprogram_Pointer is

    task type func is
       entry Handle;
    end func;

    task body func is
    begin
       loop
         select
           accept Handle do
             text_io.put_line ("in the wrong task");
           end Handle;
         or
           terminate;
         end select;
       end loop;
    end func;


    procedure execute (the_obj : in func_ptr) is

    begin
      the_obj.Handle;
    exception
      when others =>
         text_io.put_line("exception raised trying to execute a func_ptr");
         raise;
    end execute;



  package body proc_ptr is
    task type Local is
       entry Handle;
    end Local;

    type local_task_ptr is access Local;
    
    local_task : local_task_ptr;
 
    function to_func_ptr is new unchecked_conversion (
                 Source => local_task_ptr,
                 Target => Local_Ptr);

    task body Local is
    begin
       loop
         select
           accept Handle do
             text_io.put_line("in the Local task");
             User_Specified;
           end Handle;
         or
           terminate;
         end select;
       end loop;
    end Local;

  begin
    local_task := new Local;
    proc_id := to_func_ptr (local_task);

    exception
      when others =>
         text_io.put_line ("error starting the function pointer task");
         raise;

  end proc_ptr;

end Subprogram_Pointer;

--***************************

with text_io;
procedure the_callback is
begin
  text_io.put_line("it worked");
end the_callback;

--**************************

with the_callback;
with text_io;
with subprogram_pointer;

procedure Subprogram_Driver is

  cb1 : subprogram_pointer.func_ptr;
  package anypackage is new subprogram_pointer.proc_ptr
           (proc_id => cb1, user_specified => the_callback, 
            local_ptr => subprogram_pointer.func_ptr);


begin
  subprogram_pointer.execute(cb1);
exception
  when others =>
    text_io.put_line("exception caught in main routine, reraise");
    raise;
  
end Subprogram_Driver;