home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / piwg / d000004.ada < prev    next >
Encoding:
Text File  |  1988-05-03  |  3.1 KB  |  104 lines
  1.  
  2. -- PERFORMANCE MEASUREMENT : Elaboration, allocation and freeing of
  3. --                           record containing a dynamic array
  4.  
  5. package DYNAMIC_ARRAY_PACKAGE_4 is
  6.   DYNAMIC_SIZE : INTEGER ;
  7.   type DYNAMIC_ARRAY is array ( INTEGER range <> ) of INTEGER ;
  8.   type DYNAMIC_RECORD ( SIZE : INTEGER ) is
  9.     record
  10.       INSIDE_ARRAY : DYNAMIC_ARRAY ( 1..SIZE ) ;
  11.     end record ;
  12.   LOCAL_ARRAY : DYNAMIC_RECORD ( 1000 ) := ( 1000 , ( others => 1 ) ) ;
  13.   procedure PROC_CONTROL ;
  14.   procedure PROC_TEST ;
  15. end DYNAMIC_ARRAY_PACKAGE_4 ;
  16.  
  17. with DYNAMIC_ARRAY_PACKAGE_4 ; use DYNAMIC_ARRAY_PACKAGE_4 ;
  18. with REMOTE_GLOBAL ; use REMOTE_GLOBAL ; -- control optimization
  19. with ITERATION ; -- obtain stable measurement
  20. with PIWG_IO ; -- output results
  21.  
  22. procedure D000004 is  -- main procedure to execute
  23.   CPU_TIME : DURATION ; -- CPU time for one feature execution
  24.   WALL_TIME : DURATION ; -- WALL time for one feature execution
  25.   CHECK_TIMES : constant := 100 ; -- inside loop count and check
  26.   ITERATION_COUNT : INTEGER ; -- set and varied by ITERATION package
  27.   STABLE : BOOLEAN ; -- true when measurement stable
  28.  
  29. begin
  30.  
  31.   DYNAMIC_SIZE := 1000 ;
  32.  
  33.   ITERATION.START_CONTROL ;  -- dummy to bring in pages on some machines
  34.  
  35.   delay 0.5 ;  -- wait for stable enviornment on some machines
  36.  
  37.   ITERATION.INITIALIZE ( ITERATION_COUNT ) ;
  38.  
  39.   loop  -- until stable measurement, ITERATION_COUNT increases each time
  40.  
  41. --
  42. -- Control loop
  43. --
  44.     ITERATION.START_CONTROL ;
  45.     for J in 1 .. ITERATION_COUNT loop
  46.       GLOBAL := 0 ;
  47.       for INSIDE_LOOP in 1 .. CHECK_TIMES loop
  48.         PROC_CONTROL ;
  49.       end loop ;
  50.     end loop ;
  51.     ITERATION.STOP_CONTROL ( GLOBAL , CHECK_TIMES ) ;
  52.  
  53.  
  54. --
  55. -- Test loop
  56. --
  57.  
  58.     ITERATION.START_TEST ;
  59.     for J in 1 .. ITERATION_COUNT loop
  60.       GLOBAL := 0 ;
  61.       for INSIDE_LOOP in 1 .. CHECK_TIMES loop
  62.         PROC_TEST ; -- this has control global increment and call inside
  63.       end loop ;
  64.     end loop ;
  65.     ITERATION.STOP_TEST ( GLOBAL , CHECK_TIMES ) ;
  66.     ITERATION.TEST_STABLE ( ITERATION_COUNT , STABLE ) ;
  67.     exit when STABLE ;
  68.   end loop ;
  69. --
  70.   ITERATION.FEATURE_TIMES ( CPU_TIME , WALL_TIME ) ;
  71.  
  72. --
  73. -- Printout
  74. --
  75.   PIWG_IO.PIWG_OUTPUT ( "D000004" , "Allocation" ,
  76.                         CPU_TIME , WALL_TIME , ITERATION_COUNT ,
  77.     " Dynamic record allocation and deallocation time measurement " ,
  78.     " elaborating, initializing by ( DYNAMIC_SIZE,(others=>1)) " ,
  79.     " record containing a dynamic array of 1000 integers " ) ;
  80. end D000004 ;
  81.  
  82. with REMOTE_GLOBAL ; use REMOTE_GLOBAL ;
  83. package body DYNAMIC_ARRAY_PACKAGE_4 is
  84.  
  85.   procedure PROC_CONTROL is
  86.   begin
  87.     GLOBAL := GLOBAL + A_ONE ;
  88.     LOCAL_ARRAY.INSIDE_ARRAY ( GLOBAL ) := GLOBAL ;
  89.     REMOTE ;
  90.     GLOBAL := LOCAL_ARRAY.INSIDE_ARRAY ( GLOBAL ) ;
  91.   end ;
  92.  
  93.   procedure PROC_TEST is
  94.     PROC_ARRAY : DYNAMIC_RECORD ( DYNAMIC_SIZE ) := 
  95.                                 ( DYNAMIC_SIZE , ( others => 1 ) ) ;
  96.   begin
  97.     GLOBAL := GLOBAL + A_ONE ;
  98.     PROC_ARRAY.INSIDE_ARRAY ( GLOBAL ) := GLOBAL ;
  99.     REMOTE ;
  100.     GLOBAL := PROC_ARRAY.INSIDE_ARRAY ( GLOBAL ) ;
  101.   end PROC_TEST ;
  102.  
  103. end DYNAMIC_ARRAY_PACKAGE_4 ;
  104.