-- Iteration control package body with CPU_TIME_CLOCK ; -- various choices on tape with CALENDAR ; -- used for WALL clock times with TEXT_IO ; -- only for diagnostics with DURATION_IO ; -- only for diagnostics with BREAK ; package body ITERATION is -- A000032.ADA -- -- CPU time variables -- CONTROL_TIME_INITIAL : DURATION ; -- sampled from CPU_TIME_CLOCK at beginning CONTROL_TIME_FINAL : DURATION ; -- sampled from CPU_TIME_CLOCK at end CONTROL_DURATION : DURATION ; -- (FINAL-INITIAL) the measured time in seconds TEST_TIME_INITIAL : DURATION ; -- ditto for TEST TEST_TIME_FINAL : DURATION ; TEST_DURATION : DURATION ; -- -- WALL time variables -- WALL_TIME_INITIAL : DURATION ; -- sampled from CLOCK at beginning WALL_TIME_FINAL : DURATION ; -- sampled from CLOCK at end WALL_DURATION : DURATION ; -- (FINAL-INITIAL) measured time in seconds CPU_TIME_INITIAL : DURATION ; -- ditto for CPU time, used to check CPU_TIME_FINAL : DURATION ; -- conststancy of WALL and CPU timers CPU_DURATION : DURATION ; -- MINIMUM_TIME : DURATION := 1.0 ; -- required minimum value of test time TEMP_TIME : FLOAT ; -- for scaling to microseconds ITERATION_COUNT : INTEGER ; -- change to make timing stable CHECK : INTEGER ; -- saved from STOP_TEST call for scaling CLOCK_RESOLUTION : DURATION ; -- measured upon elaboration CLOCK_NEXT : DURATION ; -- temporary to hold CPU_TIME_CLOCK CPU_TOLER : DURATION ; -- temporary procedure INITIALIZE ( ITERATION_COUNT : out INTEGER ) is begin ITERATION_COUNT := 1 ; ITERATION.ITERATION_COUNT := 1 ; WALL_TIME_INITIAL := CALENDAR.SECONDS(CALENDAR.CLOCK) ; CPU_TIME_INITIAL := CPU_TIME_CLOCK ; CONTROL_DURATION := 0.0 ; end INITIALIZE ; procedure START_CONTROL is begin CONTROL_TIME_INITIAL := CPU_TIME_CLOCK ; end START_CONTROL ; procedure STOP_CONTROL ( GLOBAL : INTEGER ; CHECK : INTEGER ) is begin CONTROL_TIME_FINAL := CPU_TIME_CLOCK ; CONTROL_DURATION := CONTROL_TIME_FINAL - CONTROL_TIME_INITIAL ; -- if CHECK /= GLOBAL then TEXT_IO.PUT_LINE ( " Fix control loop before making measurements." ) ; TEXT_IO.PUT_LINE ( INTEGER'IMAGE ( GLOBAL ) & " = GLOBAL " ) ; raise PIWG_ERROR ; end if ; if CONTROL_DURATION < 0.0 then TEXT_IO.PUT_LINE ( " Timer not working properly, rerun this test" ) ; raise PIWG_ERROR ; end if ; end STOP_CONTROL ; procedure START_TEST is begin TEST_TIME_INITIAL := CPU_TIME_CLOCK ; end START_TEST ; procedure STOP_TEST ( GLOBAL : INTEGER ; CHECK : INTEGER ) is begin TEST_TIME_FINAL := CPU_TIME_CLOCK ; TEST_DURATION := TEST_TIME_FINAL - TEST_TIME_INITIAL ; -- ITERATION.CHECK := CHECK ; if CHECK /= GLOBAL then TEXT_IO.PUT_LINE ( " Fix test loop before making measurements." ) ; TEXT_IO.PUT_LINE ( INTEGER'IMAGE ( GLOBAL ) & " = GLOBAL " ) ; raise PIWG_ERROR ; end if ; if TEST_DURATION < 0.0 then TEXT_IO.PUT_LINE ( " Timer not working properly, rerun this test" ) ; raise PIWG_ERROR ; end if ; end STOP_TEST ; procedure TEST_STABLE ( ITERATION_COUNT : in out INTEGER ; STABLE : out BOOLEAN ) is begin if TEST_DURATION > MINIMUM_TIME then -- has increased ITERATION_COUNT to point where test should be valid if TEST_DURATION < CONTROL_DURATION then -- zero or negative control time. this may be OK for loop unrolloing -- in a cached memory, OK for inlined code, etc. if ITERATION_COUNT < 1024 then -- let us try a little longer to make sure ITERATION_COUNT := ITERATION_COUNT + ITERATION_COUNT ; ITERATION.ITERATION_COUNT := ITERATION_COUNT ; STABLE := FALSE ; else -- OK, admit it, really zero due to optimization -- or negative due to cache STABLE := TRUE ; end if; else -- normal stability, past minimum time and positive measure STABLE := TRUE ; end if ; elsif ITERATION_COUNT > 32767 then -- bad choice of CHECK_TIMES or -- bad choice of CASE_COUNT, -- just running too long. TEXT_IO.PUT_LINE ( "***** POSSIBLY INACCURATE MEASUREMENT *****" ) ; STABLE := TRUE ; else -- normal case. Have not reached minimum and not running too long ITERATION_COUNT := ITERATION_COUNT + ITERATION_COUNT ; ITERATION.ITERATION_COUNT := ITERATION_COUNT ; STABLE := FALSE ; end if; exception when others => TEXT_IO.PUT_LINE ( "***** INCOMPLETE MEASUREMENT, EXCEPTION *****" ) ; STABLE := TRUE ; end TEST_STABLE ; procedure INCREMENT ( GLOBAL : in out INTEGER ) is begin -- optimization breaker and check that test was really run GLOBAL := GLOBAL + BREAK.A_ONE ; end INCREMENT ; procedure FEATURE_TIMES ( CPU_TIME : out DURATION ; CPU_TOLERANCE : out DURATION ; WALL_TIME : out DURATION ; TESTS_SCALE : in out SCALE ) is begin -- -- compute scaled results -- -- the problem is some compilers loose the bottom bits of a 32 bit -- type DURATION when converting to a 32 bit type FLOAT if TEST_DURATION < CONTROL_DURATION then if CONTROL_DURATION - TEST_DURATION < 8 * CLOCK_RESOLUTION then CPU_TIME := 0.0 ; else TEXT_IO.PUT_LINE ( " CONTROL time exceeded TEST time on test below" & ", test not valid" ) ; end if ; elsif TEST_DURATION - CONTROL_DURATION > 84.0 then TEMP_TIME := FLOAT ( TEST_DURATION - CONTROL_DURATION ) ; TEMP_TIME := (1_000_000.0 * TEMP_TIME) / ( FLOAT ( ITERATION_COUNT ) * FLOAT (CHECK) ); else -- save low order fixed point digits on some compilers TEMP_TIME := FLOAT ( (TEST_DURATION-CONTROL_DURATION)*1000 ) ; TEMP_TIME := (1_000.0 * TEMP_TIME) / ( FLOAT ( ITERATION_COUNT ) * FLOAT (CHECK) ); end if; case TESTS_SCALE is -- adjust scale factor for printing when AUTO => if TEMP_TIME < 84_600.0 then TESTS_SCALE := MICROSECONDS ; elsif TEMP_TIME < 84_600_000.0 then TEMP_TIME := TEMP_TIME / 1_000.0 ; TESTS_SCALE := MILLISECONDS ; else TEMP_TIME := TEMP_TIME /1_000_000.0 ; TESTS_SCALE := SECONDS ; end if; when MICROSECONDS => null; when MILLISECONDS => TEMP_TIME := TEMP_TIME / 1_000.0 ; when SECONDS => TEMP_TIME := TEMP_TIME / 1_000_000.0 ; end case; CPU_TIME := DURATION ( TEMP_TIME ) ; -- don't clobber TEMP_TIME, used later case TESTS_SCALE is -- adjust tolerance scale also when AUTO => null; -- taken care of by this time when MICROSECONDS => CPU_TOLER := DURATION ( 1000.0 * FLOAT ( 4000 * CLOCK_RESOLUTION ) / ( FLOAT ( ITERATION_COUNT ) * FLOAT (CHECK) ) ) ; when MILLISECONDS => CPU_TOLER := DURATION ( FLOAT ( 4000 * CLOCK_RESOLUTION ) / ( FLOAT ( ITERATION_COUNT ) * FLOAT (CHECK) ) ) ; when SECONDS => CPU_TOLER := DURATION ( FLOAT ( 4 * CLOCK_RESOLUTION ) / ( FLOAT ( ITERATION_COUNT ) * FLOAT (CHECK) ) ) ; end case; -- CPU_TIME_FINAL := CPU_TIME_CLOCK ; CPU_DURATION := CPU_TIME_FINAL - CPU_TIME_INITIAL ; WALL_TIME_FINAL := CALENDAR.SECONDS(CALENDAR.CLOCK) ; WALL_DURATION := WALL_TIME_FINAL - WALL_TIME_INITIAL ; if CPU_DURATION < 0.0 then TEXT_IO.PUT_LINE ( " CPU time not a valid measurement " ) ; raise PIWG_ERROR; end if ; if WALL_DURATION < 0.0 then TEXT_IO.PUT_LINE ( " WALL time not a valid measurement," & " crossed midnight ? " ) ; end if ; if WALL_DURATION < CPU_DURATION then TEXT_IO.PUT_LINE ( " WALL time less than CPU time " ) ; end if ; WALL_TIME := DURATION ( WALL_DURATION / CPU_DURATION ) ; -- now a ratio -- do not claim better than 5% accuracy -- take into account big WALL/CPU ratio if DURATION ( TEMP_TIME / 20.0 ) > CPU_TOLER then CPU_TOLER := DURATION ( TEMP_TIME / 20.0 ) ; if DURATION ( WALL_DURATION / CPU_DURATION ) > 1.2 then CPU_TOLER := DURATION ( CPU_TOLER * DURATION ( WALL_DURATION / CPU_DURATION ) ) ; -- don't blame me for dumb looking code. I can't use an out -- parameter on the right of a := end if; end if ; CPU_TOLERANCE := CPU_TOLER ; end FEATURE_TIMES ; -- -- begin CLOCK_RESOLUTION := CPU_TIME_CLOCK ; loop CLOCK_NEXT := CPU_TIME_CLOCK ; exit when CLOCK_NEXT > CLOCK_RESOLUTION ; end loop ; CLOCK_RESOLUTION := 2 * ( CLOCK_NEXT - CLOCK_RESOLUTION + DURATION'SMALL ) ; DURATION_IO.PUT(CLOCK_RESOLUTION); TEXT_IO.PUT_LINE ( " = clock resolution used for iteration stability " ) ; TEXT_IO.PUT_LINe ( " " ) ; MINIMUM_TIME := 1.0 ; if CLOCK_RESOLUTION * 200 > MINIMUM_TIME then MINIMUM_TIME := CLOCK_RESOLUTION * 200 ; end if; -- MINIMUM_TIME is now the larger of 1.0 second, -- 400*minimum clock resolution end ITERATION ;