source: branches/virtcpu fixed int/UMachine.pas

unit UMachine;

{$mode delphi}

interface

uses
  Classes, SysUtils, UCpu, syncobjs;

type
  { TMachine }

  TMachine = class(TComponent)
  private
    FOnSerialOutput: TNotifyEvent;
    function CpuInput(Port: T): T;
    procedure CpuOutput(Port, Value: T);
    procedure DoSerialOutput;
  public
    Memory: array of T;
    Cpu: TCpu;
    VideoBase: T;
    VideoWidth: T;
    VideoHeight: T;
    SerialBufferInput: array of Char;
    SerialBufferOutput: array of Char;
    SerialBufferLock: TCriticalSection;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SerialInput(C: Char);
    property OnSerialOutput: TNotifyEvent read FOnSerialOutput write FOnSerialOutput;
  end;

implementation

{ TMachine }

constructor TMachine.Create(AOwner: TComponent);
begin
  inherited;
  SerialBufferLock := TCriticalSection.Create;
  Cpu := TCpu.Create(nil);
  Cpu.OnInput := CpuInput;
  Cpu.OnOutput := CpuOutput;
end;

destructor TMachine.Destroy;
begin
  Cpu.Stop;
  FreeAndNil(Cpu);
  FreeAndNil(SerialBufferLock);
  inherited;
end;

procedure TMachine.SerialInput(C: Char);
begin
  SerialBufferLock.Acquire;
  try
    SetLength(SerialBufferInput, Length(SerialBufferInput) + 1);
    SerialBufferInput[High(SerialBufferInput)] := C;
  finally
    SerialBufferLock.Release;
  end;
end;

function TMachine.CpuInput(Port: T): T;
begin
  Result := 0;
  case Port of
    0: begin
      SerialBufferLock.Acquire;
      try
        while (Length(SerialBufferInput) = 0) and not Cpu.Terminated do begin
          try
            SerialBufferLock.Release;
            Sleep(10);
          finally
            SerialBufferLock.Acquire;
          end;
        end;
          if Length(SerialBufferInput) > 0 then begin
          Result := Ord(SerialBufferInput[0]);
          if Length(SerialBufferInput) > 1 then
            Move(SerialBufferInput[1], SerialBufferInput[0], Length(SerialBufferInput) - 1);
          SetLength(SerialBufferInput, Length(SerialBufferInput) - 1);
        end else Result := 0;
      finally
        SerialBufferLock.Release;
      end;
    end;
    1: begin
      Result := Length(SerialBufferInput);
    end;
  end;
end;

procedure TMachine.CpuOutput(Port, Value: T);
begin
  case Port of
    0: begin
      SerialBufferLock.Acquire;
      try
        SetLength(SerialBufferOutput, Length(SerialBufferOutput) + 1);
        SerialBufferOutput[High(SerialBufferOutput)] := Chr(Value);
      finally
        SerialBufferLock.Release;
      end;
      TThread.Synchronize(Cpu.Thread, DoSerialOutput);
    end;
  end;
end;

procedure TMachine.DoSerialOutput;
begin
  if Assigned(FOnSerialOutput) then
    FOnSerialOutput(Self);
end;

end.