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.