* retag for unitrwunitrw

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/unitrw@1551 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 128 insertions, 0 deletions

diff --git a/compiler/dbgbase.pas b/compiler/dbgbase.pas
new file mode 100644
index 0000000000..681230743d
--- /dev/null
+++ b/compiler/dbgbase.pas
@@ -0,0 +1,128 @@
+{
+    Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl
+
+    This units contains support for debug info generation
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit dbgbase;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      systems,
+      symdef,symtype,
+      symsym,
+      aasmtai;
+
+    type
+      TDebugInfo=class
+        constructor Create;virtual;
+        procedure inserttypeinfo;virtual;
+        procedure insertmoduleinfo;virtual;
+        procedure insertlineinfo(list:taasmoutput);virtual;
+        procedure referencesections(list:taasmoutput);virtual;
+      end;
+      TDebugInfoClass=class of TDebugInfo;
+
+    var
+      CDebugInfo : array[tdbg] of TDebugInfoClass;
+      DebugInfo  : TDebugInfo;
+
+    procedure InitDebugInfo;
+    procedure DoneDebugInfo;
+    procedure RegisterDebugInfo(const r:tdbginfo;c:TDebugInfoClass);
+
+
+implementation
+
+    uses
+      verbose;
+
+
+    constructor tdebuginfo.Create;
+      begin
+      end;
+
+
+    procedure tdebuginfo.insertmoduleinfo;
+      begin
+      end;
+
+
+    procedure tdebuginfo.inserttypeinfo;
+      begin
+      end;
+
+
+    procedure tdebuginfo.insertlineinfo(list:taasmoutput);
+      begin
+      end;
+
+
+    procedure tdebuginfo.referencesections(list:taasmoutput);
+      begin
+      end;
+
+
+    procedure InitDebugInfo;
+      begin
+        if not assigned(CDebugInfo[target_dbg.id]) then
+          begin
+            Comment(V_Fatal,'cg_f_debuginfo_output_not_supported');
+            exit;
+          end;
+        DebugInfo:=CDebugInfo[target_dbg.id].Create;
+      end;
+
+
+    procedure DoneDebugInfo;
+      begin
+        if assigned(DebugInfo) then
+          begin
+            DebugInfo.Free;
+            DebugInfo:=nil;
+          end;
+      end;
+
+
+    procedure RegisterDebugInfo(const r:tdbginfo;c:TDebugInfoClass);
+      var
+        t : tdbg;
+      begin
+        t:=r.id;
+        if assigned(dbginfos[t]) then
+          writeln('Warning: DebugInfo is already registered!')
+        else
+          Getmem(dbginfos[t],sizeof(tdbginfo));
+        dbginfos[t]^:=r;
+        CDebugInfo[t]:=c;
+      end;
+
+
+    const
+      dbg_none_info : tdbginfo =
+         (
+           id     : dbg_none;
+           idtxt  : 'NONE';
+         );
+
+initialization
+  RegisterDebugInfo(dbg_none_info,tdebuginfo);
+end.