dbgbase.pas 2.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384
  1. {
  2. Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl
  3. This units contains support for debug info generation
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit dbgbase;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. systems;
  22. type
  23. TDebugInfo=class
  24. end;
  25. TDebugInfoClass=class of TDebugInfo;
  26. var
  27. CDebugInfo : array[tdbg] of TDebugInfoClass;
  28. DebugInfo : TDebugInfo;
  29. procedure InitDebugInfo;
  30. procedure DoneDebugInfo;
  31. procedure RegisterDebugInfo(const r:tdbginfo;c:TDebugInfoClass);
  32. implementation
  33. uses
  34. verbose;
  35. procedure InitDebugInfo;
  36. begin
  37. if not assigned(CDebugInfo[target_dbg.id]) then
  38. begin
  39. Comment(V_Fatal,'cg_f_debuginfo_output_not_supported');
  40. exit;
  41. end;
  42. DebugInfo:=CDebugInfo[target_dbg.id].Create;
  43. end;
  44. procedure DoneDebugInfo;
  45. begin
  46. if assigned(DebugInfo) then
  47. begin
  48. DebugInfo.Free;
  49. DebugInfo:=nil;
  50. end;
  51. end;
  52. procedure RegisterDebugInfo(const r:tdbginfo;c:TDebugInfoClass);
  53. var
  54. t : tdbg;
  55. begin
  56. t:=r.id;
  57. if assigned(dbginfos[t]) then
  58. writeln('Warning: DebugInfo is already registered!')
  59. else
  60. Getmem(dbginfos[t],sizeof(tdbginfo));
  61. dbginfos[t]^:=r;
  62. CDebugInfo[t]:=c;
  63. end;
  64. end.