/debugger/fpdebug/dbgutil.pp

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