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.