fpc/compiler/ogcoff.pas

{
    $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,
       { target }
       systems,
       { assembler }
       cpubase,aasm,assemble,
       { output }
       ogbase;

    type
       tcoffsection = class(tobjectsection)
       public
         flags    : cardinal;
         coffrelocs,
         coffrelocpos : longint;
         constructor createsec(sec:TSection;AAlign,AFlags:cardinal);
       end;

       tcoffdata = class(tobjectdata)
       private
         Fstrs,
         Fsyms  : Tdynamicarray;
         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:tasmsymbol;relative:relative_type);override;
         procedure writesymbol(p:tasmsymbol);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:tasmsymbol;nidx,nother,line:longint;reloc:boolean);override;
       end;

       tcoffobjectoutput = 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(const fn:string):boolean;override;
       end;

       ttasmsymbolarray = array[0..high(word)] of tasmsymbol;

       tcoffobjectinput = class(tobjectinput)
       private
         Fidx2sec  : array[0..255] of tsection;
         FCoffsyms : tdynamicarray;
         FSymTbl   : ^ttasmsymbolarray;
         win32     : boolean;
         procedure read_relocs(s:tcoffsection);
         procedure handle_symbols;
       public
         constructor createdjgpp(const fn:string);
         constructor createwin32(const fn:string);
         function  initreading:boolean;override;
         procedure donereading;override;
         procedure readfromdisk;override;
       end;

       tcoffassembler = class(tinternalassembler)
         constructor create(smart:boolean);override;
       end;

       tpecoffassembler = class(tinternalassembler)
         constructor create(smart:boolean);override;
       end;


implementation

    uses
{$ifdef delphi}
       sysutils,
{$else}
       strings,
{$endif}
       cutils,verbose,
       globtype,globals,fmodule;

    const
       symbolresize = 200*sizeof(toutputsymbol);
       coffsymbolresize = 200*18;
       strsresize   = 8192;
       DataResize   = 8192;

    const
       COFF_SYM_EXTERNAL = 2;
       COFF_SYM_STATIC   = 3;
       COFF_SYM_LABEL    = 6;
       COFF_SYM_FUNCTION = 101;
       COFF_SYM_FILE     = 103;
       COFF_SYM_SECTION  = 104;

    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
        FSyms.Free;
        FStrs.Free;
        inherited destroy;
      end;


    procedure tcoffdata.reset;
      var
        s : string;
      begin
        FSyms:=TDynamicArray.Create(symbolresize);
        FStrs:=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:=16;
            end;
          sec_data :
            begin
              if win32 then
               Flags:=$c0300040
              else
               Flags:=$40;
              Aalign:=16;
            end;
          sec_bss :
            begin
              if win32 then
               Flags:=$c0300080
              else
               Flags:=$80;
              Aalign:=16;
            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:tasmsymbol);
      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:=FStrs.size+4;
              FStrs.writestr(s);
              FStrs.writestr(#0);
            end
           else
            begin
              sym.nameidx:=-1;
              sym.namestr:=s;
            end;
           { update the asmsymbol index }
           p.idx:=FSyms.size div sizeof(TOutputSymbol);
           { write the symbol }
           FSyms.write(sym,sizeof(toutputsymbol));
         end
        else
         begin
           p.idx:=-2; { local }
         end;
      end;


    procedure tcoffdata.writereloc(data,len:longint;p:tasmsymbol;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:tasmsymbol;
                                                 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;


{****************************************************************************
                                tcoffobjectoutput
****************************************************************************}

    constructor tcoffobjectoutput.createdjgpp(smart:boolean);
      begin
        inherited create(smart);
        win32:=false;
      end;


    constructor tcoffobjectoutput.createwin32(smart:boolean);
      begin
        inherited create(smart);
        win32:=true;
      end;


    function tcoffobjectoutput.initwriting(const fn:string):boolean;
      begin
        result:=inherited initwriting(fn);
        if result then
         begin
           initsym:=0;
           if win32 then
            FData:=tcoffdata.createwin32
           else
            FData:=tcoffdata.createdjgpp;
         end;
      end;


    procedure tcoffobjectoutput.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;
           FWriter.write(rel,sizeof(rel));
           { goto next and dispose this reloc }
           hr:=r;
           r:=r^.next;
           dispose(hr);
         end;
      end;


    procedure tcoffobjectoutput.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;
        FWriter.write(sym,sizeof(sym));
      end;


    procedure tcoffobjectoutput.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^);
           FWriter.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;
               FWriter.write(secrec,sizeof(secrec));
             end;
           { The real symbols }
           FSyms.seek(0);
           for i:=1 to FSyms.size div sizeof(TOutputSymbol) do
            begin
              FSyms.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 tcoffobjectoutput.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]).coffrelocpos:=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:=(FSyms.size div sizeof(TOutputSymbol))+initsym;
           if gotreloc then
            header.flag:=$104
           else
            header.flag:=$105;
           FWriter.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]).coffrelocpos;
               sechdr.flags:=TCoffSection(sects[sec]).flags;
               FWriter.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
                  FWriter.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:=FStrs.size+4;
           FWriter.write(i,4);
           hp:=FStrs.firstblock;
           while assigned(hp) do
            begin
              FWriter.write(hp^.data,hp^.used);
              hp:=hp^.next;
            end;
         end;
      end;

{****************************************************************************
                                tcoffobjectinput
****************************************************************************}

    constructor tcoffobjectinput.createdjgpp(const fn:string);
      begin
        inherited create(fn);
        win32:=false;
      end;


    constructor tcoffobjectinput.createwin32(const fn:string);
      begin
        inherited create(fn);
        win32:=true;
      end;


    function tcoffobjectinput.initreading:boolean;
      begin
        result:=inherited initreading;
        if result then
         begin
           if win32 then
            FData:=tcoffdata.createwin32
           else
            FData:=tcoffdata.createdjgpp;
           FCoffSyms:=TDynamicArray.Create(symbolresize);
         end;
      end;


    procedure tcoffobjectinput.donereading;
      begin
        FCoffSyms.Free;
      end;


    procedure tcoffobjectinput.read_relocs(s:tcoffsection);
      var
        rel  : coffreloc;
        rel_type : relative_type;
        i        : longint;
        p        : tasmsymbol;
      begin
        for i:=1 to s.coffrelocs do
         begin
           FReader.read(rel,sizeof(rel));
           case rel.relative of
             $14 : rel_type:=relative_true;
             $06 : rel_type:=relative_false;
             $07 : rel_type:=relative_rva;
           else
             begin
               Comment(V_Error,'Error reading coff file');
               exit;
             end;
           end;

           p:=FSymTbl^[rel.sym];
           if assigned(p) then
            begin
              s.addsymreloc(rel.address,p,rel_type);
            end
           else
            begin
              Comment(V_Error,'Error reading coff file');
              exit;
            end;
         end;
      end;


    procedure tcoffobjectinput.handle_symbols;
      var
        sec       : tsection;
        i,nsyms,
        symidx    : longint;
        sym       : coffsymbol;
        strname   : string;
        p         : tasmsymbol;
        auxrec    : array[0..17] of byte;
      begin
        with tcoffdata(data) do
         begin
           nsyms:=FCoffSyms.Size div sizeof(CoffSymbol);
           { Allocate memory for symidx -> tasmsymbol table }
           GetMem(FSymTbl,nsyms*sizeof(pointer));
           FillChar(FSymTbl^,nsyms*sizeof(pointer),0);
           { Loop all symbols }
           FCoffSyms.Seek(0);
           symidx:=0;
           while (symidx<nsyms) do
            begin
              FCoffSyms.Read(sym,sizeof(sym));
              if plongint(@sym.name)^<>0 then
               begin
                 move(sym.name,strname[1],8);
                 strname[9]:=#0;
               end
              else
               begin
                 FStrs.Seek(sym.strpos-4);
                 FStrs.Read(strname[1],255);
                 strname[255]:=#0;
               end;
              strname[0]:=chr(strlen(@strname[1]));
              if strname='' then
               Internalerror(341324310);
              case sym.typ of
                COFF_SYM_EXTERNAL :
                  begin
                    if sym.section=0 then
                     begin
                       p:=tasmsymbol.create(strname,AB_EXTERNAL,AT_FUNCTION);
                     end
                    else
                     begin
                       p:=tasmsymbol.create(strname,AB_GLOBAL,AT_FUNCTION);
                       sec:=Fidx2sec[sym.section];
                       if assigned(sects[sec]) then
                        begin
                          p.section:=sec;
                          if sym.value>=sects[sec].mempos then
                           p.address:=sym.value-sects[sec].mempos
                          else
                           internalerror(432432432);
                        end
                       else
                        internalerror(34243214);
                     end;
                    AddSymbol(p);
                    FSymTbl^[symidx]:=p
                  end;
                COFF_SYM_STATIC :
                  begin
                    p:=tasmsymbol.create(strname,AB_LOCAL,AT_FUNCTION);
                    sec:=Fidx2sec[sym.section];
                    if assigned(sects[sec]) then
                     begin
                       p.section:=sec;
                       if sym.value>=sects[sec].mempos then
                        p.address:=sym.value-sects[sec].mempos
                       else
                        begin
                          if Str2Sec(strname)<>sec then
                           internalerror(432432432);
                        end;
                     end
                    else
                     internalerror(34243214);
                    AddSymbol(p);
                    FSymTbl^[symidx]:=p;
                  end;
                COFF_SYM_SECTION,
                COFF_SYM_LABEL,
                COFF_SYM_FUNCTION,
                COFF_SYM_FILE :
                  ;
                else
                  internalerror(4342343);
              end;
              { read aux records }
              for i:=1 to sym.aux do
               begin
                 FCoffSyms.Read(auxrec,sizeof(auxrec));
                 inc(symidx);
               end;
              inc(symidx);
            end;
         end;
      end;


    procedure tcoffobjectinput.readfromdisk;
      var
        strsize,
        i        : longint;
        sec      : tsection;
        header   : coffheader;
        sechdr   : coffsechdr;
      begin
        with tcoffdata(data) do
         begin
           FillChar(Fidx2sec,sizeof(Fidx2sec),0);
         { COFF header }
           if not reader.read(header,sizeof(coffheader)) then
            begin
              Comment(V_Error,'Error reading coff file');
              exit;
            end;
           if header.mach<>$14c then
            begin
              Comment(V_Error,'Not a coff file');
              exit;
            end;
           if header.nsects>255 then
            begin
              Comment(V_Error,'To many sections');
              exit;
            end;
{           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 }
         { Section headers }
           for i:=1 to header.nsects do
            begin
              if not reader.read(sechdr,sizeof(sechdr)) then
               begin
                 Comment(V_Error,'Error reading coff file');
                 exit;
               end;
              sec:=str2sec(strpas(sechdr.name));
              if sec<>sec_none then
               begin
                 Fidx2sec[i]:=sec;
                 createsection(sec);
                 if not win32 then
                  sects[sec].mempos:=sechdr.rvaofs;
                 tcoffsection(sects[sec]).coffrelocs:=sechdr.nrelocs;
                 tcoffsection(sects[sec]).coffrelocpos:=sechdr.relocpos;
                 sects[sec].datapos:=sechdr.datapos;
                 sects[sec].datasize:=sechdr.datasize;
                 tcoffsection(sects[sec]).flags:=sechdr.flags;
               end
              else
               Comment(V_Warning,'skipping unsupported section '+strpas(sechdr.name));
            end;
         { Symbols }
           Reader.Seek(header.sympos);
           if not Reader.ReadArray(FCoffSyms,header.syms*sizeof(CoffSymbol)) then
            begin
              Comment(V_Error,'Error reading coff file');
              exit;
            end;
         { Strings }
           if not Reader.Read(strsize,4) then
            begin
              Comment(V_Error,'Error reading coff file');
              exit;
            end;
           if strsize<4 then
            begin
              Comment(V_Error,'Error reading coff file');
              exit;
            end;
           if not Reader.ReadArray(FStrs,Strsize-4) then
            begin
              Comment(V_Error,'Error reading coff file');
              exit;
            end;
         { Insert all symbols }
           handle_symbols;
         { Sections }
           for sec:=low(tsection) to high(tsection) do
            if assigned(sects[sec]) and
               (sec<>sec_bss) then
             begin
               Reader.Seek(sects[sec].datapos);
               if not Reader.ReadArray(sects[sec].data,sects[sec].datasize) then
                begin
                  Comment(V_Error,'Error reading coff file');
                  exit;
                end;
             end;
         { Relocs }
           for sec:=low(tsection) to high(tsection) do
            if assigned(sects[sec]) and
               (tcoffsection(sects[sec]).coffrelocs>0) then
             begin
               Reader.Seek(tcoffsection(sects[sec]).coffrelocpos);
               read_relocs(tcoffsection(sects[sec]));
             end;
         end;
      end;


{****************************************************************************
                                 TCoffAssembler
****************************************************************************}

    constructor TCoffAssembler.Create(smart:boolean);
      begin
        inherited Create(smart);
        objectoutput:=tcoffobjectoutput.createdjgpp(smart);
      end;


{****************************************************************************
                               TPECoffAssembler
****************************************************************************}

    constructor TPECoffAssembler.Create(smart:boolean);
      begin
        inherited Create(smart);
        objectoutput:=tcoffobjectoutput.createwin32(smart);
      end;


{*****************************************************************************
                                  Initialize
*****************************************************************************}

    const
       as_i386_coff_info : tasminfo =
          (
            id     : as_i386_coff;
            idtxt  : 'COFF';
            asmbin : '';
            asmcmd : '';
            supported_target : target_i386_go32v2;
            outputbinary : true;
            allowdirect : false;
            externals : true;
            needar : false;
            labelprefix_only_inside_procedure: false;
            labelprefix : '.L';
            comment : '';
            secnames : ('',
              '.text','.data','.bss',
              '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
              '.stab','.stabstr')
          );

    const
       as_i386_pecoff_info : tasminfo =
          (
            id     : as_i386_pecoff;
            idtxt  : 'PECOFF';
            asmbin : '';
            asmcmd : '';
            supported_target : target_i386_win32;
            outputbinary : true;
            allowdirect : false;
            externals : true;
            needar : false;
            labelprefix_only_inside_procedure: false;
            labelprefix : '.L';
            comment : '';
            secnames : ('',
              '.text','.data','.bss',
              '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
              '.stab','.stabstr')
          );


initialization
  RegisterAssembler(as_i386_coff_info,TCoffAssembler);
  RegisterAssembler(as_i386_pecoff_info,TPECoffAssembler);
end.
{
  $Log$
  Revision 1.16  2001-09-17 21:29:12  peter
    * merged netbsd, fpu-overflow from fixes branch

  Revision 1.15  2001/05/06 17:13:23  jonas
    * completed incomplete typed constant records

  Revision 1.14  2001/05/04 19:50:58  peter
    * finally added the missing outputbinary field that was missing

  Revision 1.13  2001/04/18 22:01:54  peter
    * registration of targets and assemblers

  Revision 1.12  2001/04/13 01:22:10  peter
    * symtable change to classes
    * range check generation and errors fixed, make cycle DEBUG=1 works
    * memory leaks fixed

  Revision 1.11  2001/04/02 21:20:31  peter
    * resulttype rewrite

  Revision 1.10  2001/03/13 18:45:07  peter
    * fixed some memory leaks

  Revision 1.9  2001/03/05 21:40:38  peter
    * more things for tcoffobjectinput

  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

}