mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 22:49:35 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			819 lines
		
	
	
		
			25 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			819 lines
		
	
	
		
			25 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     $Id$
 | |
|     Copyright (c) 1998-2000 by Peter Vreman and Pierre Muller
 | |
| 
 | |
|     Contains the binary coff reader and writer
 | |
| 
 | |
|     * This code was inspired by the NASM sources
 | |
|       The Netwide Assembler is copyright (C) 1996 Simon Tatham and
 | |
|       Julian Hall. All rights reserved.
 | |
| 
 | |
|     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 ogcoff;
 | |
| 
 | |
| {$i defines.inc}
 | |
| 
 | |
| interface
 | |
| 
 | |
|     uses
 | |
|        { common }
 | |
|        cclasses,cobjects,
 | |
|        { target }
 | |
|        systems,
 | |
|        { assembler }
 | |
|        cpubase,aasm,
 | |
|        { output }
 | |
|        ogbase;
 | |
| 
 | |
|     type
 | |
|        tcoffsection = class(tobjectsection)
 | |
|        public
 | |
|           flags    : cardinal;
 | |
|           relocpos : longint;
 | |
|           constructor createsec(sec:TSection;AAlign,AFlags:cardinal);
 | |
|        end;
 | |
| 
 | |
|        tcoffdata = class(tobjectdata)
 | |
|        private
 | |
|          win32   : boolean;
 | |
|          procedure reset;
 | |
|        public
 | |
|          constructor createdjgpp;
 | |
|          constructor createwin32;
 | |
|          destructor  destroy;override;
 | |
|          procedure setsectionsizes(var s:tsecsize);override;
 | |
|          procedure createsection(sec:tsection);override;
 | |
|          procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);override;
 | |
|          procedure writesymbol(p:pasmsymbol);override;
 | |
|          procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);override;
 | |
|          procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;nidx,nother,line:longint;reloc:boolean);override;
 | |
|          strs,
 | |
|          syms    : Tdynamicarray;
 | |
|        end;
 | |
| 
 | |
|        tcoffoutput = class(tobjectoutput)
 | |
|        private
 | |
|          win32   : boolean;
 | |
|          initsym : longint;
 | |
|          procedure write_relocs(s:tobjectsection);
 | |
|          procedure write_symbol(const name:string;strpos,value,section,typ,aux:longint);
 | |
|          procedure write_symbols;
 | |
|        protected
 | |
|          procedure writetodisk;override;
 | |
|        public
 | |
|          constructor createdjgpp(smart:boolean);
 | |
|          constructor createwin32(smart:boolean);
 | |
|          function  initwriting(Aplace:tcutplace):tobjectdata;override;
 | |
|        end;
 | |
| 
 | |
| 
 | |
| implementation
 | |
| 
 | |
|     uses
 | |
| {$ifdef delphi}
 | |
|        sysutils,
 | |
| {$else}
 | |
|        strings,
 | |
| {$endif}
 | |
|        cutils,verbose,
 | |
|        globtype,globals,fmodule;
 | |
| 
 | |
|     const
 | |
|        symbolresize = 200*18;
 | |
|        strsresize   = 8192;
 | |
|        DataResize   = 8192;
 | |
| 
 | |
|     type
 | |
|        { Structures which are written directly to the output file }
 | |
|        coffheader=packed record
 | |
|          mach   : word;
 | |
|          nsects : word;
 | |
|          time   : longint;
 | |
|          sympos : longint;
 | |
|          syms   : longint;
 | |
|          opthdr : word;
 | |
|          flag   : word;
 | |
|        end;
 | |
|        coffsechdr=packed record
 | |
|          name     : array[0..7] of char;
 | |
|          vsize    : longint;
 | |
|          rvaofs   : longint;
 | |
|          datasize  : longint;
 | |
|          datapos  : longint;
 | |
|          relocpos : longint;
 | |
|          lineno1  : longint;
 | |
|          nrelocs  : word;
 | |
|          lineno2  : word;
 | |
|          flags    : cardinal;
 | |
|        end;
 | |
|        coffsectionrec=packed record
 | |
|          len     : longint;
 | |
|          nrelocs : word;
 | |
|          empty   : array[0..11] of char;
 | |
|        end;
 | |
|        coffreloc=packed record
 | |
|          address  : longint;
 | |
|          sym      : longint;
 | |
|          relative : word;
 | |
|        end;
 | |
|        coffsymbol=packed record
 | |
|          name    : array[0..3] of char; { real is [0..7], which overlaps the strpos ! }
 | |
|          strpos  : longint;
 | |
|          value   : longint;
 | |
|          section : smallint;
 | |
|          empty   : smallint;
 | |
|          typ     : byte;
 | |
|          aux     : byte;
 | |
|        end;
 | |
|        pcoffstab=^coffstab;
 | |
|        coffstab=packed record
 | |
|          strpos  : longint;
 | |
|          ntype   : byte;
 | |
|          nother  : byte;
 | |
|          ndesc   : word;
 | |
|          nvalue  : longint;
 | |
|        end;
 | |
| 
 | |
| 
 | |
| {****************************************************************************
 | |
|                                TCoffSection
 | |
| ****************************************************************************}
 | |
| 
 | |
|     constructor tcoffsection.createsec(sec:TSection;AAlign,AFlags:cardinal);
 | |
|       begin
 | |
|         inherited create(target_asm.secnames[sec],AAlign,(sec=sec_bss));
 | |
|         Flags:=AFlags;
 | |
|       end;
 | |
| 
 | |
| 
 | |
| {****************************************************************************
 | |
|                                 TCoffData
 | |
| ****************************************************************************}
 | |
| 
 | |
|     constructor tcoffdata.createdjgpp;
 | |
|       begin
 | |
|         inherited create;
 | |
|         win32:=false;
 | |
|         reset;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     constructor tcoffdata.createwin32;
 | |
|       begin
 | |
|         inherited create;
 | |
|         win32:=true;
 | |
|         reset;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     destructor tcoffdata.destroy;
 | |
|       begin
 | |
|         inherited destroy;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tcoffdata.reset;
 | |
|       var
 | |
|         s : string;
 | |
|       begin
 | |
|         Syms:=TDynamicArray.Create(symbolresize);
 | |
|         Strs:=TDynamicArray.Create(strsresize);
 | |
|         { we need at least the following 3 sections }
 | |
|         createsection(sec_code);
 | |
|         createsection(sec_data);
 | |
|         createsection(sec_bss);
 | |
|         if (cs_gdb_lineinfo in aktglobalswitches) or
 | |
|            (cs_debuginfo in aktmoduleswitches) then
 | |
|          begin
 | |
|            createsection(sec_stab);
 | |
|            createsection(sec_stabstr);
 | |
|            writestabs(sec_none,0,nil,0,0,0,false);
 | |
|            { write zero pchar and name together (PM) }
 | |
|            s:=#0+SplitFileName(current_module.mainsource^)+#0;
 | |
|            sects[sec_stabstr].write(s[1],length(s));
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tcoffdata.createsection(sec:TSection);
 | |
|       var
 | |
|         Flags,
 | |
|         AAlign : cardinal;
 | |
|       begin
 | |
|         { defaults }
 | |
|         Flags:=0;
 | |
|         Aalign:=1;
 | |
|         { alignment after section }
 | |
|         case sec of
 | |
|           sec_code :
 | |
|             begin
 | |
|               if win32 then
 | |
|                Flags:=$60000020
 | |
|               else
 | |
|                Flags:=$20;
 | |
|               Aalign:=4;
 | |
|             end;
 | |
|           sec_data :
 | |
|             begin
 | |
|               if win32 then
 | |
|                Flags:=$c0300040
 | |
|               else
 | |
|                Flags:=$40;
 | |
|               Aalign:=4;
 | |
|             end;
 | |
|           sec_bss :
 | |
|             begin
 | |
|               if win32 then
 | |
|                Flags:=$c0300080
 | |
|               else
 | |
|                Flags:=$80;
 | |
|               Aalign:=4;
 | |
|             end;
 | |
|           sec_idata2,
 | |
|           sec_idata4,
 | |
|           sec_idata5,
 | |
|           sec_idata6,
 | |
|           sec_idata7 :
 | |
|             begin
 | |
|               if win32 then
 | |
|                Flags:=$40000000;
 | |
|             end;
 | |
|           sec_edata :
 | |
|             begin
 | |
|               if win32 then
 | |
|                Flags:=$c0300040;
 | |
|             end;
 | |
|         end;
 | |
|         sects[sec]:=tcoffSection.createsec(Sec,AAlign,Flags);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tcoffdata.writesymbol(p:pasmsymbol);
 | |
|       var
 | |
|         sym : toutputsymbol;
 | |
|         s   : string;
 | |
|       begin
 | |
|         { already written ? }
 | |
|         if p^.idx<>-1 then
 | |
|          exit;
 | |
|         { be sure that the section will exists }
 | |
|         if (p^.section<>sec_none) and not(assigned(sects[p^.section])) then
 | |
|           createsection(p^.section);
 | |
|         FillChar(sym,sizeof(sym),0);
 | |
|         sym.value:=p^.size;
 | |
|         sym.bind:=p^.bind;
 | |
|         sym.typ:=AT_NONE;
 | |
|         { if local of global then set the section value to the address
 | |
|           of the symbol }
 | |
|         if sym.bind in [AB_LOCAL,AB_GLOBAL] then
 | |
|          begin
 | |
|            sym.section:=p^.section;
 | |
|            sym.value:=p^.address+sects[sym.section].mempos;
 | |
|          end;
 | |
|         { store the symbol, but not the local ones }
 | |
|         if (sym.bind<>AB_LOCAL) then
 | |
|          begin
 | |
|            { symbolname }
 | |
|            s:=p^.name;
 | |
|            if length(s)>8 then
 | |
|             begin
 | |
|               sym.nameidx:=Strs.size+4;
 | |
|               Strs.writestr(s);
 | |
|               Strs.writestr(#0);
 | |
|             end
 | |
|            else
 | |
|             begin
 | |
|               sym.nameidx:=-1;
 | |
|               sym.namestr:=s;
 | |
|             end;
 | |
|            { update the asmsymbol index }
 | |
|            p^.idx:=Syms.size div sizeof(TOutputSymbol);
 | |
|            { write the symbol }
 | |
|            Syms.write(sym,sizeof(toutputsymbol));
 | |
|          end
 | |
|         else
 | |
|          begin
 | |
|            p^.idx:=-2; { local }
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tcoffdata.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
 | |
|       var
 | |
|         curraddr,
 | |
|         symaddr : longint;
 | |
|       begin
 | |
|         if not assigned(sects[currsec]) then
 | |
|          createsection(currsec);
 | |
|         if assigned(p) then
 | |
|          begin
 | |
|            { current address }
 | |
|            curraddr:=sects[currsec].mempos+sects[currsec].datasize;
 | |
|            { real address of the symbol }
 | |
|            symaddr:=p^.address;
 | |
|            if p^.section<>sec_none then
 | |
|             inc(symaddr,sects[p^.section].mempos);
 | |
|            { no symbol relocation need inside a section }
 | |
|            if p^.section=currsec then
 | |
|              begin
 | |
|                case relative of
 | |
|                  relative_false :
 | |
|                    begin
 | |
|                      sects[currsec].addsectionreloc(curraddr,currsec,relative_false);
 | |
|                      inc(data,symaddr);
 | |
|                    end;
 | |
|                  relative_true :
 | |
|                    begin
 | |
|                      inc(data,symaddr-len-sects[currsec].datasize);
 | |
|                    end;
 | |
|                  relative_rva :
 | |
|                    begin
 | |
|                      sects[currsec].addsectionreloc(curraddr,currsec,relative_rva);
 | |
|                      inc(data,symaddr);
 | |
|                    end;
 | |
|                end;
 | |
|              end
 | |
|            else
 | |
|              begin
 | |
|                writesymbol(p);
 | |
|                if (p^.section<>sec_none) and (relative<>relative_true) then
 | |
|                  sects[currsec].addsectionreloc(curraddr,p^.section,relative)
 | |
|                else
 | |
|                  sects[currsec].addsymreloc(curraddr,p,relative);
 | |
|                if not win32 then {seems wrong to me (PM) }
 | |
|                 inc(data,symaddr)
 | |
|                else
 | |
|                 if (relative<>relative_true) and (p^.section<>sec_none) then
 | |
|                  inc(data,symaddr);
 | |
|                if relative=relative_true then
 | |
|                 begin
 | |
|                   if win32 then
 | |
|                     dec(data,len-4)
 | |
|                   else
 | |
|                     dec(data,len+sects[currsec].datasize);
 | |
|                 end;
 | |
|             end;
 | |
|          end;
 | |
|         sects[currsec].write(data,len);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tcoffdata.writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc : boolean);
 | |
|       var
 | |
|         stab : coffstab;
 | |
|         s : tsection;
 | |
|         curraddr : longint;
 | |
|       begin
 | |
|         s:=section;
 | |
|         { local var can be at offset -1 !! PM }
 | |
|         if reloc then
 | |
|          begin
 | |
|            if (offset=-1) then
 | |
|             begin
 | |
|               if s=sec_none then
 | |
|                offset:=0
 | |
|               else
 | |
|                offset:=sects[s].datasize;
 | |
|             end;
 | |
|            if (s<>sec_none) then
 | |
|             inc(offset,sects[s].datapos);
 | |
|          end;
 | |
|         if assigned(p) and (p[0]<>#0) then
 | |
|          begin
 | |
|            stab.strpos:=sects[sec_stabstr].datasize;
 | |
|            sects[sec_stabstr].write(p^,strlen(p)+1);
 | |
|          end
 | |
|         else
 | |
|          stab.strpos:=0;
 | |
|         stab.ntype:=nidx;
 | |
|         stab.ndesc:=line;
 | |
|         stab.nother:=nother;
 | |
|         stab.nvalue:=offset;
 | |
|         sects[sec_stab].write(stab,sizeof(stab));
 | |
|         { when the offset is not 0 then write a relocation, take also the
 | |
|           hdrstab into account with the offset }
 | |
|         if reloc then
 | |
|          begin
 | |
|            { current address }
 | |
|            curraddr:=sects[sec_stab].mempos+sects[sec_stab].datasize;
 | |
|            if DLLSource and RelocSection then
 | |
|            { avoid relocation in the .stab section
 | |
|              because it ends up in the .reloc section instead }
 | |
|              sects[sec_stab].addsectionreloc(curraddr-4,s,relative_rva)
 | |
|            else
 | |
|              sects[sec_stab].addsectionreloc(curraddr-4,s,relative_false);
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tcoffdata.writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
 | |
|                                                  nidx,nother,line:longint;reloc:boolean);
 | |
|       var
 | |
|         stab : coffstab;
 | |
|         curraddr : longint;
 | |
|       begin
 | |
|         { do not use the size stored in offset field
 | |
|          this is DJGPP specific ! PM }
 | |
|         if win32 then
 | |
|           offset:=0;
 | |
|         { local var can be at offset -1 !! PM }
 | |
|         if reloc then
 | |
|          begin
 | |
|            if (offset=-1) then
 | |
|             begin
 | |
|               if section=sec_none then
 | |
|                offset:=0
 | |
|               else
 | |
|                offset:=sects[section].datasize;
 | |
|             end;
 | |
|            if (section<>sec_none) then
 | |
|             inc(offset,sects[section].mempos);
 | |
|          end;
 | |
|         if assigned(p) and (p[0]<>#0) then
 | |
|          begin
 | |
|            stab.strpos:=sects[sec_stabstr].datasize;
 | |
|            sects[sec_stabstr].write(p^,strlen(p)+1);
 | |
|          end
 | |
|         else
 | |
|          stab.strpos:=0;
 | |
|         stab.ntype:=nidx;
 | |
|         stab.ndesc:=line;
 | |
|         stab.nother:=nother;
 | |
|         stab.nvalue:=offset;
 | |
|         sects[sec_stab].write(stab,sizeof(stab));
 | |
|         { when the offset is not 0 then write a relocation, take also the
 | |
|           hdrstab into account with the offset }
 | |
|         if reloc then
 | |
|          begin
 | |
|            { current address }
 | |
|            curraddr:=sects[sec_stab].mempos+sects[sec_stab].datasize;
 | |
|            if DLLSource and RelocSection then
 | |
|             { avoid relocation in the .stab section
 | |
|               because it ends up in the .reloc section instead }
 | |
|             sects[sec_stab].addsymreloc(curraddr-4,ps,relative_rva)
 | |
|            else
 | |
|             sects[sec_stab].addsymreloc(curraddr-4,ps,relative_false);
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tcoffdata.setsectionsizes(var s:tsecsize);
 | |
|       var
 | |
|         mempos : longint;
 | |
|         sec    : tsection;
 | |
|       begin
 | |
|         { multiply stab with real size }
 | |
|         s[sec_stab]:=s[sec_stab]*sizeof(coffstab);
 | |
|         { if debug then also count header stab }
 | |
|         if (cs_debuginfo in aktmoduleswitches) then
 | |
|          begin
 | |
|            inc(s[sec_stab],sizeof(coffstab));
 | |
|            inc(s[sec_stabstr],length(SplitFileName(current_module.mainsource^))+2);
 | |
|          end;
 | |
|         { calc mempos }
 | |
|         mempos:=0;
 | |
|         for sec:=low(tsection) to high(tsection) do
 | |
|          begin
 | |
|            if (s[sec]>0) and
 | |
|               (not assigned(sects[sec])) then
 | |
|              createsection(sec);
 | |
|            if assigned(sects[sec]) then
 | |
|             begin
 | |
|               sects[sec].memsize:=s[sec];
 | |
|               { memory position }
 | |
|               if not win32 then
 | |
|                begin
 | |
|                  sects[sec].mempos:=mempos;
 | |
|                  inc(mempos,align(sects[sec].memsize,sects[sec].addralign));
 | |
|                end;
 | |
|             end;
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
| {****************************************************************************
 | |
|                                 TCoffOutput
 | |
| ****************************************************************************}
 | |
| 
 | |
|     constructor tcoffoutput.createdjgpp(smart:boolean);
 | |
|       begin
 | |
|         inherited create(smart);
 | |
|         win32:=false;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     constructor tcoffoutput.createwin32(smart:boolean);
 | |
|       begin
 | |
|         inherited create(smart);
 | |
|         win32:=true;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function tcoffoutput.initwriting(Aplace:tcutplace):tobjectdata;
 | |
|       begin
 | |
|         inherited initwriting(Aplace);
 | |
|         initsym:=0;
 | |
|         if win32 then
 | |
|          data:=tcoffdata.createwin32
 | |
|         else
 | |
|          data:=tcoffdata.createdjgpp;
 | |
|         initwriting:=data;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tcoffoutput.write_relocs(s:tobjectsection);
 | |
|       var
 | |
|         rel  : coffreloc;
 | |
|         hr,r : poutputreloc;
 | |
|       begin
 | |
|         r:=s.relochead;
 | |
|         while assigned(r) do
 | |
|          begin
 | |
|            rel.address:=r^.address;
 | |
|            if assigned(r^.symbol) then
 | |
|             begin
 | |
|               if (r^.symbol^.bind=AB_LOCAL) then
 | |
|                rel.sym:=2*data.sects[r^.symbol^.section].secsymidx
 | |
|               else
 | |
|                begin
 | |
|                  if r^.symbol^.idx=-1 then
 | |
|                    internalerror(4321);
 | |
|                  rel.sym:=r^.symbol^.idx+initsym;
 | |
|                end;
 | |
|             end
 | |
|            else
 | |
|             begin
 | |
|               if r^.section<>sec_none then
 | |
|                rel.sym:=2*data.sects[r^.section].secsymidx
 | |
|               else
 | |
|                rel.sym:=0;
 | |
|             end;
 | |
|            case r^.typ of
 | |
|              relative_true  : rel.relative:=$14;
 | |
|              relative_false : rel.relative:=$6;
 | |
|              relative_rva   : rel.relative:=$7;
 | |
|            end;
 | |
|            writer.write(rel,sizeof(rel));
 | |
|            { goto next and dispose this reloc }
 | |
|            hr:=r;
 | |
|            r:=r^.next;
 | |
|            dispose(hr);
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tcoffoutput.write_symbol(const name:string;strpos,value,section,typ,aux:longint);
 | |
|       var
 | |
|         sym : coffsymbol;
 | |
|       begin
 | |
|         FillChar(sym,sizeof(sym),0);
 | |
|         if strpos=-1 then
 | |
|          move(name[1],sym.name,length(name))
 | |
|         else
 | |
|          sym.strpos:=strpos;
 | |
|         sym.value:=value;
 | |
|         sym.section:=section;
 | |
|         sym.typ:=typ;
 | |
|         sym.aux:=aux;
 | |
|         writer.write(sym,sizeof(sym));
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tcoffoutput.write_symbols;
 | |
|       var
 | |
|         filename  : string[18];
 | |
|         sec       : tsection;
 | |
|         sectionval,
 | |
|         i         : longint;
 | |
|         globalval : byte;
 | |
|         secrec    : coffsectionrec;
 | |
|         sym       : toutputsymbol;
 | |
|       begin
 | |
|         with tcoffdata(data) do
 | |
|          begin
 | |
|            { The `.file' record, and the file name auxiliary record }
 | |
|            write_symbol ('.file', -1, 0, -2, $67, 1);
 | |
|            fillchar(filename,sizeof(filename),0);
 | |
|            filename:=SplitFileName(current_module.mainsource^);
 | |
|            writer.write(filename[1],sizeof(filename)-1);
 | |
|            { The section records, with their auxiliaries, also store the
 | |
|              symbol index }
 | |
|            for sec:=low(tsection) to high(tsection) do
 | |
|             if assigned(sects[sec]) then
 | |
|              begin
 | |
|                write_symbol(target_asm.secnames[sec],-1,sects[sec].mempos,sects[sec].secsymidx,3,1);
 | |
|                fillchar(secrec,sizeof(secrec),0);
 | |
|                secrec.len:=sects[sec].aligneddatasize;
 | |
|                secrec.nrelocs:=sects[sec].nrelocs;
 | |
|                writer.write(secrec,sizeof(secrec));
 | |
|              end;
 | |
|            { The real symbols }
 | |
|            Syms.seek(0);
 | |
|            for i:=1 to Syms.size div sizeof(TOutputSymbol) do
 | |
|             begin
 | |
|               Syms.read(sym,sizeof(TOutputSymbol));
 | |
|               if sym.bind=AB_LOCAL then
 | |
|                 globalval:=3
 | |
|               else
 | |
|                 globalval:=2;
 | |
|               if assigned(sects[sym.section]) then
 | |
|                sectionval:=sects[sym.section].secsymidx
 | |
|               else
 | |
|                sectionval:=0;
 | |
|               write_symbol(sym.namestr,sym.nameidx,sym.value,sectionval,globalval,0);
 | |
|             end;
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure tcoffoutput.writetodisk;
 | |
|       var
 | |
|         datapos,
 | |
|         secsymidx,
 | |
|         nsects,
 | |
|         sympos,i : longint;
 | |
|         hstab    : coffstab;
 | |
|         gotreloc : boolean;
 | |
|         sec      : tsection;
 | |
|         header   : coffheader;
 | |
|         sechdr   : coffsechdr;
 | |
|         empty    : array[0..15] of byte;
 | |
|         hp       : pdynamicblock;
 | |
|       begin
 | |
|         with tcoffdata(data) do
 | |
|          begin
 | |
|          { calc amount of sections we have }
 | |
|            fillchar(empty,sizeof(empty),0);
 | |
|            nsects:=0;
 | |
|            initsym:=2;   { 2 for the file }
 | |
|            secsymidx:=0;
 | |
|            for sec:=low(tsection) to high(tsection) do
 | |
|             if assigned(sects[sec]) then
 | |
|              begin
 | |
|                inc(nsects);
 | |
|                inc(secsymidx);
 | |
|                sects[sec].secsymidx:=secsymidx;
 | |
|                inc(initsym,2); { 2 for each section }
 | |
|              end;
 | |
|          { For the stab section we need an HdrSym which can now be
 | |
|            calculated more easily }
 | |
|            if assigned(sects[sec_stab]) then
 | |
|             begin
 | |
|               hstab.strpos:=1;
 | |
|               hstab.ntype:=0;
 | |
|               hstab.nother:=0;
 | |
|               hstab.ndesc:=(sects[sec_stab].datasize div sizeof(coffstab))-1{+1 according to gas output PM};
 | |
|               hstab.nvalue:=sects[sec_stabstr].datasize;
 | |
|               sects[sec_stab].data.seek(0);
 | |
|               sects[sec_stab].data.write(hstab,sizeof(hstab));
 | |
|             end;
 | |
|          { Calculate the filepositions }
 | |
|            datapos:=sizeof(coffheader)+sizeof(coffsechdr)*nsects;
 | |
|            { sections first }
 | |
|            for sec:=low(tsection) to high(tsection) do
 | |
|             if assigned(sects[sec]) then
 | |
|              begin
 | |
|                sects[sec].datapos:=datapos;
 | |
|                if assigned(sects[sec].data) then
 | |
|                  inc(datapos,sects[sec].aligneddatasize);
 | |
|              end;
 | |
|            { relocs }
 | |
|            gotreloc:=false;
 | |
|            for sec:=low(tsection) to high(tsection) do
 | |
|             if assigned(sects[sec]) then
 | |
|              begin
 | |
|                tcoffsection(sects[sec]).relocpos:=datapos;
 | |
|                inc(datapos,10*sects[sec].nrelocs);
 | |
|                if (not gotreloc) and (sects[sec].nrelocs>0) then
 | |
|                 gotreloc:=true;
 | |
|              end;
 | |
|            { symbols }
 | |
|            sympos:=datapos;
 | |
|          { COFF header }
 | |
|            fillchar(header,sizeof(coffheader),0);
 | |
|            header.mach:=$14c;
 | |
|            header.nsects:=nsects;
 | |
|            header.sympos:=sympos;
 | |
|            header.syms:=(Syms.size div sizeof(TOutputSymbol))+initsym;
 | |
|            if gotreloc then
 | |
|             header.flag:=$104
 | |
|            else
 | |
|             header.flag:=$105;
 | |
|            writer.write(header,sizeof(header));
 | |
|          { Section headers }
 | |
|            for sec:=low(tsection) to high(tsection) do
 | |
|             if assigned(sects[sec]) then
 | |
|              begin
 | |
|                fillchar(sechdr,sizeof(sechdr),0);
 | |
|                move(target_asm.secnames[sec][1],sechdr.name,length(target_asm.secnames[sec]));
 | |
|                if not win32 then
 | |
|                  begin
 | |
|                    sechdr.rvaofs:=sects[sec].mempos;
 | |
|                    sechdr.vsize:=sects[sec].mempos;
 | |
|                  end
 | |
|                else
 | |
|                  begin
 | |
|                    if sec=sec_bss then
 | |
|                      sechdr.vsize:=sects[sec].aligneddatasize;
 | |
|                  end;
 | |
|                sechdr.datasize:=sects[sec].aligneddatasize;
 | |
|                if (sects[sec].datasize>0) and assigned(sects[sec].data) then
 | |
|                  sechdr.datapos:=sects[sec].datapos;
 | |
|                sechdr.nrelocs:=sects[sec].nrelocs;
 | |
|                sechdr.relocpos:=TCoffSection(sects[sec]).relocpos;
 | |
|                sechdr.flags:=TCoffSection(sects[sec]).flags;
 | |
|                writer.write(sechdr,sizeof(sechdr));
 | |
|              end;
 | |
|          { Sections }
 | |
|            for sec:=low(tsection) to high(tsection) do
 | |
|             if assigned(sects[sec]) and
 | |
|                assigned(sects[sec].data) then
 | |
|              begin
 | |
|                sects[sec].alignsection;
 | |
|                hp:=sects[sec].data.firstblock;
 | |
|                while assigned(hp) do
 | |
|                 begin
 | |
|                   writer.write(hp^.data,hp^.used);
 | |
|                   hp:=hp^.next;
 | |
|                 end;
 | |
|              end;
 | |
|          { Relocs }
 | |
|            for sec:=low(tsection) to high(tsection) do
 | |
|             if assigned(sects[sec]) then
 | |
|              write_relocs(sects[sec]);
 | |
|          { Symbols }
 | |
|            write_symbols;
 | |
|          { Strings }
 | |
|            i:=Strs.size+4;
 | |
|            writer.write(i,4);
 | |
|            hp:=Strs.firstblock;
 | |
|            while assigned(hp) do
 | |
|             begin
 | |
|               writer.write(hp^.data,hp^.used);
 | |
|               hp:=hp^.next;
 | |
|             end;
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| {****************************************************************************
 | |
|                                 TCoffInput
 | |
| ****************************************************************************}
 | |
| 
 | |
| 
 | |
| end.
 | |
| {
 | |
|   $Log$
 | |
|   Revision 1.8  2000-12-25 00:07:26  peter
 | |
|     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
 | |
|       tlinkedlist objects)
 | |
| 
 | |
|   Revision 1.7  2000/12/24 12:25:31  peter
 | |
|     + cstreams unit
 | |
|     * dynamicarray object to class
 | |
| 
 | |
|   Revision 1.6  2000/12/23 19:59:35  peter
 | |
|     * object to class for ow/og objects
 | |
|     * split objectdata from objectoutput
 | |
| 
 | |
|   Revision 1.5  2000/12/21 12:06:38  jonas
 | |
|     * changed type of all "flags" variables/parameters/fields to cardinal
 | |
|       and removed longint typecasts around constants
 | |
| 
 | |
|   Revision 1.4  2000/12/20 15:59:04  jonas
 | |
|     * fixed range check errors
 | |
| 
 | |
|   Revision 1.3  2000/12/18 21:56:35  peter
 | |
|     * fixed stab reloc writing
 | |
| 
 | |
|   Revision 1.2  2000/12/07 17:19:42  jonas
 | |
|     * new constant handling: from now on, hex constants >$7fffffff are
 | |
|       parsed as unsigned constants (otherwise, $80000000 got sign extended
 | |
|       and became $ffffffff80000000), all constants in the longint range
 | |
|       become longints, all constants >$7fffffff and <=cardinal($ffffffff)
 | |
|       are cardinals and the rest are int64's.
 | |
|     * added lots of longint typecast to prevent range check errors in the
 | |
|       compiler and rtl
 | |
|     * type casts of symbolic ordinal constants are now preserved
 | |
|     * fixed bug where the original resulttype wasn't restored correctly
 | |
|       after doing a 64bit rangecheck
 | |
| 
 | |
|   Revision 1.1  2000/11/12 22:20:37  peter
 | |
|     * create generic toutputsection for binary writers
 | |
| 
 | |
| }
 | 
