Programmer 7500/MAX_PROGRAMMERS.iso/CLIPPER/MISC/ADATIMER.ZIP/TIMEL2.ADA

Text File | 1990-06-07 | 6.4 KB | 231 lines

-- Listing 2.  An implementation dependent package body.

with PORT, BIT_OPS;
package body POLLED_TIMER is

  TIMER_TICK : float := 1.0 / 1_193_180.0;
  TIMER_MAX  : float := 65_536.0 * TIMER_TICK;

  type Words is range 0 .. 65_535;
    for Words'SIZE use 32;

  TIMER_PERIOD : Words;
  LOW_BYTE     : integer;
  HIGH_BYTE    : integer;
  TIMER_MODE   : Modes;

  -- IBM PC physical addresses.
  TIMER_BASE_ADDRESS : constant
    := 16#40#;
  TIMER_2_REGISTER   : constant
    := TIMER_BASE_ADDRESS + 2;
  TIMER_CONTROL      : constant
    := TIMER_BASE_ADDRESS + 3;
  SPEAKER_CONTROL    : constant
    := 16#61#;

  -- IBM PC physical constants.
  TIMER_2_GATE    : constant
    := 2#0000_0001#;
  SPEAKER_ENABLE  : constant
    := 2#0000_0010#;

  -- Intel 8254 constants
  -- (See Intel 8254 data sheet.)
  TIMER_2_MODE_0          : constant
    := 2#10_11_000_0#;
  READBACK_TIMER_2_STATUS : constant
    := 2#11_10_100_0#;
  TIMER_2_READ_COUNT      : constant
    := 2#11_01_100_0#;
  OUTPUT_FLAG             : constant
    := 2#1000_0000#;
  NOT_FINISHED            : constant
    := 0;

  -- Temporary variable (made global
  -- to avoid frequent elaboration).
  STATUS : integer;

  function Make_Word(HIGH_BYTE, LOW_BYTE : integer)
      return Words is
    WORD, HIGH, LOW : Words;
  begin
    HIGH := 256 * Words(HIGH_BYTE);
    LOW  := Words(LOW_BYTE);
    WORD := HIGH + LOW;
    return WORD;
  end Make_Word;

  function Lsb(WORD : Words) return integer is
    LOW : integer;
  begin
    LOW  := integer(WORD mod 256);
    return LOW;
  end Lsb;

  function Msb(WORD : Words) return integer is
    HIGH : integer;
  begin
    HIGH  := integer(WORD / 256);
    return HIGH;
  end Msb;

  -- The following is a Meridian 4.0 bug work-around.
  -- Meridian computes float(WORD) = negative when
  -- WORD is of type Words and greater than 32,767.
  function To_Float(WORD : Words) return float is
    HIGH, LOW : float;
  begin
    HIGH := float(Msb(WORD));
    LOW  := float(Lsb(WORD));
    return 256.0 * HIGH + LOW;
  end To_Float;

  procedure Set(PERIOD : Seconds;
                MODE   : Modes) is
  begin
    -- Check for range errors.
    if Dimensionless(PERIOD) > TIMER_MAX then
      raise INVALID_PERIOD;
    end if;
    if Dimensionless(PERIOD) < TIMER_TICK then
      raise INVALID_PERIOD;
    end if;
    -- Make sure the timer is stopped.
    Stop;
    -- Convert seconds into clock ticks.
    TIMER_PERIOD := Words(Dimensionless(PERIOD)
      /TIMER_TICK);
    -- Load the clock ticks into the timer.
    LOW_BYTE  := Lsb(TIMER_PERIOD);
    HIGH_BYTE := Msb(TIMER_PERIOD);
    PORT.Out_Byte(TIMER_2_REGISTER,LOW_BYTE);
    PORT.Out_Byte(TIMER_2_REGISTER,HIGH_BYTE);
    -- Set the mode (single or repreated).
    TIMER_MODE := MODE;
  end Set;

  procedure Start is
    use BIT_OPS; -- for "or" (bit set)
  begin
    -- Get current status.
    STATUS := PORT.In_Byte(SPEAKER_CONTROL);
    -- Set Timer 2 gate without affecting other control
    -- bits.
    STATUS := STATUS or TIMER_2_GATE;
    -- Put modified status.
    PORT.Out_Byte(SPEAKER_CONTROL,STATUS);
  end Start;

  procedure Restart is
    use BIT_OPS; -- for "or" (bit set)
  begin
    -- Load the clock ticks into the timer.
    PORT.Out_Byte(TIMER_2_REGISTER,LOW_BYTE);
    PORT.Out_Byte(TIMER_2_REGISTER,HIGH_BYTE);
    -- Start the timer.
    Start;
  end Restart;

  function Has_Expired return boolean is
    use BIT_OPS; -- for "and"
  begin
    -- Latch status.
    PORT.Out_Byte(TIMER_CONTROL,READBACK_TIMER_2_STATUS);
    STATUS := Port.In_Byte(TIMER_2_REGISTER);
    if (STATUS and OUTPUT_FLAG) = NOT_FINISHED then
      return FALSE;
    else
      case TIMER_MODE is
        when SINGLE =>
          return TRUE;
        when REPEATED =>
          Restart;
          return TRUE;
      end case;
    end if;
  end Has_Expired;

  procedure Stop is
    use BIT_OPS; -- for "and" and "not" (bit clear)
  begin
    -- Get current status.
    STATUS := PORT.In_Byte(SPEAKER_CONTROL);
    -- Clear Timer 2 gate without affecting other control
    -- bits.
    STATUS := STATUS and not TIMER_2_GATE;
    -- Put modified status.
    PORT.Out_Byte(SPEAKER_CONTROL,STATUS);
  end Stop;

  function Time_Used return Seconds is
    MSB, LSB : integer;
    CURRENT_VALUE, DIFFERENCE : Words;
    TIME : float;
  begin
    -- Latch the current count (without stopping
    -- the timer).
    PORT.Out_Byte(TIMER_CONTROL,TIMER_2_READ_COUNT);
    LSB := PORT.In_Byte(TIMER_2_REGISTER);
    MSB := PORT.In_Byte(TIMER_2_REGISTER);
    CURRENT_VALUE := Make_Word(MSB,LSB);
    DIFFERENCE := TIMER_PERIOD - CURRENT_VALUE;
    -- Meridian 4.0 incorrectly computes the next line.
    -- TIME := float(DIFFERENCE) * TIMER_TICK;
    TIME := To_Float(DIFFERENCE) * TIMER_TICK;
    return Type_Convert(TIME);
  end Time_Used;

  function Time_Left return Seconds is
    MSB, LSB : integer;
    CURRENT_VALUE : Words;
    TIME : float;
  begin
    -- Latch the current count (without stopping
    -- the timer).
    PORT.Out_Byte(TIMER_CONTROL,TIMER_2_READ_COUNT);
    LSB := PORT.In_Byte(TIMER_2_REGISTER);
    MSB := PORT.In_Byte(TIMER_2_REGISTER);
    CURRENT_VALUE := Make_Word(MSB,LSB);
    -- Meridian 4.0 incorrectly computes the next line.
    -- TIME := float(CURRENT_VALUE) * TIMER_TICK;
    TIME := To_Float(CURRENT_VALUE) * TIMER_TICK;
    return Type_Convert(TIME);
  end Time_Left;

  function Max_Period return Seconds is
  begin
    return Type_Convert(TIMER_MAX);
  end Max_Period;

  function Single_Tick return Seconds is
  begin
    return Type_Convert(TIMER_TICK);
  end Single_Tick;

  -- This package uses Timer 2, which is
  -- usually used to beep the speaker.
  -- This procedure disables the speaker.
  procedure Turn_Off_Speaker is
    use BIT_OPS; -- for "and" (bit clear)
  begin
    -- Get current status.
    STATUS := PORT.In_Byte(SPEAKER_CONTROL);
    -- Clear SPEAKER_ENABLE bit without affecting
    -- other control bits.
    STATUS := STATUS and not SPEAKER_ENABLE;
    -- Put modified status.
    PORT.Out_Byte(SPEAKER_CONTROL,STATUS);
  end Turn_Off_Speaker;

  procedure Initialize_Timer_2 is
  begin
    PORT.Out_Byte(TIMER_CONTROL,TIMER_2_MODE_0);
  end Initialize_Timer_2;

begin
  Turn_Off_Speaker;  -- so we won't hear the timer!
  Initialize_Timer_2;
end POLLED_TIMER;