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,76da32d8c4934801 X-Google-Attributes: gid103376,public From: stt@houdini.camb.inmet.com (Tucker Taft) Subject: Re: Ada --> C Translation, was: Win CE target Date: 1998/09/29 Message-ID: X-Deja-AN: 395974758 Sender: news@inmet.camb.inmet.com (USENET news) X-Nntp-Posting-Host: houdini.camb.inmet.com References: <360FB3B0.5B0E218C@galileo.mpi-hd.mpg.de> Organization: Intermetrics, Inc. Newsgroups: comp.lang.ada Date: 1998-09-29T00:00:00+00:00 List-Id: 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; ----------------------------------------------------------------------