Initial check in dpgc

2026-01-03 18:35:52 +01:00
parent 5666f85e99
commit de58f9a4e5
4 changed files with 1251 additions and 0 deletions
@@ -1,5 +1,6 @@
 bin
 *.dcu
+*.exe
 prj.dpgxcon\Win32
 prj.dpgxcon\Win64

@@ -0,0 +1,34 @@
+program dpgc;
+
+{$APPTYPE CONSOLE}
+
+{$R *.res}
+
+uses
+  System.SysUtils,
+  dpgc.Main in 'src\dpgc.Main.pas';
+
+var
+   main: TdpgcMain;
+
+
+begin
+   try
+      if ParamCount = 1 then
+      begin
+         if FileExists(ParamStr(1)) then
+         begin
+            main := TdpgcMain.Create;
+            main.Parse(ParamStr(1));
+         end
+         else
+            writeln('Grammar file "' +ParamStr(1)+ '" doesn''t exsist.');
+      end
+
+      else
+         writeln('Usage: dpgc <input_file>');
+
+   except
+      on E:Exception do Writeln(E.Classname, ': ', E.Message);
+   end
+end.
@@ -0,0 +1,112 @@
+unit dpgc.Main;
+
+interface
+uses
+   System.Classes,
+   System.SysUtils,
+   dpgrtl.types,
+   dpglib.types;
+
+type
+   TdpgcMain = class( TInterfacedObject, IToolErrorHandler)
+      protected
+         fWarnings: integer;
+         fErrors  : integer;
+         fPanics  : integer;
+
+      protected
+         procedure   Warning( pMessage: string; FileName:string=''; Line:integer=0; Column:integer=0);
+         procedure   Error(   pMessage: string; FileName:string=''; Line:integer=0; Column:integer=0);
+         procedure   Panic(   pMessage: string; FileName:string=''; Line:integer=0; Column:integer=0);
+
+      public
+         procedure   Parse(   FileName: string);
+   end;
+
+implementation
+uses
+   dpgrtl.exception,
+   dpglib.Tool;
+
+{ TdpgcMain }
+
+
+
+// @@@: dpgContext event handlers +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+//
+//                                   dpgContext event handlers
+//
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ================================================================================================
+// DoWarning
+// ================================================================================================
+procedure TdpgcMain.Warning(pMessage: string; FileName:string; Line:integer; Column:integer);
+begin
+   writeln(pMessage);
+   INC(fWarnings)
+end;
+
+// ================================================================================================
+// DoError
+// ================================================================================================
+procedure TdpgcMain.Error(pMessage: string; FileName:string; Line:integer; Column:integer);
+begin
+   writeln(pMessage);
+   INC(fErrors)
+end;
+
+// ================================================================================================
+// DoPanic
+// ================================================================================================
+procedure TdpgcMain.Panic(pMessage: string; FileName:string; Line:integer; Column:integer);
+begin
+   writeln(pMessage);
+   INC(fPanics)
+end;
+
+
+
+// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+//
+//                                           Interface
+//
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+// ================================================================================================
+// Parse
+// ================================================================================================
+procedure TdpgcMain.Parse(FileName: string);
+var
+   stm : TMemoryStream;
+   tool: ITool;
+
+begin
+   if FileExists( FileName) then
+   begin
+      try
+         stm := TMemoryStream.Create;
+         stm.LoadFromFile(FileName);
+         stm.Seek(0, soFromBeginning);
+
+         tool := TTool.Create( stm, AnsiString(FileName), '', '', self);
+         tool.Go;
+
+         stm.Free
+
+      except
+         on e: EMismatchedToken  do writeln('upsz');
+         on e: EMismatchedChar   do writeln('haho');
+         on e: Exception do writeln (e.ClassName);
+         else writeln('Ezmiez')
+      end
+   end
+end;
+
+end.