Re: Ada --> C Translation, was: Win CE target

[stt@houdini.camb.inmet.com (Tucker Taft)]

dewarr@my-dejanews.com wrote:
[...]
> Some of the trouble areas in compiling into C are
> 
>   1. Arithmetic overflow checks, especially in complex
>      expressions, which have to be broken down into steps
>      or written in prefix notation.
> 
>   2. Nested procedures, and particularly nested procedures
>      with complex local declarations.
> 
>   3. Subunits (hard to do anything other than create a huge
>      source in which the subunits are substituted).
> 
>   4. Exceptions
> 
[...]
> I will say for the record, that, according to MY definition
> of readability, it is not possible to translate Ada 95 into
> readable C in all cases.

Stefan Helfert (helfert@galileo.mpi-hd.mpg.de) wrote:

: Clearly this is a statement that you cannot argue with.  

Nevertheless, it is possible to "compile" all of Ada 95 to C, 
which can be useful for using Ada on a target lacking a "full-up"
Ada compiler, and it is possible to "translate" much of Ada 95 to 
reasonably readable C, which can ease certain kinds of reuse, and
can be used to satisfy certain clients' arbitrary requirements for C.

For what that's worth...

As an example of reasonably readable C, I have appended a translation
of a simple priority-heap package, where the automated translator did its 
best to preserve comments, Ada names, etc. in the generated C.  Note that
constraint checks have been suppressed in this translation, to avoid
offending the sensibilities of C programmers ;-).

The original Ada is appended at the end.

: Stefan Helfert

--
-Tucker Taft   stt@inmet.com   http://www.inmet.com/~stt/
Intermetrics, Inc.  Burlington, MA  USA
An AverStar Company

----------- prio_heap_pkg.spc.h ---------

#ifndef __prio_heap_pkg_spc_h__
#define __prio_heap_pkg_spc_h__


#include "standard.ada.h"

typedef uint8 Prio_heap_pkg_Prioritynumber;


extern void  Prio_heap_pkg_Add_prio(Prio_heap_pkg_Prioritynumber 
  Prio_To_Add); /* | Add new prio to prio heap */


extern void  Prio_heap_pkg_Remove_top_prio();
  /* | Remove top priority from prio heap */


extern void  Prio_heap_pkg_Print_prio_heap();
  /* | Print all priorities in priority heap, */
/*| in priority order. */

/**
 *| Overview
 *| This package maintains a "binary heap" of priorities
 *| allowing fast access to the highest priority in the heap.
 **/


#endif /* prio_heap_pkg.spc.h */

----------- prio_heap_pkg.bdy.h ---------

#ifndef __prio_heap_pkg_bdy_h__
#define __prio_heap_pkg_bdy_h__


#include "standard.ada.h"

#include "prio_heap_pkg.spc.h"


/**
 *| Overview
 *| This package maintains a "binary heap" of priorities
 *| allowing fast access to the highest priority in the heap.
 **/
#define Prio_heap_pkg__Min_prio ((Prio_heap_pkg_Prioritynumber)(0))
/*| Lowest priority supported. */


#define Prio_heap_pkg__Num_prio ((Universal_integer)(255 - 0+1))
/*| Number of priorities supported */

typedef uint16 Prio_heap_pkg__Prio_heap_count;
/**
 *| type for count of items in prio heap
 *| One extra so may always assume have 2 or 0 children (see
 *| Remove_Prio below).
 **/

typedef Prio_heap_pkg__Prio_heap_count Prio_heap_pkg__Prio_heap_index;
/*| subtype for index into prio heap */


extern uint8 Prio_heap_pkg__Prio_heap[257];
/**
 *| List of priorities which might have non-empty task queue.
 *| This list is organized as a "binary heap" where
 *| Prio_Heap(n/2) > Prio_Heap(n) for n in 2..Num_In_Prio_Heap.
 *| Initialize to Min_Prio to simplify Remove_Prio algorithm.
 **/


extern Prio_heap_pkg__Prio_heap_count Prio_heap_pkg__Num_in_prio_heap;
/*| Count of items in prio heap */


extern Boolean Prio_heap_pkg__In_prio_heap[256];
/*| Indication for each priority whether in prio heap */

/*| Highest priority which might have non-empty queue */



extern void  Prio_heap_pkg__Print_prio_list
  (Prio_heap_pkg__Prio_heap_index Parent);
  /* | Print all priorities in heap */
/*| in priority order, starting at given slot */



#endif /* prio_heap_pkg.bdy.h */

----------- prio_heap_pkg.bdy.c ---------

#include "standard.h"
#include "prio_heap_pkg.bdy.h"


/**
 *| Overview
 *| This package maintains a "binary heap" of priorities
 *| allowing fast access to the highest priority in the heap.
 **/
uint8 Prio_heap_pkg__Prio_heap[257] = {(uint8 )(int32 )
  Prio_heap_pkg__Min_prio, (uint8 )(int32 )Prio_heap_pkg__Min_prio, (
  uint8 )(int32 )Prio_heap_pkg__Min_prio, ... 
 
 [... elided lots of repeats ...]

  Prio_heap_pkg__Min_prio, (uint8 )(int32 )Prio_heap_pkg__Min_prio};
/**
 *| List of priorities which might have non-empty task queue.
 *| This list is organized as a "binary heap" where
 *| Prio_Heap(n/2) > Prio_Heap(n) for n in 2..Num_In_Prio_Heap.
 *| Initialize to Min_Prio to simplify Remove_Prio algorithm.
 **/

Prio_heap_pkg__Prio_heap_count Prio_heap_pkg__Num_in_prio_heap = {0};
/*| Count of items in prio heap */

Boolean Prio_heap_pkg__In_prio_heap[256] = {False, False, False, False, 
  False, False, False, False, False, False, False, False, False, False, 

 [... elided lots of repeats ...]

  False, False, False, False, False, False, False, False, False, False, 
  False, False};
/*| Indication for each priority whether in prio heap */

/*| Highest priority which might have non-empty queue */

void  Prio_heap_pkg_Add_prio(
    /*| Add new prio to prio heap */
    Prio_heap_pkg_Prioritynumber Prio_to_add
)
{
    /**
     *| Algorithm
     *| Add new prio to end of heap, then "sift" it up,
     *| until binary heap condition is restored
     *| (i.e., prio_heap(n) > prio_heap(2n),prio_heap(2n+1))
     **/

    Prio_heap_pkg__Prio_heap_index Parent;
    Prio_heap_pkg__Prio_heap_index Child;




    Prio_heap_pkg__Num_in_prio_heap = (uint16 )((int32 )
      Prio_heap_pkg__Num_in_prio_heap+1);

    /* Start at end of heap */
    Child = (uint16 )(int32 )Prio_heap_pkg__Num_in_prio_heap;

    /* Loop until reach top of heap, or parent greater than new prio */
    while ((int32 )Child > 1) {
        Parent = (uint16 )((int32 )Child/2);
          /*  Find slot which should be greater */
        if ((int32 )Prio_heap_pkg__Prio_heap[(int32 )Parent - 1] >= (
          int32 )Prio_to_add) {
            goto loop_label__1;
        }
        /* All done if Parent is already greater */

        /* Parent smaller, move it down to child's slot */
        Prio_heap_pkg__Prio_heap[(int32 )Child - 1] = (uint8 )(int32 )
          Prio_heap_pkg__Prio_heap[(int32 )Parent - 1];

        /* Advance up to parent slot and iterate */
        Child = (uint16 )(int32 )Parent;
    }
    loop_label__1:;

    /*| ASSERT: Prio_To_Add < Prio_Heap(Child/2) or top-of-heap */
    Prio_heap_pkg__Prio_heap[(int32 )Child - 1] = (uint8 )(int32 )
      Prio_to_add;


}


void  Prio_heap_pkg_Remove_top_prio(void)
  /* | Remove top priority from prio heap */
{
    /**
     *| Algorithm
     *| Move bottom of heap to top of heap, and then "sift" it down
     *| until binary heap condition is restored
     *| (i.e., prio_heap(n) > prio_heap(2n),prio_heap(2n+1))
     **/

    Prio_heap_pkg_Prioritynumber Prio_to_move;
    /*| Priority to sift down */

    Prio_heap_pkg__Prio_heap_index Parent;
    /*| Child = higher-prio-of (2*Parent, 2*Parent+1) */

    Prio_heap_pkg__Prio_heap_index Child;
    Prio_heap_pkg__Prio_heap_count Parent_limit;
    /*| Last parent with any children */



    Prio_to_move = (uint8 )(int32 )Prio_heap_pkg__Prio_heap[(int32 )
      Prio_heap_pkg__Num_in_prio_heap - 1];

    /**
     * Ensure that empty slots have min prio
     *  This allows us to ignore special case when parent has
     * exactly one child, since missing child will appear to have
     * minimum priority.
     **/
    Prio_heap_pkg__Prio_heap[(int32 )Prio_heap_pkg__Num_in_prio_heap
      - 1] = (uint8 )(int32 )Prio_heap_pkg__Min_prio;

    /* Shorten the heap */
    Prio_heap_pkg__Num_in_prio_heap = (uint16 )((int32 )
      Prio_heap_pkg__Num_in_prio_heap - 1);

    if ((int32 )Prio_heap_pkg__Num_in_prio_heap == 0) {

        /* All done if heap now empty */
        return ;
    }

    /* Start at top of heap */
    Parent = 1;

    /**
     * Calculate limit on parent
     * (do this to avoid overflow in child calculation)
     **/
    Parent_limit = (uint16 )((int32 )Prio_heap_pkg__Num_in_prio_heap/2);

    /* Loop until reach bottom of heap, or prio-to-mv > both children */
    while ((int32 )Parent <= (int32 )Parent_limit) {

        /* Determine larger "child" */
        Child = (uint16 )((int32 )Parent*2);
        if ((int32 )Prio_heap_pkg__Prio_heap[(int32 )Child+1 - 1] > (
          int32 )Prio_heap_pkg__Prio_heap[(int32 )Child - 1]) {
            /* 2n+1 child is greater than 2n child */
            Child = (uint16 )((int32 )Child+1);
        }

        if ((int32 )Prio_to_move >= (int32 )Prio_heap_pkg__Prio_heap[(
          int32 )Child - 1]) {
            goto loop_label__2;
        }
        /* All done when slot found for prio being moved */

        /* Move larger child up, and iterate with child's slot */
        Prio_heap_pkg__Prio_heap[(int32 )Parent - 1] = (uint8 )(int32 )
          Prio_heap_pkg__Prio_heap[(int32 )Child - 1];
        Parent = (uint16 )(int32 )Child;
    }
    loop_label__2:;

    /**
     * ASSERT: Prio_To_Move > both children (2*Parent,2*Parent+1)
     *         or slot has no children
     **/

    /* Put prio in its new slot */
    Prio_heap_pkg__Prio_heap[(int32 )Parent - 1] = (uint8 )(int32 )
      Prio_to_move;


}
void  rts_ss_mark(Root_address );
Character *  rts_integer_image(int32*,
    Integer );

#include "ada.text_io.spc.h"
void  rts_ss_release(Root_address );

void  Prio_heap_pkg__Print_prio_list(
    Prio_heap_pkg__Prio_heap_index Parent
)
{

    Prio_heap_pkg__Prio_heap_index Child;
    uint8 *pointer__3;
    int32 dyn_temp__4[2];
    Character *pointer__5;

    if ((int32 )Parent <= (int32 )Prio_heap_pkg__Num_in_prio_heap) {
        rts_ss_mark((uint8 *)&pointer__3);
        pointer__5 = rts_integer_image(dyn_temp__4,(int32 )
          Prio_heap_pkg__Prio_heap[(int32 )Parent - 1]);

        Ada_Text_io_Put_line__2((Character *)pointer__5,dyn_temp__4);
        rts_ss_release((uint8 *)&pointer__3);

        if ((int32 )Parent <= (int32 )Prio_heap_pkg__Num_in_prio_heap/2
          ) {

            Child = (uint16 )(2*(int32 )Parent);
            if ((int32 )Prio_heap_pkg__Prio_heap[(int32 )Child+1 - 1]
              > (int32 )Prio_heap_pkg__Prio_heap[(int32 )Child - 1]) {

                Prio_heap_pkg__Print_prio_list((uint16 )((int32 )Child+1));
                Prio_heap_pkg__Print_prio_list((uint16 )(int32 )Child);
            } else {

                Prio_heap_pkg__Print_prio_list((uint16 )(int32 )Child);
                Prio_heap_pkg__Print_prio_list((uint16 )((int32 )Child+1));
            }
        }
    }
}


void  Prio_heap_pkg_Print_prio_heap(void)
{
    Prio_heap_pkg__Print_prio_list(1);
}
----------- prio_heap_pkg.spc ---------
pragma Suppress(All_Checks);
package Prio_Heap_Pkg is
    --| Overview
    --| This package maintains a "binary heap" of priorities
    --| allowing fast access to the highest priority in the heap.

    subtype PriorityNumber is Integer range 0..255;
    
    procedure Add_Prio ( --| Add new prio to prio heap
      Prio_To_Add : PriorityNumber
    );
    
    procedure Remove_Top_Prio;  --| Remove top priority from prio heap
    
    procedure Print_Prio_Heap;  --| Print all priorities in priority heap,
				--| in priority order.
end Prio_Heap_Pkg;
----------- prio_heap_pkg.bdy ---------
with Ada.Text_IO;
package body Prio_Heap_Pkg is  --| Maintain priority heap
  
    --| Overview
    --| This package maintains a "binary heap" of priorities
    --| allowing fast access to the highest priority in the heap.
    
    
    Min_Prio : constant PriorityNumber := PriorityNumber'First;
      --| Lowest priority supported.
    
    Num_Prio : constant :=
      PriorityNumber'Pos(PriorityNumber'Last) -
       PriorityNumber'Pos(PriorityNumber'First) + 1;
      --| Number of priorities supported
      
    type Prio_Heap_Count is range 0 .. Num_Prio + 1;
      --| type for count of items in prio heap
      --| One extra so may always assume have 2 or 0 children (see
      --| Remove_Prio below).
      
    subtype Prio_Heap_Index is Prio_Heap_Count
      range 1 .. Prio_Heap_Count'Last;
      --| subtype for index into prio heap
    
    Prio_Heap : array(Prio_Heap_Index) of PriorityNumber :=
      (others => Min_Prio);
      --| List of priorities which might have non-empty task queue.
      --| This list is organized as a "binary heap" where
      --| Prio_Heap(n/2) > Prio_Heap(n) for n in 2..Num_In_Prio_Heap.
      --| Initialize to Min_Prio to simplify Remove_Prio algorithm.
      
    Num_In_Prio_Heap : Prio_Heap_Count := 0;
      --| Count of items in prio heap
      
    In_Prio_Heap : array(PriorityNumber) of Boolean :=
      (others => False);
        --| Indication for each priority whether in prio heap
      
    Top_Prio_In_Heap : PriorityNumber renames Prio_Heap(Prio_Heap'First);
      --| Highest priority which might have non-empty queue
    
    procedure Add_Prio ( --| Add new prio to prio heap
      Prio_To_Add : PriorityNumber
    ) is
	--| Algorithm
	--| Add new prio to end of heap, then "sift" it up,
	--| until binary heap condition is restored
	--| (i.e., prio_heap(n) > prio_heap(2n),prio_heap(2n+1))
	
	Parent, Child : Prio_Heap_Index;
    begin
	Num_In_Prio_Heap := Num_In_Prio_Heap + 1;
	
	-- Start at end of heap
	Child := Num_In_Prio_Heap;
	
	-- Loop until reach top of heap, or parent greater than new prio
	while Child > 1 loop
	    Parent := Child/2;  -- Find slot which should be greater
	    exit when Prio_Heap(Parent) >= Prio_To_Add;
	      -- All done if Parent is already greater
	      
	    -- Parent smaller, move it down to child's slot
	    Prio_Heap(Child) := Prio_Heap(Parent);
	    
	    -- Advance up to parent slot and iterate
	    Child := Parent;
	end loop;
	
	--| ASSERT: Prio_To_Add < Prio_Heap(Child/2) or top-of-heap
	Prio_Heap(Child) := Prio_To_Add;
	
    end Add_Prio;
    
    procedure Remove_Top_Prio   --| Remove top priority from prio heap
    is
	--| Algorithm
	--| Move bottom of heap to top of heap, and then "sift" it down
	--| until binary heap condition is restored
	--| (i.e., prio_heap(n) > prio_heap(2n),prio_heap(2n+1))
	
	Prio_To_Move : constant PriorityNumber :=
	  Prio_Heap(Num_In_Prio_Heap);
	  --| Priority to sift down
	  
	Parent, Child : Prio_Heap_Index;
	  --| Child = higher-prio-of (2*Parent, 2*Parent+1)
	  
	Parent_Limit : Prio_Heap_Count;
	  --| Last parent with any children
    begin
	-- Ensure that empty slots have min prio
	--  This allows us to ignore special case when parent has
	-- exactly one child, since missing child will appear to have
	-- minimum priority.
	Prio_Heap(Num_In_Prio_Heap) := Min_Prio;
	
	-- Shorten the heap
	Num_In_Prio_Heap := Num_In_Prio_Heap - 1;
	
	if Num_In_Prio_Heap = 0 then
	    
	    -- All done if heap now empty
	    return;
	
	end if;
	
	-- Start at top of heap
	Parent := 1;
	
	-- Calculate limit on parent
	-- (do this to avoid overflow in child calculation)
	Parent_Limit := Num_In_Prio_Heap / 2;

	-- Loop until reach bottom of heap, or prio-to-mv > both children
	while Parent <= Parent_Limit loop
	    
	    -- Determine larger "child"
	    Child := Parent * 2;
	    if Prio_Heap(Child + 1) > Prio_Heap(Child) then
		-- 2n+1 child is greater than 2n child
		Child := Child + 1;
	    end if;
	    
	    exit when Prio_To_Move >= Prio_Heap(Child);
	      -- All done when slot found for prio being moved
	      
	    -- Move larger child up, and iterate with child's slot
	    Prio_Heap(Parent) := Prio_Heap(Child);
	    Parent := Child;
	end loop;
	
	-- ASSERT: Prio_To_Move > both children (2*Parent,2*Parent+1)
	--         or slot has no children
	
	-- Put prio in its new slot
	Prio_Heap(Parent) := Prio_To_Move;
	
    end Remove_Top_Prio;
	
    procedure Print_Prio_List(  --| Print all priorities in heap
                                --| in priority order, starting at given slot
      Parent : Prio_Heap_Index
    ) is
	--| Algorithm
	--| Print prio at given slot in heap,
	--| Then recurse with children, higher prio first.
	
	Child : Prio_Heap_Index;
    begin
	if Parent <= Num_In_Prio_Heap then
	    -- Print priority
	    Ada.Text_IO.Put_Line(Integer'Image(Prio_Heap(Parent)));
	    
	    if Parent <= Num_In_Prio_Heap/2 then
		-- Parent has children, recurse on children in order
		Child := 2 * Parent;
		if Prio_Heap(Child+1) > Prio_Heap(Child) then
		    -- Second child is higher prio
		    Print_Prio_List(Child+1);
		    Print_Prio_List(Child);
		else
		    -- First child is higher prio
		    Print_Prio_List(Child);
		    Print_Prio_List(Child+1);
		end if;
	    end if;
	end if;
    end Print_Prio_List;
 
    procedure Print_Prio_Heap is  --| Print all priorities in priority heap,
				  --| in priority order.
    begin
	-- Just pass the buck to the recursive routine
	Print_Prio_List(Prio_Heap_Index'First);
    end Print_Prio_Heap;

 ----------------------------------------------------------------------
 end Prio_Heap_Pkg;
 ----------------------------------------------------------------------