unit I8253;

interface

uses
  Classes, SysUtils;

type
  TCounterMode = 0..5;
  TReadLoad = (rlCounterLatching, rlMostByteOnly,
    rlLeastByteOnly, rlLeastThenMostByte);
  TByteKind = (bkLeast, bkMost);
  TOutputEvent = procedure (Output: Boolean) of object;

  { TCounter }

  TCounter = record
  private
    FOnOutputChange: TOutputEvent;
  public
    ResetValue: Word;
    Value: Word;
    Mode: TCounterMode;
    Bcd: Boolean;
    ReadLoad: TReadLoad;
    ReadLoadByteKind: TByteKind;
    StorageValue: Word;
    procedure Load(Data: Byte);
    function Read: Byte;
    procedure Control(Data: Byte);
    procedure CountDown;
    property OnOutputChange: TOutputEvent read FOnOutputChange
      write FOnOutputChange;
  end;

  { T8253 }

  T8253 = class
    Counters: array[0..2] of TCounter;
    procedure Write(Address: Word; Data: Byte);
    function Read(Address: Word): Byte;
    constructor Create;
  end;


implementation

{ TCounter }

procedure TCounter.Load(Data: Byte);
begin
  case ReadLoad of
    rlCounterLatching: ;
    rlLeastByteOnly: Value := (ResetValue and $ff00) or Data;
    rlMostByteOnly: Value := (ResetValue and $ff) or (Data shl 8);
    rlLeastThenMostByte: begin
      case ReadLoadByteKind of
        bkLeast: begin
          Value := (Value and $ff00) or Data;
          ReadLoadByteKind := bkMost;
        end;
        bkMost: begin
          Value := (Value and $ff) or (Data shl 8);
          ReadLoadByteKind := bkLeast;
        end;
      end;
    end;
  end;
end;

function TCounter.Read: Byte;
begin
  case ReadLoad of
    rlCounterLatching: begin
      case ReadLoadByteKind of
        bkLeast: begin
          Result := StorageValue and $ff;
          ReadLoadByteKind := bkMost;
        end;
        bkMost: begin
          Result := (StorageValue shr 8) and $ff;
          ReadLoadByteKind := bkLeast;
        end;
      end;
    end;
    else begin
      case ReadLoadByteKind of
        bkLeast: begin
          Result := Value and $ff;
          ReadLoadByteKind := bkMost;
        end;
        bkMost: begin
          Result := (Value shr 8) and $ff;
          ReadLoadByteKind := bkLeast;
        end;
      end;
    end;
  end;
end;

procedure TCounter.Control(Data: Byte);
begin
  ReadLoad := TReadLoad((Data and $30) shr 4);
  case ReadLoad of
    rlCounterLatching: StorageValue := Value;
    rlMostByteOnly: ReadLoadByteKind := bkMost;
    rlLeastByteOnly: ReadLoadByteKind := bkLeast;
    rlLeastThenMostByte: ReadLoadByteKind := bkLeast;
  end;
  Mode := (Data and $e) shr 1;
  Bcd := (Data and 1) > 0;
end;

procedure TCounter.CountDown;
begin
  if Value > 0 then begin
    Dec(Value);
    if Value = 0 then begin
      if Assigned(FOnOutputChange) then
        FOnOutputChange(True);
    end;
  end;
end;

{ T8253 }

procedure T8253.Write(Address: Word; Data: Byte);
var
  CounterNum: Byte;
begin
  case Address of
    0: Counters[0].Load(Data);
    1: Counters[1].Load(Data);
    2: Counters[2].Load(Data);
    3: begin
      CounterNum := (Data and $c0) shr 6;
      Counters[CounterNum].Control(Data);
    end;
  end;
end;

function T8253.Read(Address: Word): Byte;
begin
  case Address of
    0: Result := Counters[0].Read;
    1: Result := Counters[1].Read;
    2: Result := Counters[2].Read;
    3: Result := 0; // Illegal
  end;
end;

constructor T8253.Create;
var
  I: Integer;
begin
  for I := 0 to 2 do
    Counters[I].Value := 0;
end;

end.