development/compilers/freepascal/compiler/og386dbg.pas

   1 {
   2     $Id$
   3     Copyright (c) 1998-2000 by Peter Vreman
   4
   5     Contains the 386 binary writer for debugging purposes
   6
   7     * This code was inspired by the NASM sources
   8       The Netwide Assembler is copyright (C) 1996 Simon Tatham and
   9       Julian Hall. All rights reserved.
  10
  11     This program is free software; you can redistribute it and/or modify
  12     it under the terms of the GNU General Public License as published by
  13     the Free Software Foundation; either version 2 of the License, or
  14     (at your option) any later version.
  15
  16     This program is distributed in the hope that it will be useful,
  17     but WITHOUT ANY WARRANTY; without even the implied warranty of
  18     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19     GNU General Public License for more details.
  20
  21     You should have received a copy of the GNU General Public License
  22     along with this program; if not, write to the Free Software
  23     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25  ****************************************************************************
  26 }
  27 unit og386dbg;
  28
  29   interface
  30     uses
  31        systems,aasm,cpubase,og386;
  32
  33     type
  34        pdbgoutput = ^tdbgoutput;
  35        tdbgoutput = object(tobjectoutput)
  36          nsyms   : longint;
  37          rawidx  : longint;
  38          constructor init(smart:boolean);
  39          destructor  done;virtual;
  40          procedure initwriting(Aplace:tcutplace);virtual;
  41          procedure donewriting;virtual;
  42          procedure writebytes(var data;len:longint);virtual;
  43          procedure writealloc(len:longint);virtual;
  44          procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);virtual;
  45          procedure writesymbol(p:pasmsymbol);virtual;
  46          procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;
  47        end;
  48
  49   implementation
  50
  51 {****************************************************************************
  52                                 Tdbgoutput
  53 ****************************************************************************}
  54
  55     constructor tdbgoutput.init(smart:boolean);
  56       begin
  57         inherited init(smart);
  58         rawidx:=-1;
  59         nsyms:=0;
  60       end;
  61
  62
  63     destructor tdbgoutput.done;
  64       begin
  65       end;
  66
  67
  68     procedure tdbgoutput.initwriting(Aplace:tcutplace);
  69       begin
  70         inherited initwriting(Aplace);
  71         writeln('initwriting '+Objfile);
  72       end;
  73
  74
  75     procedure tdbgoutput.donewriting;
  76       begin
  77         if rawidx<>-1 then
  78          begin
  79            writeln;
  80            rawidx:=-1;
  81          end;
  82         writeln('donewriting');
  83       end;
  84
  85
  86     procedure tdbgoutput.writesymbol(p:pasmsymbol);
  87       begin
  88         if rawidx<>-1 then
  89          begin
  90            writeln;
  91            rawidx:=-1;
  92          end;
  93         p^.idx:=nsyms;
  94         write('symbol [',nsyms,'] '+p^.name+' (',target_asm.secnames[p^.section],',',p^.address,',',p^.size,',');
  95         case p^.typ of
  96           AS_LOCAL :
  97             writeln('local)');
  98           AS_GLOBAL :
  99             writeln('global)');
 100           AS_EXTERNAL :
 101             writeln('extern)');
 102         else
 103           writeln('unknown)');
 104         end;
 105         inc(nsyms);
 106       end;
 107
 108
 109     procedure tdbgoutput.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
 110       begin
 111         if rawidx<>-1 then
 112          begin
 113            writeln;
 114            rawidx:=-1;
 115          end;
 116         if assigned(p) then
 117           write('reloc: ',data,' [',target_asm.secnames[p^.section],',',p^.address,']')
 118         else
 119           write('reloc: ',data);
 120         case relative of
 121           relative_true : writeln(' relative');
 122           relative_false: writeln(' not relative');
 123           relative_rva  : writeln(' relative virtual address');
 124         end;
 125       end;
 126
 127
 128     procedure tdbgoutput.writebytes(var data;len:longint);
 129
 130         function hexstr(val : longint;cnt : byte) : string;
 131         const
 132           HexTbl : array[0..15] of char='0123456789ABCDEF';
 133         var
 134           i : longint;
 135         begin
 136           hexstr[0]:=char(cnt);
 137           for i:=cnt downto 1 do
 138            begin
 139              hexstr[i]:=hextbl[val and $f];
 140              val:=val shr 4;
 141            end;
 142         end;
 143
 144       var
 145         p : pchar;
 146         i : longint;
 147       begin
 148         if len=0 then
 149          exit;
 150         p:=@data;
 151         if rawidx=-1 then
 152          begin
 153            write('raw: ');
 154            rawidx:=0;
 155          end;
 156         for i:=1to len do
 157          begin
 158            if rawidx>=16 then
 159             begin
 160               writeln;
 161               write('raw: ');
 162               rawidx:=0;
 163             end;
 164            write(hexstr(ord(p[i-1]),2),' ');
 165            inc(rawidx);
 166          end;
 167       end;
 168
 169     procedure tdbgoutput.writealloc(len:longint);
 170       begin
 171         writeln('alloc: ',len);
 172       end;
 173
 174     procedure tdbgoutput.writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);
 175       begin
 176         writeln('stabs: ',line,',',nidx,'"',p,'"');
 177       end;
 178
 179
 180 end.
 181 {
 182   $Log$
 183   Revision 1.1  2002/02/19 08:22:37  sasu
 184   Initial revision
 185
 186   Revision 1.1  2000/07/13 06:29:52  michael
 187   + Initial import
 188
 189   Revision 1.8  2000/02/09 13:22:54  peter
 190     * log truncated
 191
 192   Revision 1.7  2000/01/07 01:14:27  peter
 193     * updated copyright to 2000
 194
 195   Revision 1.6  1999/11/02 15:06:57  peter
 196     * import library fixes for win32
 197     * alignment works again
 198
 199   Revision 1.5  1999/08/04 00:23:06  florian
 200     * renamed i386asm and i386base to cpuasm and cpubase
 201
 202 }