home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / piwg / e000002.ada < prev    next >
Encoding:
Text File  |  1988-05-03  |  3.2 KB  |  122 lines
  1.  
  2. -- PERFORMANCE MEASUREMENT : exception raise and handle time
  3. --                           exception in procedure 
  4.  
  5. package EXCEPT_PACK_2 is
  6.  
  7.   MY_EXCEPTION : exception ;
  8.   SWITCH : BOOLEAN ; -- controls return or raise exception
  9.  
  10.   procedure PROC_1 ( SWITCH : BOOLEAN ) ; -- either returns or raises exception
  11.  
  12. end EXCEPT_PACK_2 ;
  13.  
  14. with EXCEPT_PACK_2 ; use EXCEPT_PACK_2 ;
  15. with REMOTE_GLOBAL ; use REMOTE_GLOBAL ; -- control optimization
  16. with ITERATION ; -- obtain stable measurement
  17. with PIWG_IO ; -- output results
  18.  
  19. procedure E000002 is  -- main procedure to execute
  20.  
  21.   CPU_TIME : DURATION ; -- CPU time for one feature execution
  22.   WALL_TIME : DURATION ; -- WALL time for one feature execution
  23.   CHECK_TIMES : constant := 100 ; -- inside loop count and check
  24.   ITERATION_COUNT : INTEGER ; -- set and varied by ITERATION package
  25.   STABLE : BOOLEAN ; -- true when measurement stable
  26.  
  27. begin
  28.  
  29.   ITERATION.START_CONTROL ;  -- dummy to bring in pages on some machines
  30.  
  31.   delay 0.5 ;  -- wait for stable enviornment on some machines
  32.  
  33.   ITERATION.INITIALIZE ( ITERATION_COUNT ) ;
  34.  
  35.   loop  -- until stable measurement, ITERATION_COUNT increases each time
  36.  
  37. --
  38. -- Control loop
  39. --
  40.     if A_ONE = 2 then
  41.       SWITCH := TRUE ;
  42.     else
  43.       SWITCH := FALSE ;
  44.     end if ;
  45.  
  46.     ITERATION.START_CONTROL ;
  47.     for J in 1 .. ITERATION_COUNT loop
  48.       GLOBAL := 0 ;
  49.       for INSIDE_LOOP in 1 .. CHECK_TIMES loop
  50. --                     this has control global increment and call inside
  51.         begin
  52.           PROC_1 ( SWITCH ) ; -- FALSE  no exception raised
  53.         exception
  54.           when MY_EXCEPTION =>
  55.             null ;
  56.         end ;
  57.       end loop ;
  58.     end loop ;
  59.     ITERATION.STOP_CONTROL ( GLOBAL , CHECK_TIMES ) ;
  60.  
  61. --
  62. -- Test loop
  63. --
  64. -- establish exception raise and handle time
  65.  
  66.     if A_ONE = 1 then
  67.       SWITCH := TRUE ;
  68.     else
  69.       SWITCH := FALSE ;
  70.     end if ;
  71.  
  72.     ITERATION.START_TEST ;
  73.     for J in 1 .. ITERATION_COUNT loop
  74.       GLOBAL := 0 ;
  75.       for INSIDE_LOOP in 1 .. CHECK_TIMES loop
  76. --                     this has control global increment and call inside
  77.         begin
  78.           PROC_1 ( SWITCH ) ; -- TRUE exception will be raised
  79.         exception
  80.           when MY_EXCEPTION =>
  81.             null ;
  82.         end ;
  83.       end loop ;
  84.     end loop ;
  85.     ITERATION.STOP_TEST ( GLOBAL , CHECK_TIMES ) ;
  86.     ITERATION.TEST_STABLE ( ITERATION_COUNT , STABLE ) ;
  87.     exit when STABLE ;
  88.   end loop ;
  89. --
  90.   ITERATION.FEATURE_TIMES ( CPU_TIME , WALL_TIME ) ;
  91.  
  92. --
  93. -- Printout
  94. --
  95.   PIWG_IO.PIWG_OUTPUT ( "E000002" , "Exception" ,
  96.                         CPU_TIME , WALL_TIME , ITERATION_COUNT ,
  97.     " Exception raise and handle timing measurement" ,
  98.     " when exception is in a procedure in a package" ,
  99.     " " ) ;
  100. end E000002 ;
  101.  
  102. with REMOTE_GLOBAL ; use REMOTE_GLOBAL ;
  103. package body EXCEPT_PACK_2 is -- compare to E000001, diff is propegation
  104.  
  105.   procedure PROC_1 ( SWITCH : BOOLEAN ) is
  106.   begin
  107.     if SWITCH then
  108.       GLOBAL := GLOBAL + 1 ;
  109.       REMOTE ;
  110.       raise MY_EXCEPTION ;
  111.     else
  112.       GLOBAL := GLOBAL + 1 ;
  113.       REMOTE ;
  114.       return ;
  115.     end if ;
  116.   exception
  117.     when PROGRAM_ERROR =>
  118.       PROC_1 ( SWITCH ) ;
  119.   end PROC_1 ;
  120.  
  121. end EXCEPT_PACK_2 ;
  122.