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

Text File | 1988-05-03 | 5.6 KB | 167 lines

-- Iteration control package body

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

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
--  MINIMUM_TIME : DURATION := 10.0 ; -- suggested minimum value for fast machines
  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 ;
  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
--      choose 1st and 3rd to uncomment, 2nd and 4th to comment if overflow
--      TEMP_TIME := FLOAT ( TEST_DURATION - CONTROL_DURATION ) ;
      TEMP_TIME := FLOAT ( (TEST_DURATION-CONTROL_DURATION)*1000 ) ;
--      TEMP_TIME := (1_000_000.0 * TEMP_TIME) /
      TEMP_TIME := (1_000.0 * TEMP_TIME) /
                   ( FLOAT ( ITERATION_COUNT ) * FLOAT (CHECK) );
      if TEMP_TIME < 0.0 then
        CPU_TIME := 0.0 ;
      else
        CPU_TIME := DURATION ( TEMP_TIME ) ;
      end if ;
    exception
      when others =>  -- bail out if trouble in conversion
        CPU_TIME := 0.0 ;
    end ;
--
    begin
--      choose 1st and 3rd to uncomment, 2nd and 4th to comment if overflow
--      TEMP_TIME := FLOAT ( WALL_TEST_DURATION - WALL_CONTROL_DURATION ) ;
      TEMP_TIME := FLOAT ( (WALL_TEST_DURATION-WALL_CONTROL_DURATION)*1000 ) ;
--      TEMP_TIME := (1_000_000.0 * TEMP_TIME) /
      TEMP_TIME := (1_000.0 * TEMP_TIME) /
                   ( FLOAT ( ITERATION_COUNT ) * FLOAT (CHECK) );
      if TEMP_TIME < 0.0 then
        WALL_TIME := 0.0 ;
      else
        WALL_TIME := DURATION ( TEMP_TIME ) ;
      end if ;
    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
      if TEST_DURATION < CONTROL_DURATION and ITERATION_COUNT < 1024 then
        STABLE := FALSE ;
      else
        STABLE := TRUE ;
      end if ;
    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,     (10.0 fast machines)
--                                   100*SYSTEM.TICK,
--                                   100*DURATION'SMALL

  CONTROL_DURATION := 0.0 ;
  WALL_CONTROL_DURATION := 0.0 ;

end ITERATION ;