Subversion Repositories ht46f47_simulator

unit HT46F47;

interface

type

  Nibble = 0..15;

  TRom = array[0..$FF] of byte;

  THT46F47 = class(TObject)

  strict private

    procedure WaitMs(milliseconds: integer);

  strict protected

    // ROM

    // Registers

    FPC: byte;

    FReturnAddress: byte;

    FPage: Nibble;

    FRegA: Nibble;

    FRegB: Nibble;

    FRegC: Nibble;

    FRegD: Nibble;

    FCalledOnce: boolean;

    // In

    FS1: boolean;

    FS2: boolean;

    FDIn: Nibble;

    FAD1: Nibble;

    FAD2: Nibble;

    // Out

    FPWM: Nibble;

    FPortOut: Nibble;

  public

    // ROM

    ROM: TRom;

    property FROM: TRom read ROM;

    // Registers

    property PC: byte read FPC;

    property ReturnAddress: byte read FReturnAddress;

    property Page: Nibble read FPage;

    property RegA: Nibble read FRegA;

    property RegB: Nibble read FRegB;

    property RegC: Nibble read FRegC;

    property RegD: Nibble read FRegD;

    // In

    property S1: boolean read FS1 write FS1;

    property S2: boolean read FS2 write FS2;

    property DIn: Nibble read FDIn write FDIn;

    property AD1: Nibble read FAD1 write FAD1;

    property AD2: Nibble read FAD2 write FAD2;

    // Out

    property PWM: Nibble read FPWM;

    property PortOut: Nibble read FPortOut;

    // Functions

    constructor Create;

    procedure Step;

    procedure Reset;

  end;

implementation

uses

  SysUtils, Forms;

{ THT46F47 }

constructor THT46F47.Create;

var

  i: integer;

begin

  for i := Low(FROM) to High(FROM) do

  begin

    ROM[i] := $00;

  end;

  Reset;

end;

procedure THT46F47.Reset;

begin

  // Internal

  FPC := 0;

  FReturnAddress := 0;

  FPage := 0;

  FRegA := 0; // Note: The registers don't seem to be reset in the actual chip, if a "soft reset" is done

  FRegB := 0;

  FRegC := 0;

  FRegD := 0;

  FCalledOnce := false;

  // In

  FS1 := false;

  FS2 := false;

  FDIn := 0;

  FAD1 := 0;

  FAD2 := 0;

  // Out

  FPWM := 0;

  FPortOut := 0;

end;

procedure THT46F47.Step;

var

  Instruction: byte;

  ProgramCounterNext: Byte;

  ProgramCounterCurrent: Byte;

begin

  Instruction := FROM[FPC];

  ProgramCounterCurrent := FPC;

  ProgramCounterNext := FPC+1;

  try

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    10  LED 0000        PORT 0

    11  LED 0001        PORT 1

    12  LED 0010        PORT 2

    13  LED 0011        PORT 3

    14  LED 0100        PORT 4

    15  LED 0101        PORT 5

    16  LED 0110        PORT 6

    17  LED 0111        PORT 7

    18  LED 1000        PORT 8

    19  LED 1001        PORT 9

    1A  LED 1010        PORT 10

    1B  LED 1011        PORT 11

    1C  LED 1100        PORT 12

    1D  LED 1101        PORT 13

    1E  LED 1110        PORT 14

    1F  LED 1111        PORT 15

    *)

    if (Instruction >= $10) and (Instruction <= $1F) then

    begin

      FPortOut := Instruction and $F;

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    20  WAIT 1ms

    21  WAIT 2ms

    22  WAIT 5ms

    23  WAIT 10ms

    24  WAIT 20ms

    25  WAIT 50ms

    26  WAIT 100ms

    27  WAIT 200ms

    28  WAIT 500ms

    29  WAIT 1s

    2A  WAIT 2s

    2B  WAIT 5s

    2C  WAIT 10s

    2D  WAIT 20s

    2E  WAIT 30s

    2F  WAIT 60s

    *)

    case Instruction of

      $20: WaitMs(1);      // WAIT 1ms

      $21: WaitMs(2);      // WAIT 2ms

      $22: WaitMs(5);      // WAIT 5ms

      $23: WaitMs(10);     // WAIT 10ms

      $24: WaitMs(20);     // WAIT 20ms

      $25: WaitMs(50);     // WAIT 50ms

      $26: WaitMs(100);    // WAIT 100ms

      $27: WaitMs(200);    // WAIT 200ms

      $28: WaitMs(500);    // WAIT 500ms

      $29: WaitMs(1000);   // WAIT 1s

      $2A: WaitMs(2000);   // WAIT 2s

      $2B: WaitMs(5000);   // WAIT 5s

      $2C: WaitMs(10000);  // WAIT 10s

      $2D: WaitMs(20000);  // WAIT 20s

      $2E: WaitMs(30000);  // WAIT 30s

      $2F: WaitMs(60000);  // WAIT 60s

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    30  JUMP -0         HALT

    31  JUMP -1

    32  JUMP -2

    33  JUMP -3

    34  JUMP -4

    35  JUMP -5

    36  JUMP -6

    37  JUMP -7

    38  JUMP -8

    39  JUMP -9

    3A  JUMP -10

    3B  JUMP -11

    3C  JUMP -12

    3D  JUMP -13

    3E  JUMP -14

    3F  JUMP -15

    *)

    if (Instruction >= $30) and (Instruction <= $3F) then

    begin

      ProgramCounterNext := ProgramCounterCurrent - (Instruction and $F);

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    40  SET A=0

    41  SET A=1

    42  SET A=2

    43  SET A=3

    44  SET A=4

    45  SET A=5

    46  SET A=6

    47  SET A=7

    48  SET A=8

    49  SET A=9

    4A  SET A=10

    4B  SET A=11

    4C  SET A=12

    4D  SET A=13

    4E  SET A=14

    4F  SET A=15

    *)

    if (Instruction >= $40) and (Instruction <= $4F) then

    begin

      FRegA := Instruction and $F;

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    50

    51  SET B=A

    52  SET C=A

    53  SET D=A

    54  SET Dout=A

    55  SET Dout.0=A.0

    56  SET Dout.1=A.0

    57  SET Dout.2=A.0

    58  SET Dout.3=A.0

    59  SET PWM=A

    5A

    5B

    5C

    5D

    5E

    5F

    *)

    case Instruction of

      $51: FRegB := FRegA;     // SET B=A

      $52: FRegC := FRegA;     // SET C=A

      $53: FRegD := FRegA;     // SET D=A

      $54: FPortOut := FRegA;  // SET Dout=A

      $55: FPortOut := ((FRegA and 1) shl 0) + (PortOut and 14); // SET Dout.0=A.0

      $56: FPortOut := ((FRegA and 1) shl 1) + (PortOut and 13); // SET Dout.1=A.0

      $57: FPortOut := ((FRegA and 1) shl 2) + (PortOut and 11); // SET Dout.2=A.0

      $58: FPortOut := ((FRegA and 1) shl 3) + (PortOut and  7); // SET Dout.3=A.0

      $59: FPWM := FRegA;      // SET PWM=A

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    60

    61  SET A=B

    62  SET A=C

    63  SET A=D

    64  SET A=Din

    65  SET A=Din.0

    66  SET A=Din.1

    67  SET A=Din.2

    68  SET A=Din.3

    69  SET A=AD1

    6A  SET A=AD2

    6B

    6C

    6D

    6E

    6F

    *)

    case Instruction of

      $61: FRegA := FRegB; // SET A=B

      $62: FRegA := FRegC; // SET A=C

      $63: FRegA := FRegD; // SET A=D

      $64: FRegA := DIn;  // SET A=Din

      $65: FRegA := (DIn and 1) shr 0;  // SET A=Din.0

      $66: FRegA := (DIn and 2) shr 1;  // SET A=Din.1

      $67: FRegA := (DIn and 4) shr 1;  // SET A=Din.2

      $68: FRegA := (DIn and 8) shr 1;  // SET A=Din.3

      $69: FRegA := AD1;

      $6A: FRegA := AD2;

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    70

    71  SET A=A+1

    72  SET A=A-1

    73  SET A=A+B

    74  SET A=A-B

    75  SET A=A*B

    76  SET A=A/B

    77  SET A=A&B                       AND

    78  SET A=A|B                       OR

    79  SET A=A^B                       XOR

    7A  SET A=~A                        NOT

    7B

    7C

    7D

    7E

    7F

    *)

    case Instruction of

      $71: FRegA := FRegA + 1;      // SET A=A+1

      $72: FRegA := FRegA - 1;      // SET A=A-1

      $73: FRegA := FRegA + FRegB;   // SET A=A+B

      $74: FRegA := FRegA - FRegB;   // SET A=A-B

      $75: FRegA := FRegA * FRegB;   // SET A=A*B

      $76: begin

             if FRegB = 0 then

               FRegA := $F // this is the actual behavior of the microchip (program 40 51 45 76 54 30)

             else

               FRegA := FRegA div FRegB; // SET A=A/B

           end;

      $77: FRegA := FRegA and FRegB; // SET A=A&B                       AND

      $78: FRegA := FRegA  or FRegB; // SET A=A|B                       OR

      $79: FRegA := FRegA xor FRegB; // SET A=A^B                       XOR

      $7A: FRegA := not FRegA;      // SET A=~A                 NOT

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    80  PAGE 0                          Page is used by JUMP, CALL, CTIMES and DTIMES

    81  PAGE 1

    82  PAGE 2

    83  PAGE 3

    84  PAGE 4

    85  PAGE 5

    86  PAGE 6

    87  PAGE 7

    88  PAGE 8

    89  PAGE 9

    8A  PAGE A

    8B  PAGE B

    8C  PAGE C

    8D  PAGE D

    8E  PAGE E

    8F  PAGE F

    *)

    if (Instruction >= $80) and (Instruction <= $8F) then

    begin

      FPage := Instruction and $F;

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    90  JUMP <PAGE>0

    91  JUMP <PAGE>1

    92  JUMP <PAGE>2

    93  JUMP <PAGE>3

    94  JUMP <PAGE>4

    95  JUMP <PAGE>5

    96  JUMP <PAGE>6

    97  JUMP <PAGE>7

    98  JUMP <PAGE>8

    99  JUMP <PAGE>9

    9A  JUMP <PAGE>A

    9B  JUMP <PAGE>B

    9C  JUMP <PAGE>C

    9D  JUMP <PAGE>D

    9E  JUMP <PAGE>E

    9F  JUMP <PAGE>F

    *)

    if (Instruction >= $90) and (Instruction <= $9F) then

    begin

      ProgramCounterNext := (FPage shl 4) + (Instruction and $F);

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    A0  CTIMES <PAGE>0                  IF C>0 THEN ( C=C-1 ; JUMP <PAGE>X ) ELSE CONTINUE

    A1  CTIMES <PAGE>1

    A2  CTIMES <PAGE>2

    A3  CTIMES <PAGE>3

    A4  CTIMES <PAGE>4

    A5  CTIMES <PAGE>5

    A6  CTIMES <PAGE>6

    A7  CTIMES <PAGE>7

    A8  CTIMES <PAGE>8

    A9  CTIMES <PAGE>9

    AA  CTIMES <PAGE>A

    AB  CTIMES <PAGE>B

    AC  CTIMES <PAGE>C

    AD  CTIMES <PAGE>D

    AE  CTIMES <PAGE>E

    AF  CTIMES <PAGE>F

    *)

    if (Instruction >= $A0) and (Instruction <= $AF) then

    begin

      if FRegC > 0 then

      begin

        Dec(FRegC);

        FReturnAddress     := ProgramCounterCurrent;

        ProgramCounterNext := (FPage shl 4) + (Instruction and $F);

      end;

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    B0  DTIMES <PAGE>0                  IF D>0 THEN ( D=D-1 ; JUMP <PAGE>X ) ELSE CONTINUE

    B1  DTIMES <PAGE>1

    B2  DTIMES <PAGE>2

    B3  DTIMES <PAGE>3

    B4  DTIMES <PAGE>4

    B5  DTIMES <PAGE>5

    B6  DTIMES <PAGE>6

    B7  DTIMES <PAGE>7

    B8  DTIMES <PAGE>8

    B9  DTIMES <PAGE>9

    BA  DTIMES <PAGE>A

    BB  DTIMES <PAGE>B

    BC  DTIMES <PAGE>C

    BD  DTIMES <PAGE>D

    BE  DTIMES <PAGE>E

    BF  DTIMES <PAGE>F

    *)

    if (Instruction >= $B0) and (Instruction <= $BF) then

    begin

      if FRegD > 0 then

      begin

        Dec(FRegD);

        FReturnAddress     := ProgramCounterCurrent;

        ProgramCounterNext := (FPage shl 4) + (Instruction and $F);

      end;

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    C0

    C1  SKIP_IF A>B

    C2  SKIP_IF A<B

    C3  SKIP_IF A=B

    C4  SKIP_IF Din.0=1

    C5  SKIP_IF Din.1=1

    C6  SKIP_IF Din.2=1

    C7  SKIP_IF Din.3=1

    C8  SKIP_IF Din.0=0

    C9  SKIP_IF Din.1=0

    CA  SKIP_IF Din.2=0

    CB  SKIP_IF Din.3=0

    CC  SKIP_IF S1=0

    CD  SKIP_IF S2=0

    CE  SKIP_IF S1=1

    CF  SKIP_IF S2=1

    *)

    case Instruction of

      $C1: if FRegA > FRegB then Inc(ProgramCounterNext);

      $C2: if FRegA < FRegB then Inc(ProgramCounterNext);

      $C3: if FRegA = FRegB then Inc(ProgramCounterNext);

      $C4: if ((Din and 1) shr 0) = 1 then Inc(ProgramCounterNext);

      $C5: if ((Din and 2) shr 1) = 1 then Inc(ProgramCounterNext);

      $C6: if ((Din and 4) shr 2) = 1 then Inc(ProgramCounterNext);

      $C7: if ((Din and 8) shr 3) = 1 then Inc(ProgramCounterNext);

      $C8: if ((Din and 1) shr 0) = 0 then Inc(ProgramCounterNext);

      $C9: if ((Din and 2) shr 1) = 0 then Inc(ProgramCounterNext);

      $CA: if ((Din and 4) shr 2) = 0 then Inc(ProgramCounterNext);

      $CB: if ((Din and 8) shr 3) = 0 then Inc(ProgramCounterNext);

      $CC: if S1 = false then Inc(ProgramCounterNext);

      $CD: if S2 = false then Inc(ProgramCounterNext);

      $CE: if S1 = true then Inc(ProgramCounterNext);

      $CF: if S2 = true then Inc(ProgramCounterNext);

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    D0  CALL <PAGE>0

    D1  CALL <PAGE>1

    D2  CALL <PAGE>2

    D3  CALL <PAGE>3

    D4  CALL <PAGE>4

    D5  CALL <PAGE>5

    D6  CALL <PAGE>6

    D7  CALL <PAGE>7

    D8  CALL <PAGE>8

    D9  CALL <PAGE>9

    DA  CALL <PAGE>A

    DB  CALL <PAGE>B

    DC  CALL <PAGE>C

    DD  CALL <PAGE>D

    DE  CALL <PAGE>E

    DF  CALL <PAGE>F

    *)

    if (Instruction >= $D0) and (Instruction <= $DF) then

    begin

      FCalledOnce        := true;

      FReturnAddress     := ProgramCounterNext;

      ProgramCounterNext := (FPage shl 4) + (Instruction and $F)

    end;

    (*

    ----------------------------------------------------

    Code        Assembly        Alternative     Comment

    ----------------------------------------------------

    E0  RET

    *)

    if Instruction = $E0 then

    begin

      if not FCalledOnce then

      begin

        // "Freeze" is the behavior of the actual chip (see test program 41 54 27 42 54 27 E0 7A 27 54 33)

        ProgramCounterNext := ProgramCounterCurrent;

      end

      else

      begin

        ProgramCounterNext := FReturnAddress;

      end;

    end;

  finally

    FPC := ProgramCounterNext;

  end;

end;

procedure THT46F47.WaitMs(milliseconds: integer);

var

  i: integer;

begin

  for i := 0 to milliseconds div 10 do

  begin

    Sleep(10);

    Application.ProcessMessages;

    if Application.Terminated then break;

  end;

end;

end.