Initial check in

This commit is contained in:
2026-01-03 18:53:14 +01:00
commit b9305ab8af
36 changed files with 6720 additions and 0 deletions
@@ -0,0 +1,205 @@
unit m.cfg;
interface
uses
m.base,
m.cfg.types;
type
TmodCFG = class( TmodBase, ICFG)
// ------------------------------------------------------------
// ICFG
// ------------------------------------------------------------
protected
function GetCapabilities: Int64;
function GetSerialNumber: AnsiString;
function GetIdentifier : AnsiString;
procedure SetSerialNumber( value: AnsiString);
procedure SetIdentifier( value: AnsiString);
end;
implementation
{ TmodCFG }
// @@@: ICFG ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// ICFG
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// get capabilities
// ================================================================================================
function TmodCFG.GetCapabilities: Int64;
var
buf : array[0..7] of AnsiChar;
cnt : cardinal;
begin
result := 1;
if Assigned(fDevice) then
begin
with fDevice do
begin
Open;
if (VendorID = $16d0) and (ProductID = $0712) then
begin
cnt := 0;
if Pipe0.Transfer( $80, // IN
$E0, // Get Serial
$00, // Value (not used)
$00, // Index (not used)
$08, // Length
@buf, // Buffer to receive data
8, // Length of buffer
cnt, // Transferred bytes
nil) then // Overlapped (not used)
begin
Result := PInt64(@buf)^;
end
end;
Close;
end
end
else
// raise
end;
// ================================================================================================
// get serial number
// ================================================================================================
function TmodCFG.GetSerialNumber: AnsiString;
var
buf : array[0..7] of AnsiChar;
cnt : cardinal;
i : integer;
begin
result := '';
if Assigned(fDevice) then
begin
with fDevice do
begin
Open;
if (VendorID = $16d0) and (ProductID = $0712) then
begin
cnt := 0;
if Pipe0.Transfer( $80, // IN
$E1, // Get Serial
$00, // Value (not used)
$00, // Index (not used)
$08, // Length
@buf, // Buffer to receive data
8, // Length of buffer
cnt, // Transferred bytes
nil) then // Overlapped (not used)
begin
for i:=0 to 7 do
if buf[i] in ['a'..'z','A'..'Z','0'..'9','$','.','_','-']
then Result := Result + buf[i]
else break
end
end;
Close;
end
end
else
// raise
end;
// ================================================================================================
// set serial number
// ================================================================================================
procedure TmodCFG.SetSerialNumber(value: AnsiString);
begin
if Assigned(fDevice) then
begin
end
else
// raise
end;
// ================================================================================================
// get identifier
// ================================================================================================
function TmodCFG.GetIdentifier: AnsiString;
var
buf : array[0..7] of AnsiChar;
cnt : cardinal;
i : integer;
begin
result := '';
if Assigned(fDevice) then
begin
with fDevice do
begin
Open;
if (VendorID = $16d0) and (ProductID = $0712) then
begin
cnt := 0;
if Pipe0.Transfer( $80, // IN
$E2, // Get Serial
$00, // Value (not used)
$00, // Index (not used)
$08, // Length
@buf, // Buffer to receive data
8, // Length of buffer
cnt, // Transferred bytes
nil) then // Overlapped (not used)
begin
for i:=0 to 7 do
if buf[i] in ['a'..'z','A'..'Z','0'..'9','$','.','_','-']
then Result := Result + buf[i]
else break
end
end;
Close;
end
end
else
// raise
end;
// ================================================================================================
// set identifier
// ================================================================================================
procedure TmodCFG.SetIdentifier(value: AnsiString);
begin
if Assigned(fDevice) then
begin
end
else
// raise
end;
end.
@@ -0,0 +1,28 @@
unit m.cfg.types;
interface
const
CFG_CAPS : byte = $E0;
CFG_SERIAL : byte = $E1;
CFG_IDENTIFIER : byte = $E2;
type
ICFG = interface
['{7B6D3FDA-4C46-4B21-8490-8E7A8AE8BEEA}']
function GetCapabilities: Int64;
function GetSerialNumber: AnsiString;
function GetIdentifier : AnsiString;
procedure SetSerialNumber( value: AnsiString);
procedure SetIdentifier( value: AnsiString);
property Capabilities : Int64 read GetCapabilities;
property SerialNumber : AnsiString read GetSerialNumber write SetSerialNumber;
property Identifier : AnsiString read GetIdentifier write SetIdentifier;
end;
implementation
end.
@@ -0,0 +1,65 @@
unit m.eeprom;
interface
uses
m.base,
m.eeprom.types;
type
TmodEEPROM = class( TmodBase, IEEPROM)
// ------------------------------------------------------------
// IEEPROM
// ------------------------------------------------------------
protected
function ReadPage( Page : word; Buffer: pointer): integer;
function WritePage( Page : word; Buffer: pointer): integer;
end;
implementation
{ TmodEEPROM }
// @@@: IEEPROM +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IEEPROM
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// read page
// ================================================================================================
function TmodEEPROM.ReadPage(Page: word; Buffer: pointer): integer;
begin
if Assigned( fDevice) then
begin
end
else
; // raise
result := 0
end;
// ================================================================================================
// write page
// ================================================================================================
function TmodEEPROM.WritePage(Page: word; Buffer: pointer): integer;
begin
if Assigned( fDevice) then
begin
end
else
;// raise
result := 0
end;
end.
@@ -0,0 +1,14 @@
unit m.eeprom.types;
interface
type
IEEPROM = interface
['{DF79DCE2-900B-41FF-B128-3C6CBC9E34D9}']
function ReadPage( PageNumber : word; Buffer: pointer): integer;
function WritePage( PageNumber : word; Buffer: pointer): integer;
end;
implementation
end.
@@ -0,0 +1,185 @@
unit m.iic;
interface
uses
m.base,
m.iic.types;
type
TmodIIC = class( TmodBase, IIIC)
protected
function Wait( addr : word;
tmo : word = 100): TIICStatus;
function Write( addr : word;
count : byte;
buffer : pointer;
tmo : word = 100): TIICStatus;
function Read( addr : word;
count : byte;
buffer : pointer;
tmo : word = 100): TIICStatus;
function ReadRSW( addr : word;
subaddr : word;
count : byte;
buffer : pointer;
tmo : word = 100): TIICStatus;
end;
implementation
uses
windows, math,
mr.dev.usb.pipe;
function CyWORD( value: word): word; overload;
begin
result := (LoByte(value) shl 8) or HiByte(value);
end;
function CyWORD( value: byte): word; overload;
begin
result := value shl 8;
end;
{ TmodIIC }
// @@@: IIIC ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IIIC
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// wait
// ================================================================================================
function TmodIIC.Wait(addr: word; tmo: word): TIICStatus;
begin
result := IIC_TMO;
end;
// ================================================================================================
// write
// ================================================================================================
function TmodIIC.Write(addr: word; count: byte; buffer: pointer; tmo: word): TIICStatus;
var
buf: TIICPacket;
len: cardinal;
p01: TPipe;
p81: TPipe;
begin
result := IIC_TMO;
if Assigned(fDevice) then
begin
p01 := fDevice.Pipes[$01];
p81 := fDevice.Pipes[$81];
if Assigned(p01) and Assigned(p81) then
begin
FillChar( buf, sizeof(buf), 0);
buf.head.command := IIC_WRITE;
buf.head.timeout := tmo;
buf.head.address := CyWORD(addr);
buf.head.length := min(count, 32);
MoveMemory(@buf.data[0], buffer, buf.head.length);
p01.Write( buf, sizeof( TIICPacket), len);
p81.Read( buf, sizeof( TIICPacketHead), len)
end
end
end;
// ================================================================================================
// read
// ================================================================================================
function TmodIIC.Read(addr: word; count: byte; buffer: pointer; tmo: word): TIICStatus;
var
buf: TIICPacket;
len: cardinal;
p01: TPipe;
p81: TPipe;
begin
result := IIC_TMO;
if Assigned(fDevice) then
begin
p01 := fDevice.Pipes[$01];
p81 := fDevice.Pipes[$81];
if Assigned(p01) and Assigned(p81) then
begin
FillChar( buf, sizeof(buf), 0);
buf.head.command := IIC_READ;
buf.head.timeout := tmo;
buf.head.address := CyWORD(addr);
buf.head.length := min(count, 32);
if p01.Write( buf, sizeof( TIICPacketHead), len) then
begin
p81.Read( buf, sizeof( TIICPacket), len);
result := TIICStatus(buf.head.timeout);
if result = IIC_OK then
MoveMemory(buffer, @buf.data[0], buf.head.length)
end;
end
end
end;
// ================================================================================================
// read with repeated start condition, 16 bit sub address
// ================================================================================================
function TmodIIC.ReadRSW(addr: word; subaddr: word; count: byte; buffer: pointer; tmo: word): TIICStatus;
var
buf: TIICPacket;
len: cardinal;
p01: TPipe;
p81: TPipe;
begin
result := IIC_TMO;
if Assigned(fDevice) then
begin
p01 := fDevice.Pipes[$01];
p81 := fDevice.Pipes[$81];
if Assigned(p01) and Assigned(p81) then
begin
FillChar( buf, sizeof(buf), 0);
buf.head.command := IIC_READ_RSW;
buf.head.timeout := tmo;
buf.head.address := CyWORD(addr);
buf.head.subaddr := CyWORD(subaddr);
buf.head.length := min(count, 32);
p01.Write( buf, sizeof( TIICPacketHead), len);
p81.Read( buf, sizeof( TIICPacket), len);
MoveMemory(buffer, @buf.data[0], buf.head.length)
end
end
end;
end.
@@ -0,0 +1,64 @@
unit m.iic.types;
interface
type
TIICCommand =
(
IIC_READ = $80,
IIC_READ_RSW = $81,
IIC_READ_RSB = $81,
IIC_WRITE = $00
);
TIICPacketHead = packed record
command : TIICCommand;
address : WORD;
subaddr : WORD;
length : BYTE;
reserved : BYTE;
timeout : BYTE;
end;
TIICPacket = packed record
head : TIICPacketHead;
data : array [0..31] of BYTE;
end;
TIICStatus =
(
IIC_OK = 0, // IIC operation successfull
IIC_TMO = 1, // Timeout
IIC_ARB = 4, // bus arbitration error
IIC_NAK = 5, // no ACK from slave
IIC_EADR = 90, // Invalid address
IIC_ELEN = 91 // Invalid length
);
IIIC = interface
['{7D675CBC-2642-4DBD-B8FC-AEE5C3864E0E}']
function Wait( addr : word;
tmo : word): TIICStatus;
function Write( addr : word;
count : byte;
buffer : pointer;
tmo : word): TIICStatus;
function Read( addr : word;
count : byte;
buffer : pointer;
tmo : word): TIICStatus;
function ReadRSW( addr : word;
subaddr : word;
count : byte;
buffer : pointer;
tmo : word): TIICStatus;
end;
implementation
end.
@@ -0,0 +1,649 @@
unit m.jtag;
interface
uses
Classes,
m.base,
m.jtag.types;
type
TmodJTAG = class( TmodBase, IJTAG)
protected
// stat
nINIT : cardinal;
nTRST : cardinal;
nENDIR : cardinal;
nENDDR : cardinal;
nSTATE : cardinal;
nSIR : cardinal;
nSDR : cardinal;
nRUN : cardinal;
// high level functions
function scan( buffer: PCardinal;
maxcnt: byte): word;
function play( filename : string): boolean;
function playsvf( stm : TMemoryStream) : boolean;
// primitive functions
procedure init;
procedure trst( value : BYTE);
procedure ena( value : BYTE);
procedure endir( state : TJTAGState);
procedure enddr( state : TJTAGState);
procedure state( state : TJTAGState);
function sir( data : PBYTE; bitcount: WORD; last: byte=1): cardinal; virtual;
function sdr( data : PBYTE; bitcount: WORD; last: byte=1): cardinal; virtual;
function sdw( data : PBYTE; bitcount: WORD; last: byte=1): cardinal; virtual;
procedure run( state : TJTAGState; count: WORD);
procedure test;
end;
implementation
uses
Windows, Math, SysUtils, Diagnostics,
mr.dev.usb,
mr.dev.usb.pipe,
mr.dev.usb.pipe0,
jtag.svfLexer,
jtag.svfScanLexer,
jtag.svfParser,
jtag.svfProgram,
jtag.svfAstNode,
jtag.svfAstEndIR,
jtag.svfAstEndDR,
jtag.svfAstScan,
jtag.svfAstPrint,
jtag.svfAstComment,
jtag.svfAstRuntest,
jtag.svfAstState;
const
// EP0 comands
CMD_JTAG_INIT = $C0;
CMD_JTAG_RESET = $C1;
CMD_JTAG_ENABLE = $C2;
CMD_JTAG_STATUS = $C3;
CMD_JTAG_ENDIR = $C8;
CMD_JTAG_ENDDR = $C9;
CMD_JTAG_STATE = $CA;
CMD_JTAG_TRST = $CB;
CMD_JTAG_TEST = $CF;
// EP2 commands
CMD_JTAG_SCAN = $C0;
CMD_JTAG_SIR = $C1;
CMD_JTAG_SDR = $C2;
CMD_JTAG_RUN = $C3;
CMD_JTAG_SDW = $C4;
type
PcmdJTAG = ^TcmdJTAG;
TcmdJTAG = packed record
command : byte;
status : byte;
number : word;
id : cardinal;
data : array [0 .. 1023] of byte;
end;
PcmdJTAGHead = ^TcmdJTAGHead;
TcmdJTAGHead = packed record
command : byte;
status : byte;
number : word;
id : cardinal;
end;
PcmdJTAGScan = ^TcmdJTAGScan;
TcmdJTAGScan = packed record
head: TcmdJTAGHead;
count: byte;
dummy: array [0 .. 2] of byte;
id: array [0 .. 125] of cardinal;
// id: array [0..503] of byte;
end;
{ TmodJTAG }
function CyWORD( state: TJTAGState): word; overload;
begin
result := BYTE(state) shl 8
end;
function CyWORD( value: word): word; overload;
begin
result := (LoByte(value) shl 8) or HiByte(value);
end;
function CyWORD( value: byte): word; overload;
begin
result := value shl 8;
end;
// @@@: IJTAG +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IJTAG
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// scan
// ================================================================================================
function TmodJTAG.scan( buffer: PCardinal; maxcnt: byte): word;
var
cmd : TcmdJTAGScan;
rsp : TcmdJTAGScan;
len : cardinal;
i : integer;
pipe02: TPipe;
pipe84: TPipe;
begin
result := 0;
if Assigned(fDevice) then
with fDevice do
begin
pipe02 := Pipes[$02];
pipe84 := Pipes[$84];
if Assigned(pipe02) and Assigned(pipe84) then
begin
ZeroMemory(@rsp, sizeof(rsp));
ZeroMemory(@cmd, sizeof(cmd));
cmd.head.command := CMD_JTAG_SCAN;
if pipe02.Write(cmd, sizeof(TcmdJTAGHead), len) then
begin
sleep(100);
if pipe84.Read(rsp, sizeof(rsp), len) then
begin
result := rsp.count;
for i:=0 to min(result, maxcnt) -1 do
begin
Buffer^ := rsp.id[0];
INC(buffer)
end
end
end
end
end
end;
// ================================================================================================
// play
// ================================================================================================
function TmodJTAG.play( filename : string): boolean;
var
stm : TMemoryStream;
begin
result := false;
if FileExists(filename) then
begin
stm := TMemoryStream.Create;
stm.LoadFromFile(filename);
result := playsvf(stm);
stm.Free
end;
end;
// ================================================================================================
// play svf file
// ================================================================================================
function TmodJTAG.playsvf( stm: TMemoryStream) : boolean;
var
scn : TsvfScanLexer;
lex : TsvfLexer;
par : TsvfParser;
i,j : integer;
inst : AnsiString;
bits : integer;
cnt : integer;
last : byte;
data : PByteArray;
sRUN : TJTAGState;
sEND : TJTAGState;
sCNT : cardinal;
prg : TsvfProgram;
stmt : TsvfAstNode;
stRun : TsvfAstRuntest;
stSta : TsvfAstState;
stScn : TsvfAstScan;
begin
nINIT := 0;
nTRST := 0;
nENDIR := 0;
nENDDR := 0;
nSTATE := 0;
nSIR := 0;
nSDR := 0;
nRUN := 0;
result := false;
if Assigned(stm) then
begin
try
lex := TsvfLexer .Create( stm);
par := TsvfParser .Create( lex);
scn := TsvfScanLexer .Create( lex.InputState);
prg := par.svf(scn);
for i:=0 to prg.StatementCount -1 do
begin
stmt := prg.Statements[i];
// ------------------------------------------------------
// ENDIR (2)
// ------------------------------------------------------
if stmt is TsvfAstEndIR then
case TsvfAstEndIR(stmt).State of
stRESET : endir(TS_RESET );
stIDLE : endir(TS_IDLE );
stIRPAUSE : endir(TS_IRPAUSE );
stDRPAUSE : endir(TS_DRPAUSE );
else
end
// ------------------------------------------------------
// ENDDR (3)
// ------------------------------------------------------
else if stmt is TsvfAstEndDR then
case TsvfAstEndIR(stmt).State of
stRESET : enddr(TS_RESET );
stIDLE : enddr(TS_IDLE );
stIRPAUSE : enddr(TS_IRPAUSE );
stDRPAUSE : enddr(TS_DRPAUSE );
else
end
// ------------------------------------------------------
// SCAN (4,5)
// ------------------------------------------------------
else if stmt is TsvfAstScan then
begin
stScn := TsvfAstScan(stmt);
inst := stscn.Inst;
// -----------------------------------------
// SIR
// -----------------------------------------
if inst = 'SIR' then
begin
bits := stScn.Bits;
while bits > 0 do
begin
if bits < 4000
then last := 1
else last := 0;
cnt := Min( bits, 4000);
data:= stScn.DataTDI;
sir( PByte(data),cnt,last);
DEC(bits,cnt);
end
end
// -----------------------------------------
// SDR
// -----------------------------------------
else if inst = 'SDR' then
begin
bits := stScn.Bits;
while bits > 0 do
begin
if bits < 4000
then last := 1
else last := 0;
cnt := Min( bits, 4000);
data:= stScn.DataTDI;
if stScn.DataTDO = nil then
sdw( PByte(data),cnt,last)
else begin
sdr( PByte(data),cnt,last);
data:= stScn.DataTDO;
end;
DEC(bits,cnt);
end
end
// -----------------------------------------
// HDR
// -----------------------------------------
else if inst = 'HDR' then
begin
end
// -----------------------------------------
// HIR
// -----------------------------------------
else if inst = 'HIR' then
begin
end
// -----------------------------------------
// TDR
// -----------------------------------------
else if inst = 'HDR' then
begin
end
// -----------------------------------------
// TIR
// -----------------------------------------
else if inst = 'HIR' then
begin
end
end
// ------------------------------------------------------
// RUNTEST (6)
// ------------------------------------------------------
else if stmt is TsvfAstRuntest then
begin
stRUN := TsvfAstRuntest(stmt);
if stRUN.RunClock = 'TCK' then
begin
case stRun.RunState of
stRESET : sRUN := TS_RESET;
stIDLE : sRUN := TS_IDLE;
stIRPAUSE : sRUN := TS_IRPAUSE;
stDRPAUSE : sRUN := TS_DRPAUSE;
else sRUN := TS_UNDEF
end;
case stRun.EndState of
stRESET : sEND := TS_RESET;
stIDLE : sEND := TS_IDLE;
stIRPAUSE : sEND := TS_IRPAUSE;
stDRPAUSE : sEND := TS_DRPAUSE;
else sEND := TS_UNDEF
end;
sCNT := StrToInt(string(stRun.RunCount));
if (sRUN <> TS_UNDEF) and (sCNT > 0) then
begin
while sCNT > 0 do
begin
run(sRUN, min(sCNT,32000));
DEC(sCNT, min(sCNT,32000));
end;
if sEND <> TS_UNDEF then
state(sEND)
end
end
end
// ------------------------------------------------------
// STATE (8)
// ------------------------------------------------------
else if stmt is TsvfAstState then
begin
stSta := TsvfAstState(stmt);
for j:=0 to stSta.StateCount -1 do
begin
case stSta.States[j] of
stRESET : sRUN := TS_RESET;
stIDLE : sRUN := TS_IDLE;
stIRPAUSE : sRUN := TS_IRPAUSE;
stDRPAUSE : sRUN := TS_DRPAUSE;
else sRUN := TS_UNDEF
end;
if sRUN <> TS_UNDEF then
state(sRUN)
end
end
end;
except
end
end
end;
// @@@: IJTAG primitives ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IJTAG primitives
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// pipe0_cmd_out
// ================================================================================================
function pipe0_cmd_out( dev: TusbDevice; req: byte; val: word=0; idx: word=0): boolean;
var
typ : byte;
p0 : TPipe0;
len : cardinal;
begin
result := true;
if Assigned( dev) and Assigned( dev.Pipe0) then
begin
typ := bmDirOut + bmTypeStandrad + bmRecDevice;
p0 := dev.Pipe0;
len := 0;
if Assigned(p0)
then p0.Transfer( typ,req, val,idx,0,nil,0,len)
else result := false
end
end;
// ================================================================================================
// ep2_xfer
// ================================================================================================
function pipe2_xfer( dev: TusbDevice; p2cmd: byte; buf: PByte; bitcount: word): cardinal;
var
pipe02 : TPipe;
pipe84 : TPipe;
cmd : TcmdJTAG;
len : cardinal;
bytes : cardinal;
begin
len := 0;
result := 0;
if Assigned( dev) then
begin
pipe02 := dev.Pipes[$02];
pipe84 := dev.Pipes[$84];
bytes := (bitcount +7) div 8;
if Assigned(pipe02) and Assigned(pipe84) then
begin
ZeroMemory( @cmd, sizeof(cmd));
cmd.command := p2cmd;
cmd.number := CyWord(bitcount);
cmd.status := 1;
if Assigned(buf) then
MoveMemory( @cmd.data, buf, bytes);
if p2cmd = CMD_JTAG_SDW then
pipe02.Write( cmd,sizeof(TcmdJTAGHead)+bytes,len)
else begin
if pipe02.Write( cmd,sizeof(TcmdJTAGHead)+bytes,len) then
if pipe84.Read(cmd,sizeof(TcmdJTAGHead)+bytes,len) then
MoveMemory(buf, @cmd.data, bytes)
end;
result := len
end
end
end;
// ================================================================================================
// INIT
//
// INIT command sent over the control endpoint EP0, because it is an important
// message. If the JTAG endpoint processing is stalled somewhere, it is not possible
// to send command using the stalled endpoint. The JTAG endpoints EP2 and EP4 are used
// only to transfer large data to the device when it is in DRSHIFT state (e.g.: programming),
// or when the device want to receive or send data (e.g.: LA data transfer, GPIF).
//
// ================================================================================================
procedure TmodJTAG.init;
begin
INC(nINIT);
pipe0_cmd_out( fDevice, CMD_JTAG_INIT);
end;
// ================================================================================================
// ENABLE
// ================================================================================================
procedure TmodJTAG.ena(value: BYTE);
begin
pipe0_cmd_out( fDevice, CMD_JTAG_ENABLE, CyWord(value));
end;
// ================================================================================================
// ENDIR
// ================================================================================================
procedure TmodJTAG.endir(state: TJTAGState);
begin
INC(nENDIR);
pipe0_cmd_out( fDevice, CMD_JTAG_ENDIR, CyWord(state));
end;
// ================================================================================================
// ENDDR
// ================================================================================================
procedure TmodJTAG.enddr(state: TJTAGState);
begin
INC(nENDDR);
pipe0_cmd_out( fDevice, CMD_JTAG_ENDDR, CyWord(state));
end;
// ================================================================================================
// STATE
// ================================================================================================
procedure TmodJTAG.state(state: TJTAGState);
begin
INC(nSTATE);
pipe0_cmd_out( fDevice, CMD_JTAG_STATE, CyWord(state));
end;
// ================================================================================================
// TRST
// ================================================================================================
procedure TmodJTAG.trst(value: BYTE);
begin
INC(nTRST);
pipe0_cmd_out( fDevice, CMD_JTAG_TRST, CyWord(value));
end;
// ================================================================================================
// SIR
// ================================================================================================
function TmodJTAG.sir(data: PByte; bitcount: word; last: byte): cardinal;
begin
INC(nSIR);
result := pipe2_xfer( fDevice, CMD_JTAG_SIR, data, bitcount);
end;
// ================================================================================================
// SDR
// ================================================================================================
function TmodJTAG.sdr(data: PByte; bitcount: word; last: byte): cardinal;
begin
INC(nSDR);
result := pipe2_xfer( fDevice, CMD_JTAG_SDR, data, bitcount);
end;
// ================================================================================================
// SDW
// ================================================================================================
function TmodJTAG.sdw(data: PByte; bitcount: word; last: byte): cardinal;
begin
INC(nSDR);
result := pipe2_xfer( fDevice, CMD_JTAG_SDW, data, bitcount);
end;
// ================================================================================================
// RUN
// ================================================================================================
procedure TmodJTAG.run(state: TJTAGState; count: WORD);
begin
pipe0_cmd_out( fDevice, CMD_JTAG_RUN, CyWord(state), CyWord(count));
//-- pipe2_xfer( fDevice, CMD_JTAG_RUN, nil, count);
end;
// ================================================================================================
// TEST
// ================================================================================================
procedure TmodJTAG.test;
begin
// pipe0_cmd_out( fDevice, CMD_JTAG_TEST);
end;
end.
@@ -0,0 +1,51 @@
unit m.jtag.types;
interface
type
TJTAGState =
(
TS_RESET = 0,
TS_IDLE = 1,
TS_IRPAUSE = 2,
TS_DRPAUSE = 3,
TS_IRSHIFT = 4,
TS_DRSHIFT = 5,
TS_DRCAPT = 6,
TS_IREXIT1 = 7,
TS_DREXIT1 = 8,
TS_UNDEF = $FF
);
IJTAG = interface
['{063CC4AC-2694-488C-A252-C2FA427EEC75}']
function scan( buffer : PCardinal;
maxcnt : byte): word;
function play( filename : string): boolean;
procedure init;
procedure ena( value : BYTE);
// JTAG primitive functions
procedure endir( state : TJTAGState);
procedure enddr( state : TJTAGState);
procedure state( state : TJTAGState);
function sir( data : PBYTE; bitcount: WORD; last: byte=1): cardinal;
function sdr( data : PBYTE; bitcount: WORD; last: byte=1): cardinal;
procedure trst( value : BYTE);
procedure run( state : TJTAGState; count: WORD);
procedure test;
end;
IJTAGLOG = interface
procedure info( msg : string);
procedure warning( msg : string);
end;
implementation
end.
@@ -0,0 +1,187 @@
unit m.lcd;
interface
uses
m.base,
m.lcd.types;
type
TmodLCD = class( TmodBase, ILCD)
// ------------------------------------------------------------
// ILCD
// ------------------------------------------------------------
protected
procedure Cls;
procedure GotoXY( x,y: word);
procedure putc( const c: AnsiChar );
procedure puts( const s: AnsiString);
end;
implementation
uses
Windows;
function CyWORD( value: word): word;
begin
result := (LoByte(value) shl 8) or HiByte(value);
end;
{ TmodLCD }
// @@@: ILCD ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// ILCD
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// cls
// ================================================================================================
procedure TmodLCD.Cls;
var
cnt : cardinal;
begin
if Assigned(fDevice) then
begin
with fDevice do
begin
if (VendorID = $16d0) and (ProductID = $0712) then
begin
cnt := 0;
Pipe0.Transfer( $00, // OUT
LCD_CLS, // cls
$0000, // Value (not used)
$0000, // Index (not used)
$0000, // Length (not used)
nil, // Buffer to receive data
0, // Length of buffer
cnt, // Transferred bytes
nil) // Overlapped (not used)
end;
end
end
else
// raise
end;
// ================================================================================================
// gotoxy
// ================================================================================================
procedure TmodLCD.GotoXY(x, y: word);
var
cnt : cardinal;
w : word;
begin
if Assigned(fDevice) then
begin
with fDevice do
begin
if (VendorID = $16d0) and (ProductID = $0712) then
begin
cnt := 0;
w := CyWord((x shl 8) +y);
Pipe0.Transfer( $00, // OUT
LCD_GOTOXY, //
w, // Value (not used)
$0000, // Index (not used)
$0000, // Length (not used)
nil, // Buffer to receive data
0, // Length of buffer
cnt, // Transferred bytes
nil) // Overlapped (not used)
end;
end
end
else
// raise
end;
// ================================================================================================
// putc
// ================================================================================================
procedure TmodLCD.putc(const c: AnsiChar);
var
cnt : cardinal;
w : word;
begin
if Assigned(fDevice) then
begin
with fDevice do
begin
if (VendorID = $16d0) and (ProductID = $0712) then
begin
cnt := 0;
w := CyWord(ord(c));
Pipe0.Transfer( $00, // OUT
LCD_PUTC, //
w, // Value (not used)
$0000, // Index (not used)
$0000, // Length (not used)
nil, // Buffer to receive data
0, // Length of buffer
cnt, // Transferred bytes
nil) // Overlapped (not used)
end;
end
end
else
// raise
end;
// ================================================================================================
// puts
// ================================================================================================
procedure TmodLCD.puts(const s: AnsiString);
var
cnt : cardinal;
buf : array [0..31] of AnsiChar;
begin
if Length(s) > 0 then
if Assigned(fDevice) then
begin
with fDevice do
begin
if (VendorID = $16d0) and (ProductID = $0712) then
begin
Windows.ZeroMemory(@buf[0],32);
cnt := 0;
buf[0] := '%';
Pipe0.Transfer( $00, // OUT
LCD_PUTS, //
$0000, // Value (not used)
$0000, // Index (not used)
32, // Length (not used)
@buf, // Buffer data to send
32, // Length of buffer
cnt, // Transferred bytes
nil) // Overlapped (not used)
end;
end
end
else
// raise
end;
end.
@@ -0,0 +1,22 @@
unit m.lcd.types;
interface
const
LCD_CLS = $50;
LCD_GOTOXY = $51;
LCD_PUTC = $52;
LCD_PUTS = $53;
type
ILCD = interface
['{267BDD5D-5918-46BD-8D9A-393938C707DB}']
procedure Cls;
procedure GotoXY( x,y: word);
procedure putc( const c: AnsiChar);
// procedure puts( const s: AnsiString);
end;
implementation
end.
@@ -0,0 +1,86 @@
unit m.led;
interface
uses
m.base,
m.led.types;
type
TmodLED = class( TmodBase, ILED)
// ------------------------------------------------------------
// ILED
// ------------------------------------------------------------
procedure LedOn( led: byte);
procedure LedOff(led: byte);
end;
implementation
uses
Windows;
function CyWORD( value: word): word;
begin
result := (LoByte(value) shl 8) or HiByte(value);
end;
{ TmodLED }
// ================================================================================================
// led on
// ================================================================================================
procedure TmodLED.LedOn( LED: byte);
var
cnt : cardinal;
w : word;
begin
cnt := 0;
w := CyWord((LED shl 8) +1);
assert( fDevice <> nil);
with fDevice do
if (VendorID = $16d0) and (ProductID = $0712) then
Pipe0.Transfer( $00, // OUT
LCD_LED, //
w, // Value
$0000, // Index (not used)
$0000, // Length (not used)
nil, // Buffer to receive data
0, // Length of buffer
cnt, // Transferred bytes
nil) // Overlapped (not used)
end;
// ================================================================================================
// led off
// ================================================================================================
procedure TmodLED.LedOff( LED: byte);
var
cnt : cardinal;
w : word;
begin
cnt := 0;
w := CyWord(LED shl 8);
assert( fDevice <> nil);
with fDevice do
if (VendorID = $16d0) and (ProductID = $0712) then
Pipe0.Transfer( $00, // OUT
LCD_LED, //
w, // Value
$0000, // Index (not used)
$0000, // Length (not used)
nil, // Buffer to receive data
0, // Length of buffer
cnt, // Transferred bytes
nil) // Overlapped (not used)
end;
end.
@@ -0,0 +1,17 @@
unit m.led.types;
interface
const
LCD_LED = $40;
type
ILED = interface
['{C3908812-2FB3-4A8F-8159-9B96E06C0659}']
procedure LedOn( led: byte);
procedure LedOff(led: byte);
end;
implementation
end.
@@ -0,0 +1,53 @@
unit m.base;
interface
uses
mr.trinity;
type
TmodBase = class (TInterfacedObject)
protected
fDevice : TTrinity;
// ------------------------------------------------------------
// construction / destruction
// ------------------------------------------------------------
public
constructor Create( dev: TTrinity);
destructor Destroy; override;
end;
implementation
uses
SysUtils;
{ TmodBase }
// @@@: construction / destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// construction / destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// constructor
// ================================================================================================
constructor TmodBase.Create(dev: TTrinity);
begin
inherited Create;
fDevice := dev;
end;
// ================================================================================================
// destructor
// ================================================================================================
destructor TmodBase.Destroy;
begin
inherited;
end;
end.
@@ -0,0 +1,56 @@
unit mr.trinity.consts;
interface
const
CMD_TRI_CAPS : byte = $E0;
CMD_TRI_SERIAL : byte = $E1;
CMD_TRI_IDENTIFIER : byte = $E2;
CFG_CAPS : byte = $E0;
CFG_SERIAL : byte = $E1;
CFG_IDENTIFIER : byte = $E2;
const
EEPROM_BOOT = $10;
EEPROM_CFG = $11;
EEPROM_LIC = $12;
EEPROM_USR = $13;
EEPROM_RAW = $14;
EEPROM_READ = $80;
EEPROM_WRITE = $00;
DIR_OUT = $00;
DIR_IN = $80;
EP1_I2C = $20;
EP1_EEPROM = $11;
bmCap0_I2C = $0001;
bmCap0_SER = $0002;
bmCap0_EPR = $0004;
bmCap0_RAM = $0008;
bmCap0_JTG = $0010;
bmCap0_20 = $0020;
bmCap0_40 = $0040;
bmCap0_80 = $0080;
bmCap1_LED = $0100;
bmCap1_LCD = $0200;
bmCap1_EXP = $0400;
bmCap1_LXP = $0800;
bmCap1_SDR = $1000;
bmCap1_20 = $2000;
bmCap1_40 = $4000;
bmCap1_80 = $8000;
implementation
end.
@@ -0,0 +1,457 @@
unit mr.trinity.hex;
interface
uses
Generics.Collections,
Classes;
const
rtData = $00;
rtEOF = $01;
rtExtendedSegment = $02;
rtStartSegment = $03;
rtExtendedLinear = $04;
rtStartLinear = $05;
type
THexLine = class
public
RecLength : byte;
RecType : byte;
Address : word;
Data : PByte;
Chksum : byte;
public
destructor Destroy; override;
end;
THexBlock = class
public
BlockLength : cardinal;
BlockType : byte;
Address : word;
Data : PByte;
public
destructor Destroy; override;
end;
THexLineList = TObjectList<THexLine>;
THexBlockList = TObjectList<THexBlock>;
THexFile = class
protected
fHexLines : THexLineList;
fHexBlocks : THexBlockList;
private
function GetBlockCount : integer;
function GetBlock(i:integer): THexBlock;
protected
function ReadLine( Stream: TStream): THexLine;
public
procedure LoadFromFile( FileName : string);
procedure LoadFromStream( Stream : TStream);
procedure Dump( Stream : TStream);
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
public
property Lines : THexLineList read fHexLines;
property Blocks : THexBlockList read fHexBlocks;
property BlockCount : integer read GetBlockCount;
property Block[i:integer] : THexBlock read GetBlock;
end;
implementation
uses
Windows,
SysUtils;
{ THexFile }
// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// After Construction
// ================================================================================================
procedure THexFile.AfterConstruction;
begin
inherited;
fHexLines := THexLineList .Create(false);
fHexBlocks := THexBlockList .Create
end;
// ================================================================================================
// Before Destruction
// ================================================================================================
procedure THexFile.BeforeDestruction;
begin
FreeAndNil(fHexBlocks);
FreeAndNil(fHexLines );
inherited
end;
// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Interface
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Load From File
// ================================================================================================
procedure THexFile.LoadFromFile(FileName: string);
var
stm: TMemoryStream;
begin
if FileExists(FileName) then
begin
stm := TMemoryStream.Create;
stm.LoadFromFile(FileName);
LoadFromStream(stm);
stm.Free;
end
end;
// ================================================================================================
// Load From Stream
// ================================================================================================
procedure THexFile.LoadFromStream(Stream: TStream);
var
block : THexBlock;
line : THexLine;
cnt : integer;
procedure Compress;
var
blk1 : THexBlock;
blk2 : THexBlock;
i,j : integer;
size : integer;
ptr : PByte;
label
loop;
begin
loop:
for i:=0 to fHexBlocks.Count -2 do
begin
blk1 := fHexBlocks[i];
for j:=1 to fHexBlocks.Count -1 do
begin
blk2 := fHexBlocks[j];
if (blk1.Address +blk1.BlockLength) = blk2.Address then
begin
size := blk1.BlockLength +blk2.BlockLength;
blk1.Data := ReallocMemory( blk1.Data,size);
ptr := blk1.Data;
INC(ptr, blk1.BlockLength);
CopyMemory(ptr, blk2.Data, blk2.BlockLength);
blk1.BlockLength := size;
fHexBlocks.Delete(j);
goto loop;
end
else if (blk2.Address +blk2.BlockLength) = blk1.Address then
begin
size := blk1.BlockLength +blk2.BlockLength;
blk2.Data := ReallocMemory( blk2.Data,size);
ptr := blk2.Data;
INC(ptr, blk2.BlockLength);
CopyMemory(ptr, blk1.Data, blk1.BlockLength);
blk2.BlockLength := size;
fHexBlocks.Delete(i);
goto loop;
end;
end;
end;
end;
begin
if Assigned(Stream) then
begin
Stream.Seek(0, soBeginning);
// ------------------------------------------------------------
// Read hex records
// ------------------------------------------------------------
while true do
begin
line := ReadLine(Stream);
if line = nil
then break
else fHexLines.Add(line)
end;
// ------------------------------------------------------------
// If the last record is EOF then the data is correct,
// so build the blocks.
// ------------------------------------------------------------
cnt := fHexLines.Count;
if (cnt > 0) and (fHexLines[cnt-1].RecType = rtEOF) then
begin
for line in fHexLines do
if line.RecType = rtData then
begin
block := THexBlock.Create;
block.BlockLength := line.RecLength;
block.BlockType := line.RecType;
block.Address := line.Address;
block.Data := AllocMem(line.RecLength);
CopyMemory( block.Data, line.Data, line.RecLength);
fHexBlocks.Add(block);
end;
Compress;
end;
end
end;
// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Internals
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Read Line
// ================================================================================================
function THexFile.ReadLine(Stream: TStream): THexLine;
function HexToBin( hex: byte): byte;
begin
result := 0;
if ansichar(hex) in ['0'..'9'] then result := ord(hex) -ord('0');
if ansichar(hex) in ['a'..'f'] then result := ord(hex) -ord('a') +10;
if ansichar(hex) in ['A'..'F'] then result := ord(hex) -ord('A') +10;
end;
function GetByte( Data: array of byte): byte;
begin
result := (HexToBin(Data[0]) shl 4) +
(HexToBin(Data[1]));
end;
function GetWord( Data0: array of byte; Data1: array of byte): word;
begin
result := (HexToBin(Data0[0]) shl 12) +
(HexToBin(Data0[1]) shl 8) +
(HexToBin(Data1[0]) shl 4) +
(HexToBin(Data1[1]));
end;
var
mark : ansichar;
chksum : byte;
i : byte;
l : cardinal;
ptr : PByte;
x1 : array [0..1] of byte;
x2 : array [0..1] of byte;
begin
result := nil;
l := Stream.Read( mark, 1);
// -----------------------------------------------------
// skip CR,LF
// -----------------------------------------------------
while (l > 0) and (mark in [#10,#13]) do
l := Stream.Read(mark,1);
if l = 0 then
exit;
// -----------------------------------------------------
// process record
// -----------------------------------------------------
if mark = ':' then
begin
chksum := 0;
// --------------------------------------------------
// Allocate HexLine
// --------------------------------------------------
result := THexLine.Create;
// --------------------------------------------------
// Length
// --------------------------------------------------
Stream.Read(x1, 2);
inc(chksum, GetByte(x1));
result.RecLength := GetByte(x1);
result.Data := GetMemory(result.RecLength);
// --------------------------------------------------
// Offset
// --------------------------------------------------
Stream.Read(x1, 2);
Stream.Read(x2, 2);
inc(chksum, GetByte(x1));
inc(chksum, GetByte(x2));
result.Address := GetWord(x1,x2);
// --------------------------------------------------
// Record type
// --------------------------------------------------
Stream.Read(x1, 2);
inc(chksum, GetByte(x1));
result.RecType := GetByte(x1);
// --------------------------------------------------
// Data
// --------------------------------------------------
ptr := result.Data;
for i:=0 to result.RecLength -1 do
begin
Stream.Read(x1,2);
inc(chksum, GetByte(x1));
ptr^ := GetByte(x1);
inc(ptr);
end;
// --------------------------------------------------
// Checksum
// --------------------------------------------------
Stream.Read(x1,2);
inc(chksum, GetByte(x1));
// --------------------------------------------------
// At that point the checksum must be 0!!!
// --------------------------------------------------
if chksum <> 0 then
FreeAndNil(result);
end
end;
// @@@: Property Handlers +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Property Handlers
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get Block Count
// ================================================================================================
function THexFile.GetBlockCount: integer;
begin
result := fHexBlocks.Count
end;
// ================================================================================================
// Get Block
// ================================================================================================
function THexFile.GetBlock(i: integer): THexBlock;
begin
if (i>=0) and (i<fHexBlocks.Count)
then result := fHexBlocks.Items[i]
else result := nil
end;
// ================================================================================================
// Dump
// ================================================================================================
procedure THexFile.Dump(Stream: TStream);
var
blk: THexBlock;
i : integer;
s : string;
begin
i := 1;
for blk in fHexBlocks do
begin
// blk.Address;
// blk.BlockLength;
s := Format('%3d %4.4x-%4.4x (%4.4x)'#13, [i,blk.Address,blk.Address+blk.BlockLength, blk.BlockLength]);
writeln(s);
INC(i);
end;
end;
{ THexLine }
destructor THexLine.Destroy;
begin
if Assigned(Data) then FreeMem(Data);
inherited;
end;
{ THexBlock }
destructor THexBlock.Destroy;
begin
if Assigned(Data) then FreeMem(Data);
inherited;
end;
end.
+567
View File
@@ -0,0 +1,567 @@
// ================================================================================================
// TTrinity
//
// The base class of all trinity boards. Every device returned by the device manager's
// "AllocateDevice" is an instance of a TTrinity class, or it's derivates. Every trinity
// board have on-board EEPROM and implement the following base functions:
//
// - I2C bus communication functions
// - EEPROM read/write functions
// - configuration functions (serial no, etc...)
// - firmware download (in case of cypress chip. RX devices ignore this request)
//
// Because of the mandatory functions, the I2C,EPR do not appear in the "Capabilties"
// property !
//
// To add new Capabilty to a board, see "dev.usb.trinity.consts", "dev.usb.trinity.utils",
// and "dev.usb.trinity.types".
//
// ================================================================================================
unit mr.trinity;
interface
uses
System.Classes,
System.SysUtils,
mr.dev.usb,
mr.trinity.consts,
mr.trinity.types,
mr.trinity.utils,
mr.trinity.pipe0,
m.eeprom.types,
m.cfg.types,
m.iic.types,
m.jtag.types,
m.led.types,
m.lcd.types;
type
// -----------------------------------------------------------------------------------
// TTrinity
// -----------------------------------------------------------------------------------
TTrinity = class (TUsbDevice, ITrinity, IIIC, ILCD, ILED, IEEPROM, IJTAG, ICFG)
protected
fCaps : TCapabilities;
fCaps64 : Int64;
fSerial : string;
fIdentifier : string;
// ----------------------------------------------------------------------
// ITrinity
// ----------------------------------------------------------------------
public
procedure Open; override;
procedure DownloadFirmware( Filename : string); overload;
procedure DownloadFirmware( Stream : TStream); overload;
procedure DownloadFirmwarePerm( Filename : string); overload;
procedure DownloadFirmwarePerm( Stream : TStream); overload;
// procedure I2CRead( addr: byte; var buffer; length: byte);
// procedure I2CWrite( addr: byte; const buffer; length: byte);
function EEPROMReadPage( page: word; var buffer): boolean;
function EEPROMWritePage( page: word; const buffer): boolean;
function SerialNumber : string;
function Capabilities : TCapabilities;
// ----------------------------------------------------------------------
// interface implementor modules
// ----------------------------------------------------------------------
private
fModCFG : ICFG;
fModIIC : IIIC;
fModEPR : IEEPROM;
fModJTAG : IJTAG;
fModLCD : ILCD;
fModLED : ILED;
protected
property cfg : ICFG read fModCFG implements ICFG;
property iic : IIIC read fModIIC implements IIIC;
property eeprom : IEEPROM read fModEPR implements IEEPROM;
property jtag : IJTAG read fModJTAG implements IJTAG;
property lcd : ILCD read fModLCD implements ILCD;
property led : ILED read fModLED implements ILED;
// ----------------------------------------------------------------------
// construction / destruction
// ----------------------------------------------------------------------
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
// ----------------------------------------------------------------------
// properties
// ----------------------------------------------------------------------
public
// property SerialNumber : string read fSerial;
// property Capabilities : TCapabilities read fCaps;
property Caps : Int64 read fCaps64;
end;
implementation
uses
Windows, Diagnostics,
mr.dev.manager,
mr.dev.usb.pipe,
mr.dev.usb.pipe0,
mr.trinity.hex,
m.cfg,
m.iic,
m.lcd,
m.led,
m.jtag,
m.eeprom;
type
THeader = packed record
command : byte;
status : byte;
page : word;
offset : byte;
length : byte;
dummy : word;
end;
TEEPROM = packed record
header : THeader;
data : array [0..31] of byte;
end;
{ TTrinity }
// @@@: Construction / destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Construction / destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// After Construction
// ================================================================================================
procedure TTrinity.AfterConstruction;
begin
inherited;
fPipe0Class := TTrinityPipe0;
fModCFG := TmodCFG .Create( self);
fModIIC := TmodIIC .Create( self);
fModEPR := TmodEEPROM .Create( self);
fModLCD := TmodLCD .Create( self);
fModLED := TmodLED .Create( self);
fModJTAG := TmodJTAG .Create( self);
end;
// ================================================================================================
// Before Destruction
// ================================================================================================
procedure TTrinity.BeforeDestruction;
begin
inherited
end;
function TTrinity.Capabilities: TCapabilities;
begin
result := fCaps
end;
// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Interface
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Open
// ================================================================================================
procedure TTrinity.Open;
var
buf: array [0..7] of AnsiChar;
cnt: cardinal;
i : integer;
begin
inherited;
if (VendorID = $16d0) and (ProductID = $0712) then
begin
// ----------------------------------------------------------------------
// serial number
// ----------------------------------------------------------------------
if Pipe0.Transfer( $80, // IN
CFG_SERIAL, // Get Serial
$00, // Value (not used)
$00, // Index (not used)
$08, // Length
@buf, // Buffer to receive data
8, // Length of buffer
cnt, // Transferred bytes
nil) then // Overlapped (not used)
begin
fSerial := '';
for i:=0 to 7 do
if buf[i] in ['a'..'z','A'..'Z','0'..'9','$','.','_','-']
then fSerial := fSerial + string(buf[i])
else break
end;
// ----------------------------------------------------------------------
// capabilities
// ----------------------------------------------------------------------
if Pipe0.Transfer( $80, // IN
CFG_CAPS, // Get Capabilities
$00, // Value (not used)
$00, // Index (not used)
$08, // Length
@buf, // Buffer to receive data
8, // Length of buffer
cnt, // Transferred bytes
nil) then // Overlapped (not used)
begin
fCaps64 := PInt64(@buf)^;
fCaps := DecodeCapabilities(fCaps64);
end
end
end;
function TTrinity.SerialNumber: string;
begin
result := fserial
end;
// ================================================================================================
// Download firmware (file)
// ================================================================================================
procedure TTrinity.DownloadFirmware(Filename: string);
begin
with Pipe0 as TTrinityPipe0 do
DownloadFirmware( Filename);
end;
// ================================================================================================
// Download firmware (stream)
// ================================================================================================
procedure TTrinity.DownloadFirmware(Stream: TStream);
begin
with Pipe0 as TTrinityPipe0 do
DownloadFirmware( Stream);
end;
// ================================================================================================
// Download firmware permanent (file)
// ================================================================================================
procedure TTrinity.DownloadFirmwarePerm(Filename: string);
var
stm: TMemoryStream;
begin
if FileExists(Filename) then
begin
stm := TMemoryStream.Create;
stm.LoadFromFile(Filename);
DownloadFirmwarePerm(stm);
stm.Free
end;
end;
// ================================================================================================
// Download firmware permanent (stream)
// ================================================================================================
procedure TTrinity.DownloadFirmwarePerm(Stream: TStream);
var
addr : word;
left : word;
bidx : byte;
didx : byte;
hex : THexFile;
page : word;
buf : array [0..31] of byte;
procedure PushByte( data: byte);
begin
buf[bidx] := data;
if bidx >= 31 then
begin
EEPROMWritePage(page,buf);
ZeroMemory(@buf,32);
INC(page);
bidx := 0;
end
else
INC(bidx)
end;
var
cnt : word;
procedure SendBlock( const blk: THexBlock);
const
CHUNK = 1023;
var
dptr : PByte;
begin
left := blk.BlockLength;
addr := blk.Address;
dptr := blk.Data;
didx := 0;
while left > 0 do
begin
if left > CHUNK then
begin
// push length of block
PushByte( HiByte(CHUNK));
PushByte( LoByte(CHUNK));
// push load address of block
PushByte( HiByte(addr));
PushByte( LoByte(addr));
cnt := CHUNK;
left := left - CHUNK;
addr := addr + CHUNK;
end
else begin
// push length of block
PushByte( HiByte(left));
PushByte( LoByte(left));
// push load address of block
PushByte( HiByte(addr));
PushByte( LoByte(addr));
cnt := left;
left := 0;
end;
// push data
while cnt > 0 do
begin
PushByte( dptr^);
INC(dptr);
DEC(cnt);
end;
end;
end;
var
blk: THexBlock;
begin
hex := THexFile.Create;
hex.LoadFromStream(stream);
// prepare counters
page := 0;
bidx := 8;
// prepare first eeprom block.
// be careful with the first 8 bytes!!!
ZeroMemory( @buf, 32);
buf[0] := $c2;
buf[7] := $01;
// download blocks
// for i:=0 to hex.BlockCount -1 do
// SendBlock( hex.Blocks[i]);
for blk in hex.Blocks do
SendBlock(blk);
// download last block
PushByte( $80);
PushByte( $01);
PushByte( $E6);
PushByte( $00);
PushByte( $00);
if bidx > 0 then
EEPROMWritePage(page, buf);
hex.Free
end;
// ================================================================================================
// EEPROM Read
// ================================================================================================
function TTrinity.EEPROMReadPage( page: word; var buffer): boolean;
var
pipe01 : TPipe;
pipe81 : TPipe;
buf : TEEPROM;
len : cardinal;
begin
if capEEPROM in fCaps then
begin
result := false;
pipe01 := Pipes[$01];
pipe81 := Pipes[$81];
if Assigned( pipe01) and Assigned( pipe81) then
begin
buf.header.command := EEPROM_RAW or EEPROM_READ;
buf.header.page := (LoByte(page) shl 8) + HiByte(page);
buf.header.offset := $00;
buf.header.length := $20;
pipe01.Write( buf, sizeof(buf), len);
pipe81.Read( buf, sizeof(buf), len);
CopyMemory(@buffer, @buf.data, 32);
end;
end
else
raise EInvalidFunction.Create('EEPROM Read');
end;
// ================================================================================================
// EEPROM Write
// ================================================================================================
function TTrinity.EEPROMWritePage( page: word; const buffer): boolean;
var
pipe01 : TPipe;
pipe81 : TPipe;
buf : TEEPROM;
len : cardinal;
begin
if capEEPROM in fCaps then
begin
result := false;
pipe01 := Pipes[$01];
pipe81 := Pipes[$81];
if Assigned( pipe01) and Assigned( pipe81) then
begin
buf.header.command := EEPROM_RAW or EEPROM_WRITE;
buf.header.page := (LoByte(page) shl 8) + HiByte(page);
buf.header.offset := $00;
buf.header.length := $20;
CopyMemory(@buf.data, @buffer, 32);
pipe01.Write( buf, sizeof(buf), len);
pipe81.Read( buf, sizeof(buf), len);
end;
end
else
raise EInvalidFunction.Create('EEPROM Write');
end;
// ================================================================================================
// I2C Read
//
// TODO: Must be executed in a thread.
// ================================================================================================
{
procedure TTrinity.I2CRead( addr: byte; var buffer; length: byte);
var
pipe01 : TPipe;
pipe81 : TPipe;
buf : TEEPROM;
len : cardinal;
begin
pipe01 := Pipes[$01];
pipe81 := Pipes[$81];
if length >= 32 then
length := 32;
if Assigned( pipe01) and Assigned( pipe81) then
begin
buf.header.command := DIR_IN + $20;
buf.header.page := 0;
buf.header.offset := addr;
buf.header.length := length;
pipe01.Write( buf, sizeof(TEEPROM), len);
ZeroMemory( @buf, sizeof(TEEPROM));
pipe81.Read( buf, sizeof(TEEPROM), len);
CopyMemory(@buffer, @buf.data, length)
end
end;
}
// ================================================================================================
// I2C Write
// ================================================================================================
{
procedure TTrinity.I2CWrite(addr: byte; const buffer; length: byte);
var
pipe01 : TPipe;
pipe81 : TPipe;
buf : TEEPROM;
len : cardinal;
begin
pipe01 := Pipes[$01];
pipe81 := Pipes[$81];
if length >= 32 then
length := 32;
if Assigned( pipe01) and Assigned( pipe81) then
begin
buf.header.command := DIR_OUT + $20;
buf.header.page := 0;
buf.header.offset := addr;
buf.header.length := length;
CopyMemory(@buf.data, @buffer, length);
pipe01.Write( buf, sizeof(TEEPROM), len);
pipe81.Read( buf, sizeof(THeader), len);
end
end;
}
initialization
RegisterDevice( $04b4, $8613, 0, TTrinity); // cypress vid/pid
RegisterDevice( $16d0, $0712, 0, TTrinity); // trinity vid/pid
end.
@@ -0,0 +1,135 @@
unit mr.trinity.pipe0;
interface
uses
Classes,
mr.dev.usb.pipe0;
type
TTrinityPipe0 = class( TPipe0)
public
procedure DownloadFirmware( Filename : string); overload; virtual;
procedure DownloadFirmware( Stm : TStream); overload; virtual;
end;
implementation
uses
SysUtils,
mr.trinity.hex,
mr.drv.usb.types,
mr.drv.usb;
{ TTrinityPipe0 }
// ================================================================================================
// Download Firmware (file)
// ================================================================================================
procedure TTrinityPipe0.DownloadFirmware(Filename: string);
var
stm : TMemoryStream;
begin
if FileExists(Filename) then
begin
stm := TMemoryStream.Create;
stm.LoadFromFile(Filename);
DownloadFirmware(stm);
stm.Free
end
end;
// ================================================================================================
// Download Firmware (stream)
// ================================================================================================
procedure TTrinityPipe0.DownloadFirmware(Stm: TStream);
var
len : cardinal;
b0 : byte;
b1 : byte;
addr : word;
left : word;
ptr : PByte;
hex : THexFile;
blk : THexBlock;
sud : TUsbSetupPacket;
begin
hex := THexFile.Create;
hex.LoadFromStream(stm);
hex.Dump(nil);
if Assigned( fDriver) then
begin
b0 := 0;
b1 := 1;
// ------------------------------------------------------------
// Reset 8051
// ------------------------------------------------------------
sud.RequestType := $40;
sud.Request := $A0;
sud.Value := $E600;
sud.Index := $0000;
sud.Length := $0000;
fDriver.ControlTransfer(sud, @b1, 1, len, nil);
// ------------------------------------------------------------
// Download firmware in 4 kB chunks
// ------------------------------------------------------------
// for i:=0 to hex.BlockCount -1 do
for blk in hex.Blocks do
begin
// blk := hex.Blocks[i];
addr := blk.Address;
left := blk.BlockLength;
ptr := blk.Data;
while left > 0 do
begin
sud.RequestType:= $40;
sud.Request := $A0;
if left > 4096 then
begin
sud.Value := addr;
sud.Index := $0000;
sud.Length := 4096;
fDriver.ControlTransfer( sud, ptr, 4096, len, nil);
addr := addr +4096;
ptr := pointer( cardinal(ptr) +4096);
left := left -4096
end
else begin
sud.Value := addr;
sud.Index := $0000;
sud.Length := left;
fDriver.ControlTransfer( sud, ptr, left, len, nil);
left := 0
end
end
end;
// ------------------------------------------------------------
// Restart 8051
// ------------------------------------------------------------
sud.RequestType := $40;
sud.Request := $A0;
sud.Value := $E600;
sud.Index := $0000;
sud.Length := $0000;
fDriver.ControlTransfer(sud, @b0, 1, len, nil)
end
end;
end.
@@ -0,0 +1,107 @@
unit mr.trinity.types;
interface
uses
System.Classes,
System.SysUtils;
type
EInvalidFunction = Exception;
TCapability =
(
capSER,
capCFG, // CFG
capIIC, // IIC
capRAM, // SRAM
capEEPROM, // EPR
capDSO, // DSO
capDSO2, // DS2
capREFLOW, // RFL
capLAMINATOR, // LAM
capLED, // LED
capJTAG, // JTG
capJTAG2, // JT2
capJTAG3, // JT3
capLCD, // LCD //44780
capLCD2, // LC2 //7565
capLA // LA
);
TCapabilities = set of TCapability;
function Caps2Int64( caps: TCapabilities): Int64;
function Caps2String( caps: TCapabilities): string;
type
ITrinity = interface
['{2CDBFA80-893B-41E9-A5C8-C02B7ED3D949}']
procedure Open;
procedure Close;
procedure DownloadFirmware( Filename : string); overload;
procedure DownloadFirmware( Stream : TStream); overload;
procedure DownloadFirmwarePerm( Filename : string); overload;
procedure DownloadFirmwarePerm( Stream : TStream); overload;
// procedure I2CRead( addr: byte; var buffer; length: byte);
// procedure I2CWrite( addr: byte; const buffer; length: byte);
function EEPROMReadPage( page: word; var buffer): boolean;
function EEPROMWritePage( page: word; const buffer): boolean;
function SerialNumber : string;
function Capabilities : TCapabilities;
end;
implementation
uses
mr.trinity.consts;
function Caps2Int64( caps: TCapabilities): Int64;
begin
result := 0;
if capIIC in caps then result := result or bmCap0_I2C;
if capSER in caps then result := result or bmCap0_SER;
if capEEPROM in caps then result := result or bmCap0_EPR;
if capRAM in caps then result := result or bmCap0_RAM;
if capJTAG in caps then result := result or bmCap0_JTG;
if capLED in caps then result := result or (bmCap1_LED shl 8);
if capLCD in caps then result := result or (bmCap1_LCD shl 8);
end;
function Caps2String( caps: TCapabilities): string;
var
cap : TCapability;
begin
result := '';
for cap in [ Low(TCapability) .. High(TCapability)] do
if cap in caps then
begin
if result <> '' then
result := result +',';
case cap of
capSER : result := result +'SER';
capCFG : result := result +'CFG';
capIIC : result := result +'I2C';
capRAM : result := result +'RAM';
capEEPROM: result := result +'EEPROM';
capJTAG : result := result +'JTG';
capLCD : result := result +'LCD';
capLCD2 : result := result +'LCD2';
end;
end;
end;
end.
@@ -0,0 +1,39 @@
unit mr.trinity.utils;
interface
uses
mr.trinity.consts,
mr.trinity.types;
function DecodeCapabilities( caps: Int64 ): TCapabilities;
function EncodeCapabilities( caps: TCapabilities): Int64;
implementation
// ================================================================================================
// EncodeCapabilities
// ================================================================================================
function EncodeCapabilities( caps: TCapabilities): Int64;
begin
result := 0;
if capJTAG in caps then result := result or bmCap0_JTG;
end;
// ================================================================================================
// DecodeCapabilities
// ================================================================================================
function DecodeCapabilities( caps: Int64): TCapabilities;
begin
result := [];
if( caps and bmCap0_I2C ) <> 0 then Include( result, capIIC );
if( caps and bmCap0_SER ) <> 0 then Include( result, capSER );
if( caps and bmCap0_EPR ) <> 0 then Include( result, capEEPROM );
if( caps and bmCap0_RAM ) <> 0 then Include( result, capRAM );
if( caps and bmCap0_JTG ) <> 0 then Include( result, capJTAG );
if( caps and bmCap1_LCD ) <> 0 then Include( result, capLCD );
end;
end.