/debugger/fpdebug/dbgutil.pp

http://github.com/graemeg/lazarus · Puppet · 112 lines · 90 code · 22 blank · 0 comment · 10 complexity · 109df5a5f02172efdbe515de2e2f5e43 MD5 · raw file

  1. { $Id$ }
  2. {
  3. ---------------------------------------------------------------------------
  4. dbgutil.pp - Native freepascal debugger - Utilities
  5. ---------------------------------------------------------------------------
  6. This unit contains utility functions
  7. ---------------------------------------------------------------------------
  8. @created(Mon Apr 10th WET 2006)
  9. @lastmod($Date$)
  10. @author(Marc Weustink <marc@@dommelstein.nl>)
  11. ***************************************************************************
  12. * *
  13. * This source is free software; you can redistribute it and/or modify *
  14. * it under the terms of the GNU General Public License as published by *
  15. * the Free Software Foundation; either version 2 of the License, or *
  16. * (at your option) any later version. *
  17. * *
  18. * This code is distributed in the hope that it will be useful, but *
  19. * WITHOUT ANY WARRANTY; without even the implied warranty of *
  20. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
  21. * General Public License for more details. *
  22. * *
  23. * A copy of the GNU General Public License is available on the World *
  24. * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
  25. * obtain it by writing to the Free Software Foundation, *
  26. * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
  27. * *
  28. ***************************************************************************
  29. }
  30. unit DbgUtil;
  31. {$mode objfpc}{$H+}
  32. interface
  33. uses
  34. Classes, SysUtils;
  35. type
  36. THexValueFormatFlag = (hvfSigned, hvfPrefixPositive, hvfIncludeHexchar);
  37. THexValueFormatFlags = set of THexValueFormatFlag;
  38. function AlignPtr(Src: Pointer; Alignment: Byte): Pointer;
  39. function HexValue(const AValue; ASize: Byte; AFlags: THexValueFormatFlags): String;
  40. procedure Log(const AText: String; const AParams: array of const); overload;
  41. procedure Log(const AText: String); overload;
  42. implementation
  43. function AlignPtr(Src: Pointer; Alignment: Byte): Pointer;
  44. begin
  45. Result := Pointer(((PtrUInt(Src) + Alignment - 1) and not PtrUInt(Alignment - 1)));
  46. end;
  47. function HexValue(const AValue; ASize: Byte; AFlags: THexValueFormatFlags): String;
  48. var
  49. i: Int64;
  50. p: PByte;
  51. begin
  52. if ASize > 8
  53. then begin
  54. Result := 'HexValue: size to large';
  55. Exit;
  56. end;
  57. if ASize = 0
  58. then begin
  59. Result := '';
  60. Exit;
  61. end;
  62. p := @AValue;
  63. if p[ASize - 1] < $80
  64. then Exclude(AFlags, hvfSigned);
  65. if hvfSigned in AFlags
  66. then i := -1
  67. else i := 0;
  68. Move(AValue, i, ASize);
  69. if hvfSigned in AFlags
  70. then begin
  71. i := not i + 1;
  72. Result := '-';
  73. end
  74. else begin
  75. if hvfPrefixPositive in AFlags
  76. then Result := '+';
  77. end;
  78. if hvfIncludeHexchar in AFlags
  79. then Result := Result + '$';
  80. Result := Result + HexStr(i, ASize * 2);
  81. end;
  82. procedure Log(const AText: String; const AParams: array of const); overload;
  83. begin
  84. WriteLN(Format(AText, AParams));
  85. end;
  86. procedure Log(const AText: String); overload;
  87. begin
  88. WriteLN(AText);
  89. end;
  90. end.