From 7a64fa18fb430757de58948be86c70541e6eb205 Mon Sep 17 00:00:00 2001 From: Abu Abacus Date: Sat, 3 Jan 2026 18:57:08 +0100 Subject: [PATCH] Initial check in --- .gitignore | 26 + prj.prgc/Delphi12Athens/prgc.dpr | 28 + prj.prgc/Delphi12Athens/prgc.dproj | 1110 ++++++++++++++++++++++++++ prj.prgc/Delphi12Athens/prgc.rc | 13 + src.prgc/grammar/prg.dpp | 4 + src.prgc/grammar/prgLexer.g | 155 ++++ src.prgc/grammar/prgLexer.pas | 609 ++++++++++++++ src.prgc/grammar/prgLexerTokens.pas | 38 + src.prgc/grammar/prgLexerTokens.txt | 26 + src.prgc/grammar/prgParser.g | 247 ++++++ src.prgc/grammar/prgParser.pas | 280 +++++++ src.prgc/grammar/prgParserTokens.pas | 38 + src.prgc/grammar/prgParserTokens.txt | 26 + src.prgc/main.pas | 407 ++++++++++ 14 files changed, 3007 insertions(+) create mode 100644 .gitignore create mode 100644 prj.prgc/Delphi12Athens/prgc.dpr create mode 100644 prj.prgc/Delphi12Athens/prgc.dproj create mode 100644 prj.prgc/Delphi12Athens/prgc.rc create mode 100644 src.prgc/grammar/prg.dpp create mode 100644 src.prgc/grammar/prgLexer.g create mode 100644 src.prgc/grammar/prgLexer.pas create mode 100644 src.prgc/grammar/prgLexerTokens.pas create mode 100644 src.prgc/grammar/prgLexerTokens.txt create mode 100644 src.prgc/grammar/prgParser.g create mode 100644 src.prgc/grammar/prgParser.pas create mode 100644 src.prgc/grammar/prgParserTokens.pas create mode 100644 src.prgc/grammar/prgParserTokens.txt create mode 100644 src.prgc/main.pas diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..1cd8848 --- /dev/null +++ b/.gitignore @@ -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 + diff --git a/prj.prgc/Delphi12Athens/prgc.dpr b/prj.prgc/Delphi12Athens/prgc.dpr new file mode 100644 index 0000000..8e76e17 --- /dev/null +++ b/prj.prgc/Delphi12Athens/prgc.dpr @@ -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. diff --git a/prj.prgc/Delphi12Athens/prgc.dproj b/prj.prgc/Delphi12Athens/prgc.dproj new file mode 100644 index 0000000..a7c0268 --- /dev/null +++ b/prj.prgc/Delphi12Athens/prgc.dproj @@ -0,0 +1,1110 @@ + + + {5209193D-2726-4662-92FA-98C9966B6CA0} + 20.3 + None + True + Debug + Win32 + prgc + 1 + Console + prgc.dpr + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + prgc + + + vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;Skia.Package.RTL;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;soapmidas;vclactnband;fmxFireDAC;dbexpress;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;Skia.Package.FMX;FireDACOracleDriver;fmxdae;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;Skia.Package.VCL;vcldb;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;fmxobj;bindcompvclsmp;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + fx2 /list + (None) + none + + + vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;soapmidas;vclactnband;fmxFireDAC;dbexpress;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;fmxdae;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;Skia.Package.VCL;vcldb;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;fmxobj;bindcompvclsmp;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage) + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + true + true + + + false + C:\Work\mr.sw\sw.bds\bds.tools\mr.devmgr\src.devmgr\;$(Debugger_DebugSourcePath) + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + + MainSource + + + + + + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Application + + + + prgc.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + true + + + + + true + + + + + true + + + + + prgc.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\values-v35 + 1 + + + res\values-v35 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + True + False + + + 12 + + + + + diff --git a/prj.prgc/Delphi12Athens/prgc.rc b/prj.prgc/Delphi12Athens/prgc.rc new file mode 100644 index 0000000..79bb1c7 --- /dev/null +++ b/prj.prgc/Delphi12Athens/prgc.rc @@ -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 diff --git a/src.prgc/grammar/prg.dpp b/src.prgc/grammar/prg.dpp new file mode 100644 index 0000000..97f79eb --- /dev/null +++ b/src.prgc/grammar/prg.dpp @@ -0,0 +1,4 @@ +DPG project + Grammar = "prgLexer.g" + Grammar = "prgParser.g" +End diff --git a/src.prgc/grammar/prgLexer.g b/src.prgc/grammar/prgLexer.g new file mode 100644 index 0000000..1897018 --- /dev/null +++ b/src.prgc/grammar/prgLexer.g @@ -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 +{ +} + diff --git a/src.prgc/grammar/prgLexer.pas b/src.prgc/grammar/prgLexer.pas new file mode 100644 index 0000000..e5ba8a7 --- /dev/null +++ b/src.prgc/grammar/prgLexer.pas @@ -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. diff --git a/src.prgc/grammar/prgLexerTokens.pas b/src.prgc/grammar/prgLexerTokens.pas new file mode 100644 index 0000000..be9c041 --- /dev/null +++ b/src.prgc/grammar/prgLexerTokens.pas @@ -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. diff --git a/src.prgc/grammar/prgLexerTokens.txt b/src.prgc/grammar/prgLexerTokens.txt new file mode 100644 index 0000000..69d683b --- /dev/null +++ b/src.prgc/grammar/prgLexerTokens.txt @@ -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 diff --git a/src.prgc/grammar/prgParser.g b/src.prgc/grammar/prgParser.g new file mode 100644 index 0000000..cdd8892 --- /dev/null +++ b/src.prgc/grammar/prgParser.g @@ -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; + +} + diff --git a/src.prgc/grammar/prgParser.pas b/src.prgc/grammar/prgParser.pas new file mode 100644 index 0000000..5e4a5ba --- /dev/null +++ b/src.prgc/grammar/prgParser.pas @@ -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. diff --git a/src.prgc/grammar/prgParserTokens.pas b/src.prgc/grammar/prgParserTokens.pas new file mode 100644 index 0000000..272ca27 --- /dev/null +++ b/src.prgc/grammar/prgParserTokens.pas @@ -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. diff --git a/src.prgc/grammar/prgParserTokens.txt b/src.prgc/grammar/prgParserTokens.txt new file mode 100644 index 0000000..c53e73c --- /dev/null +++ b/src.prgc/grammar/prgParserTokens.txt @@ -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 diff --git a/src.prgc/main.pas b/src.prgc/main.pas new file mode 100644 index 0000000..0b82b6a --- /dev/null +++ b/src.prgc/main.pas @@ -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.