Initial check in

This commit is contained in:
2026-01-03 18:57:08 +01:00
commit 7a64fa18fb
14 changed files with 3007 additions and 0 deletions
+26
View File
@@ -0,0 +1,26 @@
__history
__recovery
bin
dcu
*.exe
prj.dpgxcon\Win32
prj.dpgxcon\Win64
*.dcu
*.res
*.identcache
*.local
*.dsk
*.dsv
# documentation intermediate files (TeX)
*.aux
*.bmt
*.dvi
*.log
*.lot
*.mtc*
*.mlt*
*.toc
+28
View File
@@ -0,0 +1,28 @@
program prgc;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
main in '..\..\src.prgc\main.pas',
prgLexer in '..\..\src.prgc\grammar\prgLexer.pas',
prgLexerTokens in '..\..\src.prgc\grammar\prgLexerTokens.pas',
prgParser in '..\..\src.prgc\grammar\prgParser.pas',
prgParserTokens in '..\..\src.prgc\grammar\prgParserTokens.pas';
begin
var cmd := '';
for var i:=1 to ParamCount do
cmd := cmd + ParamStr(i);
with TcmdMain.Create do
begin
Execute( 'prgc.exe', cmd);
Free
end
end.
File diff suppressed because it is too large Load Diff
+13
View File
@@ -0,0 +1,13 @@
STRINGTABLE
BEGIN
0x8F00, "Help"
0x8F01, "New instance"
0x8F02, "Language"
0x8F03, "Username"
0x8F04, "Password"
0x8F05, "Profile"
0x8F06, "System GUID"
0x8F07, "Role GUID"
END
+4
View File
@@ -0,0 +1,4 @@
DPG project
Grammar = "prgLexer.g"
Grammar = "prgParser.g"
End
+155
View File
@@ -0,0 +1,155 @@
unit prgLexer;
// ----------------------------------------------------------------------------
// This section is used for generating "uses" clause in the unit 'prgLexer'.
// Every unit name must be terminated with ';'
// e.g:
//
// uses
// {
// Classes;
// SysUtils;
// }
// ----------------------------------------------------------------------------
uses
{
}
// ----------------------------------------------------------------------------
// This section is used for generating "const" clause in the unit 'prgLexer'.
// The content of the section is verbatim copied into the generated code.
// ----------------------------------------------------------------------------
//const
//{
//}
// ----------------------------------------------------------------------------
// This section is used for generating "type" clause in the unit 'prgLexer'.
// The content of the section is verbatim copied into the generated code.
// ----------------------------------------------------------------------------
type
{
}
// ============================================================================
// Lexer class declaration
// ============================================================================
lexer TprgLexer;
// ----------------------------------------------------------------------------
// Lexer options
// ----------------------------------------------------------------------------
options
{
k = 2;
exportVocab = prgLexer;
caseSensitive = false;
}
// ----------------------------------------------------------------------------
// Lexer tokens. Usualy string literals.
// ----------------------------------------------------------------------------
tokens
{
"dso";
"jtag";
"fx2";
"/list";
"/id";
"/pos";
"/loc";
"/perm";
"/cmd";
"/v";
"/v1";
QID;
}
// ----------------------------------------------------------------------------
// Lexer member declarations.
// All user defined member declarations should be placed here.
// The content of the section is verbatim copied into the generated code.
// ----------------------------------------------------------------------------
memberdecl
{
}
// ============================================================================
// Begin rule definitions
//
// Remember: All lexer rule names must begin with UPPERCASE letter!
// ============================================================================
//SLASH : '/';
COMMA : ',';
COLON : ':';
PLUS : '+';
MINUS : '-';
DOT : '.';
EQ : '=';
// STAR : '*';
ID
options
{
testLiterals = true;
}
: ('A'..'Z' | 'a'..'z' | '/' | '&' | '*')
( 'A'..'Z'
| 'a'..'z'
| '0'..'9'
| '&'
| '*'
| '_'
| '.' { _ttype := TT_QID; }
)*
;
INT : ('0'..'9')('0'..'9')*;
REXP : "<"! (~(">"))* ">"!;
// ----------------------------------------------------------------------------
// NEWLINE
// ----------------------------------------------------------------------------
NEWLINE
:
(
options
{
generateAmbigWarnings = false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
)
{
_ttype := TT_SKIP;
}
;
// ----------------------------------------------------------------------------
// WHITESPACE
// ----------------------------------------------------------------------------
WS
:
(
' '
| '\t' { tab; }
)
// {
// _ttype := TT_SKIP;
// }
;
// ============================================================================
// End rule definitions
// ============================================================================
// ----------------------------------------------------------------------------
// This section is used for generating member defintions in the unit 'prgLexer'.
// The content of the section is verbatim copied into the generated code.
// ----------------------------------------------------------------------------
memberdef
{
}
+609
View File
@@ -0,0 +1,609 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: prgLexer.g
// ============================================================================
unit prgLexer;
interface
uses
Classes,
dpgrtl.lexer,
dpgrtl.types,
prgLexerTokens,
SysUtils;
type
// =========================================================================
// Type declarations from grammar.
// =========================================================================
// =========================================================================
// Class TprgLexer declaration
// =========================================================================
TprgLexer = class( TLexer)
protected // Internals
procedure initialize; override;
public // Public grammar rules
procedure mCOMMA ( pCreate: boolean);
procedure mCOLON ( pCreate: boolean);
procedure mPLUS ( pCreate: boolean);
procedure mMINUS ( pCreate: boolean);
procedure mDOT ( pCreate: boolean);
procedure mEQ ( pCreate: boolean);
procedure mID ( pCreate: boolean);
procedure mINT ( pCreate: boolean);
procedure mREXP ( pCreate: boolean);
procedure mNEWLINE ( pCreate: boolean);
procedure mWS ( pCreate: boolean);
public
function NextToken: IToken; override;
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// mCOMMA
// ============================================================================
procedure TprgLexer.mCOMMA( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_COMMA;
match(',');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mCOLON
// ============================================================================
procedure TprgLexer.mCOLON( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_COLON;
match(':');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mPLUS
// ============================================================================
procedure TprgLexer.mPLUS( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_PLUS;
match('+');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mMINUS
// ============================================================================
procedure TprgLexer.mMINUS( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_MINUS;
match('-');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mDOT
// ============================================================================
procedure TprgLexer.mDOT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_DOT;
match('.');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mEQ
// ============================================================================
procedure TprgLexer.mEQ( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_EQ;
match('=');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mID
// ============================================================================
procedure TprgLexer.mID( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_ID;
var c := LA(1);
if (( LA(1) in ['A'..'Z'])) then
begin
match( ['A'..'Z']);
end
else if (( LA(1) in ['a'..'z'])) then
begin
match( ['a'..'z']);
end
else if (( LA(1) in ['/'])) then
begin
match('/');
end
else if (( LA(1) in ['&'])) then
begin
match('&');
end
else if (( LA(1) in ['*'])) then
begin
match('*');
end
else
Raise EMismatchedChar.Create( LA(1), ['&','*','/','A'..'Z','a'..'z'], InputState.FileName, InputState.Line, InputState.Column);
while(true) do
begin
c := LA(1);
if (( LA(1) in ['A'..'Z'])) then
begin
match( ['A'..'Z']);
end
else if (( LA(1) in ['a'..'z'])) then
begin
match( ['a'..'z']);
end
else if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else if (( LA(1) in ['&'])) then
begin
match('&');
end
else if (( LA(1) in ['*'])) then
begin
match('*');
end
else if (( LA(1) in ['_'])) then
begin
match('_');
end
else if (( LA(1) in ['.'])) then
begin
match('.');
_ttype := TT_QID;
end
else
break;
end;
_ttype := TestLiteral( _ttype);
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mINT
// ============================================================================
procedure TprgLexer.mINT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_INT;
match( ['0'..'9']);
while(true) do
begin
if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else
break;
end;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mREXP
// ============================================================================
procedure TprgLexer.mREXP( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_REXP;
SaveConsumedInput := false;
match('<');
SaveConsumedInput := true;
while(true) do
begin
if (( LA(1) in [#1..'=','?'..#255])) then
begin
match( [#1..'=','?'..#255]);
end
else
break;
end;
SaveConsumedInput := false;
match('>');
SaveConsumedInput := true;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mNEWLINE
// ============================================================================
procedure TprgLexer.mNEWLINE( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_NEWLINE;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else
Raise EMismatchedChar.Create( LA(1), [#10,#13], InputState.FileName, InputState.Line, InputState.Column);
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mWS
// ============================================================================
procedure TprgLexer.mWS( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_WS;
if (( LA(1) in [' '])) then
begin
match(' ');
end
else if (( LA(1) in [#9])) then
begin
match(#9);
tab;
end
else
Raise EMismatchedChar.Create( LA(1), [#9,' '], InputState.FileName, InputState.Line, InputState.Column);
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ----------------------------------------------------------------------------
// NextToken
// ----------------------------------------------------------------------------
function TprgLexer.NextToken : IToken;
var
_first : TCharSet;
begin
_first := [#9..#10,#13,' ','&','*'..':','<'..'=','A'..'Z','a'..'z'];
while( true) do
begin
ResetText;
try
if (( LA(1) in [','])) then
begin
mCOMMA(true);
result := ReturnToken;
end
else if (( LA(1) in [':'])) then
begin
mCOLON(true);
result := ReturnToken;
end
else if (( LA(1) in ['+'])) then
begin
mPLUS(true);
result := ReturnToken;
end
else if (( LA(1) in ['-'])) then
begin
mMINUS(true);
result := ReturnToken;
end
else if (( LA(1) in ['.'])) then
begin
mDOT(true);
result := ReturnToken;
end
else if (( LA(1) in ['='])) then
begin
mEQ(true);
result := ReturnToken;
end
else if (( LA(1) in ['&','*','/','A'..'Z','a'..'z'])) then
begin
mID(true);
result := ReturnToken;
end
else if (( LA(1) in ['0'..'9'])) then
begin
mINT(true);
result := ReturnToken;
end
else if (( LA(1) in ['<'])) then
begin
mREXP(true);
result := ReturnToken;
end
else if (( LA(1) in [#10,#13])) then
begin
mNEWLINE(true);
result := ReturnToken;
end
else if (( LA(1) in [#9,' '])) then
begin
mWS(true);
result := ReturnToken;
end
else
begin
if LA(1) = EOF_CHAR then
begin
uponEof;
result := TToken.Create(TT_EOF);
end
else
Raise EMismatchedChar.Create(LA(1), _first, InputState.FileName, InputState.Line, InputState.Column);
end;
// --------------------------------------------------------------
// If we found a SKIP token, then try again...
// --------------------------------------------------------------
if result = nil then
continue;
// --------------------------------------------------------------
// Now we have a valid token, so exit the function
// --------------------------------------------------------------
break;
except
Raise;
end;
end;
end;
// ----------------------------------------------------------------------------
// InitLiterals
// ----------------------------------------------------------------------------
procedure TprgLexer.initialize;
begin
fCaseSensitive := false;
fLiterals.CaseSensitive := false;
fLiterals['/cmd' ] := 12;
fLiterals['fx2' ] := 6;
fLiterals['/id' ] := 8;
fLiterals['/pos' ] := 9;
fLiterals['/v' ] := 13;
fLiterals['/loc' ] := 10;
fLiterals['/list' ] := 7;
fLiterals['/perm' ] := 11;
fLiterals['dso' ] := 4;
fLiterals['/v1' ] := 14;
fLiterals['jtag' ] := 5;
end;
end.
+38
View File
@@ -0,0 +1,38 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: prgLexer.g
// ============================================================================
unit prgLexerTokens;
interface
const
LT_SLASH_cmd = 12;
LT_fx2 = 6;
LT_SLASH_id = 8;
TT_ID = 22;
LT_SLASH_pos = 9;
TT_NEWLINE = 25;
TT_EOF = 1;
TT_COLON = 17;
LT_SLASH_v = 13;
LT_SLASH_loc = 10;
TT_INT = 23;
LT_SLASH_list = 7;
TT_WS = 26;
LT_SLASH_perm = 11;
LT_dso = 4;
TT_COMMA = 16;
TT_EQ = 21;
TT_QID = 15;
TT_PLUS = 18;
TT_MINUS = 19;
TT_DOT = 20;
LT_SLASH_v1 = 14;
TT_REXP = 24;
LT_jtag = 5;
implementation
end.
+26
View File
@@ -0,0 +1,26 @@
// $Delphi Parser Generator: prgLexer.g -> prgLexer.gTokens.txt$
TprgLexer
LT_SLASH_cmd="/cmd"=12
LT_fx2="fx2"=6
LT_SLASH_id="/id"=8
TT_ID=22
LT_SLASH_pos="/pos"=9
TT_NEWLINE=25
TT_EOF=1
TT_COLON=17
LT_SLASH_v="/v"=13
LT_SLASH_loc="/loc"=10
TT_INT=23
LT_SLASH_list="/list"=7
TT_WS=26
LT_SLASH_perm="/perm"=11
LT_dso="dso"=4
TT_COMMA=16
TT_EQ=21
TT_QID=15
TT_PLUS=18
TT_MINUS=19
TT_DOT=20
LT_SLASH_v1="/v1"=14
TT_REXP=24
LT_jtag="jtag"=5
+247
View File
@@ -0,0 +1,247 @@
unit prgParser;
// ----------------------------------------------------------------------------
// This section is used for generating "uses" clause in the unit 'prgParser'.
// Every unit name must be terminated with ';'
// e.g:
//
// uses
// {
// Classes;
// SysUtils;
// }
// ----------------------------------------------------------------------------
uses
{
Classes;
}
// ----------------------------------------------------------------------------
// This section is used for generating "const" clause in the unit 'prgParser'.
// The content of the section is verbatim copied into the generated code.
// ----------------------------------------------------------------------------
//const
//{
//}
// ----------------------------------------------------------------------------
// This section is used for generating "type" clause in the unit 'prgParser'.
// The content of the section is verbatim copied into the generated code.
// ----------------------------------------------------------------------------
type
{
TprgCommand =
(
cmdNone,
cmdList,
cmdListDSOs,
cmdListJTAGs,
cmdListFX2s,
cmdListDSO,
cmdListJTAG,
cmdProgramDSO,
cmdProgramJTAG,
cmdProgramFX2,
cmdProgramFX2Perm,
cmdEepromDump,
cmdEepromRead,
cmdEepromWrite
);
}
// ============================================================================
// Parser class declaration
// ============================================================================
parser TprgParser;
// ----------------------------------------------------------------------------
// Parser options
// ----------------------------------------------------------------------------
options
{
k = 2;
importVocab = prgLexer;
exportVocab = prgParser;
}
// ----------------------------------------------------------------------------
// Parser member declarations.
// All user defined member declarations should be placed here.
// The content of the section is verbatim copied into the generated code.
// ----------------------------------------------------------------------------
memberdecl
{
protected
fCommand : TprgCommand;
fDevice : string;
fFiles : TStringList;
fVerbose : string;
private
function GetFileCount: integer;
function GetFile( Idx: integer): string;
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
public
property Command : TprgCommand read fCommand;
property Verbose : string read fVerbose;
property DeviceID : string read fDevice;
property FileCount : integer read GetFileCount;
property Files[i:integer] : string read GetFile;
}
// ============================================================================
// Begin rule definitions
//
// Remember: All parser rule names must begin with LOWERCASE letter!
// ============================================================================
prg
{
fCommand := cmdNone;
fVerbose := '';
fDevice := '';
}
: "/list"
{
fCommand := cmdList;
}
|
(
"fx2" (WS)?
(
"/list"
{
fCommand := cmdListFX2s;
}
| "/loc" COLON (x:INT | x:REXP) EQ prgfile
{
fCommand := cmdProgramFX2;
fDevice := x.TokenText;
}
(
"/perm"
{
fCommand := cmdProgramFX2Perm;
}
)?
)
)
|
(
"dso" { fCommand := cmdListDSOs; }
| "jtag" { fCommand := cmdListJTAGs; }
)
(WS)?
(
"/id"
COLON
x:ID { fDevice := x.TokenText; }
{
if fCommand = cmdListDSOs then fCommand := cmdListDSO;
if fCommand = cmdListJTAGs then fCommand := cmdListJTAG;
}
(WS)?
)?
(
"/list"
| EQ prgfile
{
if fCommand = cmdListDSO then fCommand := cmdProgramDSO;
if fCommand = cmdListJTAG then fCommand := cmdProgramJTAG;
}
(
v:"/v" { fVerbose := '0'; }
| v:"/v1" { fVerbose := '1'; }
)?
)
;
//prgfiles:
// (prgfile)+
// ;
prgfile
local
{
pos : AnsiString;
name : AnsiString;
}
{
pos := '0';
name := '';
}
: x:QID { name := x.TokenText; }
// SLASH "pos" COLON
// x:INT { pos := x.TokenText; }
{
fFiles.Add(pos+'='+name);
}
;
// ============================================================================
// End rule definitions
// ============================================================================
// ----------------------------------------------------------------------------
// This section is used for generating member defintions in the unit 'prgParser'.
// The content of the section is verbatim copied into the generated code.
// ----------------------------------------------------------------------------
memberdef
{
// ============================================================================
// After construction
// ============================================================================
procedure TprgParser.AfterConstruction;
begin
inherited;
fFiles := TStringList.Create
end;
// ============================================================================
// Before Destruction
// ============================================================================
procedure TprgParser.BeforeDestruction;
begin
fFiles.Free;
inherited
end;
// ============================================================================
// Get File Count
// ============================================================================
function TprgParser.GetFileCount: integer;
begin
result := fFiles.Count
end;
// ============================================================================
// Get File
// ============================================================================
function TprgParser.GetFile( Idx: integer): string;
var
i: integer;
p: integer;
begin
result := '';
for i:=0 to fFiles.Count -1 do
begin
p := StrToIntDef( fFiles.Names[i], -1);
if p = Idx then
begin
result := fFiles.ValueFromIndex[i];
break;
end
end;
end;
}
+280
View File
@@ -0,0 +1,280 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: prgparser.g
// ============================================================================
unit prgParser;
interface
uses
Classes,
dpgrtl.llkparser,
dpgrtl.types,
prgParserTokens,
SysUtils;
type
// =========================================================================
// Type declarations from grammar.
// =========================================================================
TprgCommand =
(
cmdNone,
cmdList,
cmdListDSOs,
cmdListJTAGs,
cmdListFX2s,
cmdListDSO,
cmdListJTAG,
cmdProgramDSO,
cmdProgramJTAG,
cmdProgramFX2,
cmdProgramFX2Perm,
cmdEepromDump,
cmdEepromRead,
cmdEepromWrite
);
// =========================================================================
// Class TprgParser declaration
// =========================================================================
TprgParser = class( TLLkParser)
protected
fCommand : TprgCommand;
fDevice : string;
fFiles : TStringList;
fVerbose : string;
private
function GetFileCount: integer;
function GetFile( Idx: integer): string;
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
public
property Command : TprgCommand read fCommand;
property Verbose : string read fVerbose;
property DeviceID : string read fDevice;
property FileCount : integer read GetFileCount;
property Files[i:integer] : string read GetFile;
public // Public grammar rules
procedure prg ;
procedure prgfile ;
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// prg
// ============================================================================
procedure TprgParser.prg;
var
v: IToken;
x: IToken;
begin
fCommand := cmdNone;
fVerbose := '';
fDevice := '';
if (( LA(1) in [LT_SLASH_list])) then
begin
match(LT_SLASH_list);
fCommand := cmdList;
end
else if (( LA(1) in [LT_fx2])) then
begin
match(LT_fx2);
if (( LA(1) in [TT_WS])) then
begin
match(TT_WS);
end;
if (( LA(1) in [LT_SLASH_list])) then
begin
match(LT_SLASH_list);
fCommand := cmdListFX2s;
end
else if (( LA(1) in [LT_SLASH_loc])) then
begin
match(LT_SLASH_loc);
match(TT_COLON);
if (( LA(1) in [TT_INT])) then
begin
x := LT(1);
match(TT_INT);
end
else if (( LA(1) in [TT_REXP])) then
begin
x := LT(1);
match(TT_REXP);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_INT..TT_REXP], InputState.FileName);
match(TT_EQ);
prgfile;
fCommand := cmdProgramFX2;
fDevice := x.TokenText;
if (( LA(1) in [LT_SLASH_perm])) then
begin
match(LT_SLASH_perm);
fCommand := cmdProgramFX2Perm;
end;
end
else
Raise EMismatchedToken.Create( LT(1), [LT_SLASH_list,LT_SLASH_loc], InputState.FileName);
end
else if (( LA(1) in [LT_dso..LT_jtag])) then
begin
if (( LA(1) in [LT_dso])) then
begin
match(LT_dso);
fCommand := cmdListDSOs;
end
else if (( LA(1) in [LT_jtag])) then
begin
match(LT_jtag);
fCommand := cmdListJTAGs;
end
else
Raise EMismatchedToken.Create( LT(1), [LT_dso..LT_jtag], InputState.FileName);
if (( LA(1) in [TT_WS])) then
begin
match(TT_WS);
end;
if (( LA(1) in [LT_SLASH_id])) then
begin
match(LT_SLASH_id);
match(TT_COLON);
x := LT(1);
match(TT_ID);
fDevice := x.TokenText;
if fCommand = cmdListDSOs then fCommand := cmdListDSO;
if fCommand = cmdListJTAGs then fCommand := cmdListJTAG;
if (( LA(1) in [TT_WS])) then
begin
match(TT_WS);
end;
end;
if (( LA(1) in [LT_SLASH_list])) then
begin
match(LT_SLASH_list);
end
else if (( LA(1) in [TT_EQ])) then
begin
match(TT_EQ);
prgfile;
if fCommand = cmdListDSO then fCommand := cmdProgramDSO;
if fCommand = cmdListJTAG then fCommand := cmdProgramJTAG;
if (( LA(1) in [LT_SLASH_v])) then
begin
v := LT(1);
match(LT_SLASH_v);
fVerbose := '0';
end
else if (( LA(1) in [LT_SLASH_v1])) then
begin
v := LT(1);
match(LT_SLASH_v1);
fVerbose := '1';
end;
end
else
Raise EMismatchedToken.Create( LT(1), [LT_SLASH_list,TT_EQ], InputState.FileName);
end
else
Raise EMismatchedToken.Create( LT(1), [LT_dso..LT_SLASH_list], InputState.FileName);
end;
// ============================================================================
// prgfile
// ============================================================================
procedure TprgParser.prgfile;
var
x: IToken;
pos : AnsiString;
name : AnsiString;
begin
pos := '0';
name := '';
x := LT(1);
match(TT_QID);
name := x.TokenText;
fFiles.Add(pos+'='+name);
end;
// ============================================================================
// After construction
// ============================================================================
procedure TprgParser.AfterConstruction;
begin
inherited;
fFiles := TStringList.Create
end;
// ============================================================================
// Before Destruction
// ============================================================================
procedure TprgParser.BeforeDestruction;
begin
fFiles.Free;
inherited
end;
// ============================================================================
// Get File Count
// ============================================================================
function TprgParser.GetFileCount: integer;
begin
result := fFiles.Count
end;
// ============================================================================
// Get File
// ============================================================================
function TprgParser.GetFile( Idx: integer): string;
var
i: integer;
p: integer;
begin
result := '';
for i:=0 to fFiles.Count -1 do
begin
p := StrToIntDef( fFiles.Names[i], -1);
if p = Idx then
begin
result := fFiles.ValueFromIndex[i];
break;
end
end;
end;
end.
+38
View File
@@ -0,0 +1,38 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: prgparser.g
// ============================================================================
unit prgParserTokens;
interface
const
LT_jtag = 5;
LT_fx2 = 6;
LT_SLASH_id = 8;
TT_ID = 22;
LT_SLASH_pos = 9;
TT_NEWLINE = 25;
TT_EOF = 1;
TT_COLON = 17;
LT_SLASH_v = 13;
LT_SLASH_loc = 10;
TT_INT = 23;
LT_SLASH_list = 7;
TT_WS = 26;
LT_SLASH_perm = 11;
LT_dso = 4;
TT_COMMA = 16;
TT_EQ = 21;
TT_QID = 15;
TT_PLUS = 18;
TT_MINUS = 19;
TT_DOT = 20;
LT_SLASH_v1 = 14;
TT_REXP = 24;
LT_SLASH_cmd = 12;
implementation
end.
+26
View File
@@ -0,0 +1,26 @@
// $Delphi Parser Generator: prgparser.g -> prgparser.gTokens.txt$
TprgParser
LT_jtag="jtag"=5
LT_fx2="fx2"=6
LT_SLASH_id="/id"=8
TT_ID=22
LT_SLASH_pos="/pos"=9
TT_NEWLINE=25
TT_EOF=1
TT_COLON=17
LT_SLASH_v="/v"=13
LT_SLASH_loc="/loc"=10
TT_INT=23
LT_SLASH_list="/list"=7
TT_WS=26
LT_SLASH_perm="/perm"=11
LT_dso="dso"=4
TT_COMMA=16
TT_EQ=21
TT_QID=15
TT_PLUS=18
TT_MINUS=19
TT_DOT=20
LT_SLASH_v1="/v1"=14
TT_REXP=24
LT_SLASH_cmd="/cmd"=12
+407
View File
@@ -0,0 +1,407 @@
unit main;
interface
uses
System.Classes,
mr.trinity.types;
type
TcmdMain = class
private
procedure doCmdList( Functions: TCapabilities = []);
procedure doCmdListFX2 ( Functions: TCapabilities = []);
procedure doCmdListJTAG;
procedure DoCmdListJTAGDevices( id: string);
procedure doCmdProgramFX2( const Location : string;
const Filename : string;
Permanent : boolean=false);
procedure doCmdProgramJTAG( const ID : string;
const FileName : string;
const Verbose : string='');
public
procedure Execute( Module: string; CommandLine: string);
end;
implementation
uses
System.SysUtils,
System.StrUtils,
System.RegularExpressions,
prgLexer,
prgParser,
Vcl.Forms,
mr.drv.usb.winusb,
mr.trinity,
mr.dev.manager,
m.lcd.types,
m.led.types,
m.jtag.types;
{ TcmdMain }
// ================================================================================================
// execute
// ================================================================================================
procedure TcmdMain.Execute(Module: string; CommandLine: string);
var
lex : TprgLexer;
par : TprgParser;
stm : TMemoryStream;
cmd : AnsiString;
jtg : IJTAG;
begin
cmd := AnsiString(CommandLine);
stm := TMemoryStream.Create;
stm.Write( cmd[1], Length(cmd));
stm.Seek( 0, soFromBeginning);
try
lex := TprgLexer .Create( stm);
par := TprgParser .Create( lex, 3);
par.prg;
case par.Command of
cmdList : doCmdList;
cmdListFX2s : doCmdListFX2;
cmdListJTAGs : doCmdListJTAG;
cmdListJTAG : DoCmdListJTAGDevices( par.DeviceID);
cmdProgramFX2 : doCmdProgramFX2( par.DeviceID, par.Files[0], false);
cmdProgramFX2Perm : doCmdProgramFX2( par.DeviceID, par.Files[0], true);
cmdProgramJTAG : doCmdProgramJTAG( par.DeviceID, par.Files[0]);
end;
par.Free
except
writeln( Module +': Syntax error')
end;
stm.Free
end;
// ================================================================================================
// /list
// ================================================================================================
procedure TcmdMain.doCmdList( Functions: TCapabilities = []);
var
c: TCapabilities;
s: string;
begin
if Functions = [] then
begin
writeln;
writeln('--------------------------------------------------------------------');
writeln(' VID PID Description Location ');
writeln('--------------------------------------------------------------------');
end
else begin
writeln;
writeln('--------------------------------------------------------------------');
writeln(' Device Functions Location ');
writeln('--------------------------------------------------------------------');
end;
GetDeviceList
(
function( VID: word; PID: word; Desc: string; Loc: string; DevicePath: string): boolean
begin
var key := (VID shl 16) + PID;
if key = $16D00712 then
begin
var dev := AllocateDevice( DevicePath);
if dev is TTrinity then
with TTrinity(dev) do
begin
Open;
c := TTrinity(dev).Capabilities;
if (Functions = []) or ( (c * Functions) = Functions)
then s := Caps2String( c)
else s := '';
if s <> '' then
Desc := Desc +' ['+ s +']';
Close
end;
dev.Free;
end;
writeln( Format(' %4.4X %4.4X %-40.40s %s', [VID, PID, Desc, Loc]));
exit( true)
end
)
end;
// ================================================================================================
// fx2 /list
// ================================================================================================
procedure TcmdMain.doCmdListFx2( Functions : TCapabilities);
var
c : TCapabilities;
s : string;
begin
writeln;
writeln('------------------------------------------------------------------------------');
writeln(' Device Functions Location Serial ');
writeln('------------------------------------------------------------------------------');
GetDeviceList
(
function( VID: word; PID: word; Desc: string; Loc: string; DevicePath: string): boolean
begin
var key := (vid shl 16) +pid;
var dev := AllocateDevice( DevicePath);
if dev is TTrinity then
with TTrinity(dev) do
begin
Open;
c := TTrinity(dev).Capabilities;
if (Functions = []) or ( (c * Functions) = Functions) then
s := Caps2String( c);
Loc := Loc + ' '+ Format('%-8.8s',[TTrinity(dev).SerialNumber]);
writeln( Format(' Trinity %-41.41s %s', [ s, Loc]));
Close
end;
dev.Free;
exit( true)
end,
$16D0,
$0712
)
end;
// ================================================================================================
// fx2 /loc:xxxx=file.hex [/perm]
// ================================================================================================
procedure TcmdMain.doCmdProgramFX2( const Location: string; const Filename: string; Permanent: boolean);
begin
GetDeviceList
(
function( VID: word; PID: word; Desc: string; Loc: string; DevicePath: string): boolean
begin
if Length( Location) <= Length( Loc) then
begin
var re := TRegEx.Create( Location+'$');
if re.IsMatch( Loc) then
begin
writeln(Format('Programming "%s" @ %s', [Desc, Loc]));
var dev := AllocateDevice( DevicePath);
if dev is TTrinity then
with TTrinity(dev) do
begin
Open;
if not Permanent
then DownloadFirmware( FileName)
else DownloadFirmwarePerm( FileName);
Close
end;
dev.Free;
exit(false)
end;
end;
exit( true)
end
)
end;
// @@@: JTAG ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// JTAG
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// jtag /list
// ================================================================================================
procedure TcmdMain.doCmdListJtag;
begin
doCmdListFx2( [capJTAG]);
end;
// ================================================================================================
// jtag /id:xxxx /list
// ================================================================================================
procedure TcmdMain.DoCmdListJTAGDevices(ID: string);
var
tri: ITrinity;
jtg: IJTAG;
ids: array [0..9] of cardinal;
s : string;
begin
writeln;
writeln('------------------------------------------------------------------------------');
writeln(' Device JTAG chain Location Serial ');
writeln('------------------------------------------------------------------------------');
GetDeviceList
(
function( VID: word; PID: word; Desc: string; Loc: string; DevicePath: string): boolean
begin
var key := (vid shl 16) +pid;
var dev := AllocateDevice( DevicePath);
if Supports( dev, ITrinity, tri) then
begin
tri.Open;
if tri.SerialNumber = ID then
begin
if Supports( dev, IJTAG, jtg) then
begin
jtg.scan( @ids[0], 10);
s := '';
for var i := 0 to 9 do
begin
if ids[i] <> 0 then
begin
if s <> '' then
s := s+ ', ';
s := s + Format( '%8.8X', [ids[i]]);
end
else break
end;
end;
Loc := Loc + ' '+ Format('%-8.8s',[tri.SerialNumber]);
if capJTAG in tri.Capabilities then
writeln( Format(' %-9.9s %-41.41s %s', [ Desc, s, Loc]));
end;
tri.Close
end;
exit( true)
end,
$16D0,
$0712
)
end;
// ================================================================================================
// jtag /id:xxx=file[svf,vme]
// ================================================================================================
procedure TcmdMain.doCmdProgramJTAG(const ID, FileName, Verbose: string);
var
tri: ITrinity;
jtg: IJTAG;
led: ILED;
lcd: ILCD;
ids: array [0..9] of cardinal;
s : string;
begin
GetDeviceList
(
function( VID: word; PID: word; Desc: string; Loc: string; DevicePath: string): boolean
begin
result := true;
var dev := AllocateDevice( DevicePath);
if Supports( dev, ITrinity, tri) then
begin
tri.Open;
if ID = tri.SerialNumber then
begin
Supports( tri, ILED, led);
Supports( tri, ILCD, lcd);
if Supports( tri, IJTAG, jtg) then
begin
if led <> nil then
begin
led.LedOn(0);
led.LedOff(3)
end;
if lcd <> nil then
begin
lcd.Cls;
lcd.GotoXY(0,0);
lcd.putc('<');
end;
jtg.scan( @ids[0], 10);
writeln( Format('Programming %-8.8X', [ids[0]]));
jtg.play( FileName);
if lcd <> nil then
lcd.putc('>');
if led <> nil then
begin
led.LedOff(0);
led.LedOn(3)
end;
result := false
end
end;
tri.Close
end;
end,
$16D0,
$0712
)
end;
end.