Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/piwg/a000033.ada

Text File | 1988-05-03 | 5.1 KB | 156 lines

-- Iteration control package body ( for test development )
--   This version is instrumented and may interefere with some
--   types of tests

with CPU_TIME_CLOCK ;  -- various choices on tape
with CALENDAR ; -- used for WALL clock times
with SYSTEM ; -- used to get value of TICK
with TEXT_IO ;  -- only for diagnostics
with DURATION_IO ;

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_CONTROL_TIME_INITIAL : DURATION ; -- sampled from CLOCK at beginning
  WALL_CONTROL_TIME_FINAL : DURATION ;  -- sampled from CLOCK at end
  WALL_CONTROL_DURATION : DURATION ; -- (FINAL-INITIAL) measured time in seconds
  WALL_TEST_TIME_INITIAL : DURATION ; -- ditto for TEST
  WALL_TEST_TIME_FINAL : DURATION ;
  WALL_TEST_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

  procedure START_CONTROL is
  begin
    CONTROL_TIME_INITIAL := CPU_TIME_CLOCK ;
    WALL_CONTROL_TIME_INITIAL := CALENDAR.SECONDS(CALENDAR.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 ;
    WALL_CONTROL_TIME_FINAL := CALENDAR.SECONDS(CALENDAR.CLOCK) ;
    WALL_CONTROL_DURATION := WALL_CONTROL_TIME_FINAL -
                             WALL_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 PROGRAM_ERROR ;
    end if ;
    TEXT_IO.PUT_LINE ( "Iteration " & INTEGER'IMAGE ( ITERATION_COUNT ) ) ;
    DURATION_IO.PUT ( CONTROL_TIME_INITIAL );
    DURATION_IO.PUT ( CONTROL_TIME_FINAL );
    DURATION_IO.PUT ( CONTROL_TIME_DURATION );
    TEXT_IO.NEW_LINE ;
  end STOP_CONTROL ;

  procedure START_TEST is
  begin
    TEST_TIME_INITIAL := CPU_TIME_CLOCK ;
    WALL_TEST_TIME_INITIAL := CALENDAR.SECONDS(CALENDAR.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 ;
    WALL_TEST_TIME_FINAL := CALENDAR.SECONDS(CALENDAR.CLOCK) ;
    WALL_TEST_DURATION := WALL_TEST_TIME_FINAL - WALL_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 PROGRAM_ERROR ;
    end if ;
  end STOP_TEST ;

  procedure FEATURE_TIMES ( CPU_TIME : out DURATION ;
                            WALL_TIME : out DURATION ) is
  begin
--
--  compute scaled results
--
    begin
      TEMP_TIME := FLOAT ( TEST_DURATION - CONTROL_DURATION ) ;
      TEMP_TIME := (1_000_000.0 * TEMP_TIME) /
                   ( FLOAT ( ITERATION_COUNT ) * FLOAT (CHECK) );
      CPU_TIME := DURATION ( TEMP_TIME ) ;
    exception
      when others =>  -- bail out if trouble in conversion
        CPU_TIME := 0.0 ;
    end ;
--
    begin
      TEMP_TIME := FLOAT ( WALL_TEST_DURATION - WALL_CONTROL_DURATION ) ;
      TEMP_TIME := (1_000_000.0 * TEMP_TIME) /
                   ( FLOAT ( ITERATION_COUNT ) * FLOAT (CHECK) );
      WALL_TIME := DURATION ( TEMP_TIME ) ;
    exception
      when others =>
        WALL_TIME := 0.0 ;
    end ;

  end FEATURE_TIMES ;


  procedure INITIALIZE ( ITERATION_COUNT : out INTEGER ) is
  begin
    ITERATION_COUNT := 1 ;
    ITERATION.ITERATION_COUNT := 1 ;
  end INITIALIZE ;

  procedure TEST_STABLE ( ITERATION_COUNT : in out INTEGER ;
                          STABLE : out BOOLEAN ) is
  begin
    if TEST_DURATION > MINIMUM_TIME then
      STABLE := TRUE ;
    elsif ITERATION_COUNT >= 16384 then
      TEXT_IO.PUT_LINE ( "***** INCOMPLETE MEASUREMENT *****" ) ;
      STABLE := TRUE ;
    else
      ITERATION_COUNT := ITERATION_COUNT + ITERATION_COUNT ;
      ITERATION.ITERATION_COUNT := ITERATION_COUNT ;
      STABLE := FALSE ;
    END IF;
  end TEST_STABLE ;


--
begin

  if SYSTEM.TICK * 100 > MINIMUM_TIME then
    MINIMUM_TIME := SYSTEM.TICK * 100 ;
  end if;

  if DURATION'SMALL * 100 > MINIMUM_TIME then
    MINIMUM_TIME := DURATION'SMALL * 100 ;
  end if;

-- MINIMUM_TIME is now the larger of 1.0 second,
--                                   100*SYSTEM.TICK,
--                                   100*DURATION'SMALL

  CONTROL_DURATION := 0.0 ;
  WALL_CONTROL_DURATION := 0.0 ;

end ITERATION ;