* create generic toutputsection for binary writers

compiler/ag386bin.pas

@@ -25,7 +25,6 @@ unit ag386bin;
 {$i defines.inc}
 
 {$define MULTIPASS}
-{$define EXTERNALBSS}
 
 interface
 
@@ -83,7 +82,8 @@ interface
 {$ifdef GDB}
        gdb,
 {$endif}
-       og386,og386dbg,og386cff,og386elf;
+       ogbase,
+       ogcoff,ogelf;
 
 {$ifdef GDB}
 
@@ -380,7 +380,6 @@ interface
                end;
              ait_datablock :
                begin
-{$ifdef EXTERNALBSS}
                  if not SmartAsm then
                   begin
                     if not pai_datablock(hp)^.is_global then
@@ -395,7 +394,6 @@ interface
                   end
                  else
                   begin
-{$endif}
                     l:=pai_datablock(hp)^.size;
                     if l>2 then
                       objectalloc^.sectionalign(4)
@@ -477,7 +475,6 @@ interface
                begin
                  if objectalloc^.currsec<>sec_bss then
                   Message(asmw_e_alloc_data_only_in_bss);
-{$ifdef EXTERNALBSS}
                  if not SmartAsm then
                   begin
                     if pai_datablock(hp)^.is_global then
@@ -500,7 +497,6 @@ interface
                      end;
                    end
                   else
-{$endif}
                    begin
                      l:=pai_datablock(hp)^.size;
                      if l>2 then
@@ -664,18 +660,14 @@ interface
              ait_datablock :
                begin
                  objectoutput^.writesymbol(pai_datablock(hp)^.sym);
-                 if SmartAsm
-{$ifdef EXTERNALBSS}
-                    or (not pai_datablock(hp)^.is_global)
-{$endif}
-                    then
+                 if SmartAsm or (not pai_datablock(hp)^.is_global) then
                    begin
                      l:=pai_datablock(hp)^.size;
                      if l>2 then
-                       objectoutput^.writealign(4)
+                       objectoutput^.allocalign(4)
                      else if l>1 then
-                       objectoutput^.writealign(2);
-                     objectoutput^.writealloc(pai_datablock(hp)^.size);
+                       objectoutput^.allocalign(2);
+                     objectoutput^.alloc(pai_datablock(hp)^.size);
                    end;
                end;
              ait_const_32bit :
@@ -852,10 +844,10 @@ interface
            objectalloc^.resetsections;
            objectalloc^.setsection(startsec);
            TreePass0(hp);
-{$endif}
            { leave if errors have occured }
            if errorcount>0 then
             exit;
+{$endif MULTIPASS}
 
          { Pass 1 }
            currpass:=1;
@@ -977,14 +969,14 @@ interface
         case t of
           og_none :
             Message(asmw_f_no_binary_writer_selected);
-          og_dbg :
-            objectoutput:=new(pdbgoutput,init(smart));
           og_coff :
-            objectoutput:=new(pdjgppcoffoutput,init(smart));
+            objectoutput:=new(pcoffoutput,initdjgpp(smart));
           og_pecoff :
-            objectoutput:=new(pwin32coffoutput,init(smart));
+            objectoutput:=new(pcoffoutput,initwin32(smart));
           og_elf :
             objectoutput:=new(pelf32output,init(smart));
+          else
+            internalerror(43243432);
         end;
         objectalloc:=new(pobjectalloc,init);
         SmartAsm:=smart;
@@ -1011,7 +1003,10 @@ interface
 end.
 {
   $Log$
-  Revision 1.8  2000-09-24 15:06:10  peter
+  Revision 1.9  2000-11-12 22:20:37  peter
+    * create generic toutputsection for binary writers
+
+  Revision 1.8  2000/09/24 15:06:10  peter
     * use defines.inc
 
   Revision 1.7  2000/08/27 16:11:49  peter

compiler/cobjects.pas

@@ -260,6 +260,7 @@ interface
          procedure align(i:longint);
          procedure seek(i:longint);
          procedure write(const d;len:longint);
+         procedure writestr(const s:string);
          function  read(var d;len:longint):longint;
          procedure blockwrite(var f:file);
        private
@@ -1631,6 +1632,12 @@ end;
       end;
 
 
+    procedure tdynamicarray.writestr(const s:string);
+      begin
+        write(s[1],length(s));
+      end;
+
+
     function tdynamicarray.read(var d;len:longint):longint;
       var
         p : pchar;
@@ -1846,7 +1853,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.18  2000-11-04 14:25:19  florian
+  Revision 1.19  2000-11-12 22:20:37  peter
+    * create generic toutputsection for binary writers
+
+  Revision 1.18  2000/11/04 14:25:19  florian
     + merged Attila's changes for interfaces, not tested yet
 
   Revision 1.17  2000/11/03 19:41:06  jonas
@@ -1903,4 +1913,4 @@ end.
   Revision 1.2  2000/07/13 11:32:38  michael
   + removed logs
 
-}
+}

compiler/globals.pas

@@ -1257,7 +1257,7 @@ implementation
         { must_be_valid:=true; obsolete PM }
         not_unit_proc:=true;
 
-        apptype:=at_cui;
+        apptype:=app_cui;
      end;
 
 begin
@@ -1270,7 +1270,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.18  2000-11-04 14:25:19  florian
+  Revision 1.19  2000-11-12 22:20:37  peter
+    * create generic toutputsection for binary writers
+
+  Revision 1.18  2000/11/04 14:25:19  florian
     + merged Attila's changes for interfaces, not tested yet
 
   Revision 1.17  2000/10/31 22:02:46  peter
@@ -1327,4 +1330,4 @@ end.
   Revision 1.2  2000/07/13 11:32:41  michael
   + removed logs
 
-}
+}

compiler/globtype.pas

@@ -139,8 +139,8 @@ interface
        tmodeswitches = set of tmodeswitch;
 
        { win32 sub system }
-       tapptype = (at_none,
-         at_gui,at_cui
+       tapptype = (app_none,
+         app_gui,app_cui
        );
 
        { interface types }
@@ -210,7 +210,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  2000-11-04 14:25:19  florian
+  Revision 1.9  2000-11-12 22:20:37  peter
+    * create generic toutputsection for binary writers
+
+  Revision 1.8  2000/11/04 14:25:19  florian
     + merged Attila's changes for interfaces, not tested yet
 
   Revision 1.7  2000/09/24 15:06:16  peter
@@ -232,4 +235,4 @@ end.
   Revision 1.2  2000/07/13 11:32:41  michael
   + removed logs
 
-}
+}

compiler/htypechk.pas

@@ -765,9 +765,9 @@ implementation
                              (hsym^.owner = aktprocsym^.definition^.localst)) then
                            begin
                              if tloadnode(p).symtable^.symtabletype=localsymtable then
-                              CGMessage1(sym_n_uninitialized_local_variable,hsym^.name)
+                              CGMessage1(sym_n_uninitialized_local_variable,hsym^.realname)
                              else
-                              CGMessage1(sym_n_uninitialized_variable,hsym^.name);
+                              CGMessage1(sym_n_uninitialized_variable,hsym^.realname);
                            end;
                         end;
                      end;
@@ -887,7 +887,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  2000-11-04 14:25:19  florian
+  Revision 1.15  2000-11-12 22:20:37  peter
+    * create generic toutputsection for binary writers
+
+  Revision 1.14  2000/11/04 14:25:19  florian
     + merged Attila's changes for interfaces, not tested yet
 
   Revision 1.13  2000/10/31 22:02:47  peter
@@ -931,4 +934,4 @@ end.
 
   Revision 1.2  2000/07/13 11:32:41  michael
   + removed logs
-}
+}

compiler/i386/cpuasm.pas

@@ -146,7 +146,8 @@ type
 implementation
 
 uses
-  cutils,og386;
+  cutils,
+  ogbase;
 
 {*****************************************************************************
                                  TaiRegAlloc
@@ -1669,7 +1670,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-10-15 10:50:46  florian
+  Revision 1.3  2000-11-12 22:20:37  peter
+    * create generic toutputsection for binary writers
+
+  Revision 1.2  2000/10/15 10:50:46  florian
    * fixed xmm register access
 
   Revision 1.1  2000/10/15 09:39:37  peter
@@ -1689,4 +1693,4 @@ end.
   Revision 1.2  2000/07/13 11:32:38  michael
   + removed logs
 
-}
+}

compiler/og386cff.pas

@@ -1,1068 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Peter Vreman and Pierre Muller
-
-    Contains the 386 binary coff 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 og386cff;
-
-{$i defines.inc}
-
-{
-  Notes on COFF:
-
-  (0) When I say `standard COFF' below, I mean `COFF as output and
-  used by DJGPP'. I assume DJGPP gets it right.
-
-  (1) Win32 appears to interpret the term `relative relocation'
-  differently from standard COFF. Standard COFF understands a
-  relative relocation to mean that during relocation you add the
-  address of the symbol you're referencing, and subtract the base
-  address of the section you're in. Win32 COFF, by contrast, seems
-  to add the address of the symbol and then subtract the address
-  of THE BYTE AFTER THE RELOCATED DWORD. Hence the two formats are
-  subtly incompatible.
-
-  (2) Win32 doesn't bother putting any flags in the header flags
-  field (at offset 0x12 into the file).
-
-  (3) Win32 uses some extra flags into the section header table:
-  it defines flags 0x80000000 (writable), 0x40000000 (readable)
-  and 0x20000000 (executable), and uses them in the expected
-  combinations. It also defines 0x00100000 through 0x00700000 for
-  section alignments of 1 through 64 bytes.
-
-  (4) Both standard COFF and Win32 COFF seem to use the DWORD
-  field directly after the section name in the section header
-  table for something strange: they store what the address of the
-  section start point _would_ be, if you laid all the sections end
-  to end starting at zero. Dunno why. Microsoft's documentation
-  lists this field as "Virtual Size of Section", which doesn't
-  seem to fit at all. In fact, Win32 even includes non-linked
-  sections such as .drectve in this calculation.
-
-  (5) Standard COFF does something very strange to common
-  variables: the relocation point for a common variable is as far
-  _before_ the variable as its size stretches out _after_ it. So
-  we must fix up common variable references. Win32 seems to be
-  sensible on this one.
-}
-
-interface
-
-    uses
-       cobjects,
-       systems,cpubase,aasm,og386;
-
-    type
-       preloc = ^treloc;
-       treloc = packed record
-          next     : preloc;
-          address  : longint;
-          symbol   : pasmsymbol;
-          section  : tsection; { only used if symbol=nil }
-          relative : relative_type;
-       end;
-
-       psymbol = ^tsymbol;
-       tsymbol = packed record
-         name    : string[8];
-         strpos  : longint;
-         section : tsection;
-         value   : longint;
-         typ     : TAsmsymbind;
-       end;
-
-       pcoffsection = ^tcoffsection;
-       tcoffsection = object
-          index  : tsection;
-          secsymidx : longint; { index for the section in symtab }
-          data   : PDynamicArray;
-          size,
-          fillsize,
-          mempos,
-          len,
-          datapos,
-          relocpos,
-          nrelocs,
-          align,
-          flags     : longint;
-          relochead : PReloc;
-          reloctail : ^PReloc;
-          constructor init(sec:TSection;Aflags:longint);
-          destructor  done;
-          procedure  write(var d;l:longint);
-          procedure  alloc(l:longint);
-          procedure  addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
-          procedure  addsectionreloc(ofs:longint;sec:tsection;relative:relative_type);
-       end;
-
-       pgenericcoffoutput = ^tgenericcoffoutput;
-       tgenericcoffoutput = object(tobjectoutput)
-         win32   : boolean;
-         sects   : array[TSection] of PCoffSection;
-         strs,
-         syms    : Pdynamicarray;
-         initsym : longint;
-         constructor init(smart:boolean);
-         destructor  done;virtual;
-         procedure initwriting(Aplace:tcutplace);virtual;
-         procedure donewriting;virtual;
-         function  sectionsize(s:tsection):longint;virtual;
-         procedure setsectionsizes(var s:tsecsize);virtual;
-         procedure writebytes(var data;len:longint);virtual;
-         procedure writealloc(len:longint);virtual;
-         procedure writealign(len:longint);virtual;
-         procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);virtual;
-         procedure writesymbol(p:pasmsymbol);virtual;
-         procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;
-         procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
-           nidx,nother,line:longint;reloc:boolean);virtual;
-         function  text_flags : longint;virtual;
-         function  data_flags : longint;virtual;
-         function  bss_flags : longint;virtual;
-         function  idata_flags : longint;virtual;
-         function  edata_flags : longint;virtual;
-       private
-         procedure createsection(sec:tsection);
-         procedure write_relocs(s:pcoffsection);
-         procedure write_symbol(const name:string;strpos,value,section,typ,aux:longint);
-         procedure write_symbols;
-         procedure writetodisk;
-       end;
-
-       pdjgppcoffoutput = ^tdjgppcoffoutput;
-       tdjgppcoffoutput = object(tgenericcoffoutput)
-         constructor init(smart:boolean);
-         function text_flags : longint;virtual;
-         function data_flags : longint;virtual;
-         function bss_flags : longint;virtual;
-       end;
-
-       pwin32coffoutput = ^twin32coffoutput;
-       twin32coffoutput = object(tgenericcoffoutput)
-         constructor init(smart:boolean);
-         function text_flags : longint;virtual;
-         function data_flags : longint;virtual;
-         function bss_flags : longint;virtual;
-         function idata_flags : longint;virtual;
-         function edata_flags : longint;virtual;
-       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;
-          datalen  : longint;
-          datapos  : longint;
-          relocpos : longint;
-          lineno1  : longint;
-          nrelocs  : word;
-          lineno2  : word;
-          flags    : longint;
-        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;
-
-
-{****************************************************************************
-                               TSection
-****************************************************************************}
-
-    constructor tcoffsection.init(sec:TSection;Aflags:longint);
-      begin
-        index:=sec;
-        secsymidx:=0;
-        flags:=AFlags;
-        { alignment after section }
-        case sec of
-          sec_code,
-          sec_data,
-          sec_bss :
-            align:=4;
-          else
-            align:=1;
-        end;
-        { filled after pass 1 }
-        size:=0;
-        fillsize:=0;
-        mempos:=0;
-        { pass 2 data }
-        relocHead:=nil;
-        relocTail:=@relocHead;
-        Len:=0;
-        NRelocs:=0;
-        if sec=sec_bss then
-         data:=nil
-        else
-         new(Data,Init(DataResize));
-      end;
-
-
-    destructor tcoffsection.done;
-      begin
-        if assigned(Data) then
-          dispose(Data,done);
-      end;
-
-
-    procedure  tcoffsection.write(var d;l:longint);
-      begin
-        if not assigned(Data) then
-         Internalerror(3334441);
-        Data^.write(d,l);
-        inc(len,l);
-      end;
-
-
-    procedure  tcoffsection.alloc(l:longint);
-      begin
-        if assigned(Data) then
-         Internalerror(3334442);
-        inc(len,l);
-      end;
-
-
-    procedure tcoffsection.addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
-      var
-        r : PReloc;
-      begin
-        new(r);
-        reloctail^:=r;
-        reloctail:=@r^.next;
-        r^.next:=nil;
-        r^.address:=ofs+mempos;
-        r^.symbol:=p;
-        r^.section:=sec_none;
-        r^.relative:=relative;
-        inc(nrelocs);
-      end;
-
-
-    procedure tcoffsection.addsectionreloc(ofs:longint;sec:tsection;relative:relative_type);
-      var
-        r : PReloc;
-      begin
-        new(r);
-        reloctail^:=r;
-        reloctail:=@r^.next;
-        r^.next:=nil;
-        r^.address:=ofs+mempos;
-        r^.symbol:=nil;
-        r^.section:=sec;
-        r^.relative:=relative;
-        inc(nrelocs);
-      end;
-
-
-{****************************************************************************
-                            Genericcoffoutput
-****************************************************************************}
-
-    constructor tgenericcoffoutput.init(smart:boolean);
-      begin
-        inherited init(smart);
-      end;
-
-
-    destructor tgenericcoffoutput.done;
-      begin
-        inherited done;
-      end;
-
-
-    procedure tgenericcoffoutput.initwriting(Aplace:tcutplace);
-      var
-        s : string;
-      begin
-        inherited initwriting(Aplace);
-        { reset }
-        initsym:=0;
-        new(syms,init(symbolresize));
-        new(strs,init(strsresize));
-        FillChar(Sects,sizeof(Sects),0);
-        { 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 tgenericcoffoutput.donewriting;
-      var
-        sec : tsection;
-      begin
-        { Only write the .o if there are no errors }
-        if errorcount=0 then
-          writetodisk;
-        dispose(syms,done);
-        dispose(strs,done);
-        for sec:=low(tsection) to high(tsection) do
-         if assigned(sects[sec]) then
-          dispose(sects[sec],done);
-        inherited donewriting;
-      end;
-
-
-    function tgenericcoffoutput.sectionsize(s:tsection):longint;
-      begin
-        if assigned(sects[s]) then
-         sectionsize:=sects[s]^.len
-        else
-         sectionsize:=0;
-      end;
-
-
-    function tgenericcoffoutput.text_flags : longint;
-      begin
-        text_flags:=0;
-      end;
-
-    function tgenericcoffoutput.data_flags : longint;
-      begin
-        data_flags:=0;
-      end;
-
-    function tgenericcoffoutput.bss_flags : longint;
-      begin
-        bss_flags:=0;
-      end;
-
-    function tgenericcoffoutput.edata_flags : longint;
-      begin
-        edata_flags:=0;
-      end;
-
-    function tgenericcoffoutput.idata_flags : longint;
-      begin
-        idata_flags:=0;
-      end;
-
-
-    procedure tgenericcoffoutput.createsection(sec:TSection);
-      var
-        Aflags : longint;
-      begin
-        Aflags:=0;
-        case sec of
-          sec_code :
-            Aflags:=text_flags;
-          sec_data :
-            Aflags:=data_flags;
-          sec_bss :
-            Aflags:=bss_flags;
-          sec_idata2,
-          sec_idata4,
-          sec_idata5,
-          sec_idata6,
-          sec_idata7 :
-            Aflags:=idata_flags;
-          sec_edata :
-            Aflags:=edata_flags;
-          else
-            Aflags:=0;
-        end;
-        sects[sec]:=new(PcoffSection,init(Sec,Aflags));
-      end;
-
-
-    procedure tgenericcoffoutput.writesymbol(p:pasmsymbol);
-      var
-        pos : longint;
-        sym : tsymbol;
-        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);
-        { symbolname }
-        pos:=strs^.size+4;
-        s:=p^.name;
-        if length(s)>8 then
-         begin
-           if length(s)<255 then
-             s:=s+#0;
-           strs^.write(s[1],length(s));
-           { if the length is 255 we need to addd the terminal #0
-             separately bug report from Florian 20/6/2000 }
-           if length(s)=255 then
-             begin
-               s:=#0;
-               strs^.write(s[1],length(s));
-             end;
-         end
-        else
-         pos:=-1;
-        FillChar(sym,sizeof(sym),0);
-        sym.strpos:=pos;
-        if pos=-1 then
-         sym.name:=s;
-        sym.value:=p^.size;
-        sym.typ:=p^.bind;
-        { coff doesn't have common, replace with external }
-        if sym.typ=AB_COMMON then
-          sym.typ:=AB_EXTERNAL;
-        { if local of global then set the section value to the address
-          of the symbol }
-        if sym.typ in [AB_LOCAL,AB_GLOBAL] then
-         begin
-           sym.section:=p^.section;
-           sym.value:=p^.address+sects[p^.section]^.mempos;
-         end;
-        { update the asmsymbol index }
-        p^.idx:=syms^.size div sizeof(TSymbol);
-        { store the symbol, but not the local ones (PM) }
-        if (sym.typ<>AB_LOCAL) or ((copy(s,1,2)<>'.L') and
-          ((copy(s,1,1)<>'L') or not win32)) then
-          syms^.write(sym,sizeof(tsymbol));
-        { make the exported syms known to the objectwriter
-          (needed for .a generation) }
-        if (sym.typ=AB_GLOBAL) or
-           ((sym.typ=AB_EXTERNAL) and (sym.value=p^.size) and (sym.value>0)) then
-          writer^.writesym(p^.name);
-      end;
-
-
-    procedure tgenericcoffoutput.writebytes(var data;len:longint);
-      begin
-        if not assigned(sects[currsec]) then
-         createsection(currsec);
-        sects[currsec]^.write(data,len);
-      end;
-
-
-    procedure tgenericcoffoutput.writealloc(len:longint);
-      begin
-        if not assigned(sects[currsec]) then
-         createsection(currsec);
-        sects[currsec]^.alloc(len);
-      end;
-
-
-    procedure tgenericcoffoutput.writealign(len:longint);
-      var
-        modulo : longint;
-      begin
-        if not assigned(sects[currsec]) then
-         createsection(currsec);
-        modulo:=sects[currsec]^.len mod len;
-        if modulo > 0 then
-          sects[currsec]^.alloc(len-modulo);
-      end;
-
-
-    procedure tgenericcoffoutput.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
-      var
-        symaddr : longint;
-      begin
-        if not assigned(sects[currsec]) then
-         createsection(currsec);
-        if assigned(p) then
-         begin
-           { 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(sects[currsec]^.len,currsec,relative_false);
-                     inc(data,symaddr);
-                   end;
-                 relative_true :
-                   begin
-                     inc(data,symaddr-len-sects[currsec]^.len);
-                   end;
-                 relative_rva :
-                   begin
-                     { don't know if this can happens !! }
-                     { does this work ?? }
-                     sects[currsec]^.addsectionreloc(sects[currsec]^.len,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(sects[currsec]^.len,p^.section,relative)
-               else
-                 sects[currsec]^.addsymreloc(sects[currsec]^.len,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]^.len);
-                end;
-            end;
-         end;
-        sects[currsec]^.write(data,len);
-      end;
-
-
-    procedure tgenericcoffoutput.writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc : boolean);
-      var
-        stab : coffstab;
-        s : tsection;
-      begin
-        { This is wrong because
-          sec_none is used only for external bss
-        if section=sec_none then
-         s:=currsec
-        else }
-         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]^.len;
-            end;
-           if (s<>sec_none) then
-            inc(offset,sects[s]^.mempos);
-         end;
-        if assigned(p) and (p[0]<>#0) then
-         begin
-           stab.strpos:=sects[sec_stabstr]^.len;
-           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
-          if DLLSource and RelocSection then
-          { avoid relocation in the .stab section
-            because it ends up in the .reloc section instead }
-            sects[sec_stab]^.addsectionreloc(sects[sec_stab]^.len-4,s,relative_rva)
-          else
-            sects[sec_stab]^.addsectionreloc(sects[sec_stab]^.len-4,s,relative_false);
-      end;
-
-
-    procedure tgenericcoffoutput.writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
-                                                 nidx,nother,line:longint;reloc:boolean);
-      var
-        stab : coffstab;
-        s : tsection;
-      begin
-        { This is wrong because
-          sec_none is used only for external bss
-        if section=sec_none then
-         s:=currsec
-        else }
-         s:=section;
-        { 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 s=sec_none then
-               offset:=0
-              else
-               offset:=sects[s]^.len;
-            end;
-           if (s<>sec_none) then
-            inc(offset,sects[s]^.mempos);
-         end;
-        if assigned(p) and (p[0]<>#0) then
-         begin
-           stab.strpos:=sects[sec_stabstr]^.len;
-           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
-          if DLLSource and RelocSection then
-          { avoid relocation in the .stab section
-            because it ends up in the .reloc section instead }
-            sects[sec_stab]^.addsymreloc(sects[sec_stab]^.len-4,ps,relative_rva)
-          else
-            sects[sec_stab]^.addsymreloc(sects[sec_stab]^.len-4,ps,relative_false);
-      end;
-
-
-    procedure tgenericcoffoutput.setsectionsizes(var s:tsecsize);
-      var
-        align,
-        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;
-        { fix all section }
-        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]^.size:=s[sec];
-              sects[sec]^.mempos:=mempos;
-              { calculate the alignment }
-              align:=sects[sec]^.align;
-              sects[sec]^.fillsize:=align-(sects[sec]^.size and (align-1));
-              if sects[sec]^.fillsize=align then
-               sects[sec]^.fillsize:=0;
-              { next section position, not for win32 which uses
-                relative addresses }
-              if not win32 then
-                inc(mempos,sects[sec]^.size+sects[sec]^.fillsize);
-            end;
-         end;
-      end;
-
-
-{***********************************************
-             Writing to disk
-***********************************************}
-
-    procedure tgenericcoffoutput.write_relocs(s:pcoffsection);
-      var
-        rel  : coffreloc;
-        hr,r : preloc;
-      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*sects[r^.symbol^.section]^.secsymidx
-              else
-               begin
-                 if r^.symbol^.idx=-1 then
-                   internalerror(4321);
-                 rel.sym:=r^.symbol^.idx+initsym;
-               end;
-            end
-           else if r^.section<>sec_none then
-            rel.sym:=2*sects[r^.section]^.secsymidx
-           else
-            rel.sym:=0;
-           case r^.relative 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 tgenericcoffoutput.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 tgenericcoffoutput.write_symbols;
-      var
-        filename : string[18];
-        sec : tsection;
-        sectionval,
-        i   : longint;
-        globalval : byte;
-        secrec : coffsectionrec;
-        sym : tsymbol;
-      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]^.len;
-            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(TSymbol) do
-         begin
-           syms^.read(sym,sizeof(TSymbol));
-           if sym.typ=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.name,sym.strpos,sym.value,sectionval,globalval,0);
-         end;
-      end;
-
-
-    procedure tgenericcoffoutput.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
-      { calc amount of sections we have and align sections at 4 bytes }
-        fillchar(empty,sizeof(empty),0);
-        nsects:=0;
-        for sec:=low(tsection) to high(tsection) do
-         if assigned(sects[sec]) then
-          begin
-{$ifdef EXTDEBUG}
-          { check if the section is still the same size }
-            if (sects[sec]^.len<>sects[sec]^.size) then
-              Comment(V_Warning,'Size of section changed '+
-                tostr(sects[sec]^.size)+'->'+tostr(sects[sec]^.len)+
-                ' ['+target_asm.secnames[sec]+']');
-{$endif EXTDEBUG}
-          { fill with zero }
-            if sects[sec]^.fillsize>0 then
-             begin
-               if assigned(sects[sec]^.data) then
-                 sects[sec]^.write(empty,sects[sec]^.fillsize)
-               else
-                 sects[sec]^.alloc(sects[sec]^.fillsize);
-             end;
-            inc(nsects);
-          end;
-      { Calculate the filepositions }
-        datapos:=sizeof(coffheader)+sizeof(coffsechdr)*nsects;
-        initsym:=2; { 2 for the file }
-        { sections first }
-        secsymidx:=0;
-        for sec:=low(tsection) to high(tsection) do
-         if assigned(sects[sec]) then
-          begin
-            inc(secsymidx);
-            sects[sec]^.secsymidx:=secsymidx;
-            sects[sec]^.datapos:=datapos;
-            if assigned(sects[sec]^.data) then
-              inc(datapos,sects[sec]^.len);
-            inc(initsym,2); { 2 for each section }
-          end;
-        { relocs }
-        gotreloc:=false;
-        for sec:=low(tsection) to high(tsection) do
-         if assigned(sects[sec]) then
-          begin
-            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(TSymbol))+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]^.len;
-              end;
-            sechdr.datalen:=sects[sec]^.len;
-            if (sects[sec]^.len>0) and assigned(sects[sec]^.data) then
-              sechdr.datapos:=sects[sec]^.datapos;
-            sechdr.relocpos:=sects[sec]^.relocpos;
-            sechdr.nrelocs:=sects[sec]^.nrelocs;
-            sechdr.flags:=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
-            { For the stab section we need an HdrSym which can now be
-              calculated more easily }
-            if sec=sec_stab then
-             begin
-               hstab.strpos:=1;
-               hstab.ntype:=0;
-               hstab.nother:=0;
-               hstab.ndesc:=(sects[sec_stab]^.len div sizeof(coffstab))-1{+1 according to gas output PM};
-               hstab.nvalue:=sects[sec_stabstr]^.len;
-               sects[sec_stab]^.data^.seek(0);
-               sects[sec_stab]^.data^.write(hstab,sizeof(hstab));
-             end;
-            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;
-
-
-{****************************************************************************
-                            DJGppcoffoutput
-****************************************************************************}
-
-    constructor tdjgppcoffoutput.init(smart:boolean);
-      begin
-        inherited init(smart);
-        win32:=false;
-      end;
-
-    function tdjgppcoffoutput.text_flags : longint;
-      begin
-        text_flags:=$20;
-      end;
-
-    function tdjgppcoffoutput.data_flags : longint;
-      begin
-        data_flags:=$40;
-      end;
-
-    function tdjgppcoffoutput.bss_flags : longint;
-      begin
-        bss_flags:=$80;
-      end;
-
-
-{****************************************************************************
-                            Win32coffoutput
-****************************************************************************}
-
-    constructor twin32coffoutput.init(smart:boolean);
-      begin
-        inherited init(smart);
-        win32:=true;
-      end;
-
-    function twin32coffoutput.text_flags : longint;
-      begin
-        text_flags:=$60000020; { same as as 2.9.1 }
-      end;
-
-    function twin32coffoutput.data_flags : longint;
-      begin
-        data_flags:=$c0300040;
-      end;
-
-    function twin32coffoutput.bss_flags : longint;
-      begin
-        bss_flags:=$c0300080;
-      end;
-
-    function twin32coffoutput.edata_flags : longint;
-      begin
-        edata_flags:=$c0300040;
-      end;
-
-    function twin32coffoutput.idata_flags : longint;
-      begin
-        idata_flags:=$40000000;
-      end;
-
-
-end.
-{
-  $Log$
-  Revision 1.8  2000-10-21 14:36:26  peter
-    * merged pierres fixes
-
-  Revision 1.7  2000/09/24 15:06:19  peter
-    * use defines.inc
-
-  Revision 1.6  2000/09/19 23:09:07  pierre
-   * problems wih extdebug cond. solved
-
-  Revision 1.5  2000/08/27 16:11:51  peter
-    * moved some util functions from globals,cobjects to cutils
-    * splitted files into finput,fmodule
-
-  Revision 1.4  2000/08/19 18:44:27  peter
-    * new tdynamicarray implementation using blocks instead of
-      reallocmem (merged)
-
-  Revision 1.3  2000/07/13 12:08:26  michael
-  + patched to 1.1.0 with former 1.09patch from peter
-
-  Revision 1.2  2000/07/13 11:32:43  michael
-  + removed logs
-
-}

compiler/og386dbg.pas

@@ -1,196 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Peter Vreman
-
-    Contains the 386 binary writer for debugging purposes
-
-    * 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 og386dbg;
-
-{$i defines.inc}
-
-interface
-
-    uses
-       systems,aasm,cpubase,og386;
-
-    type
-       pdbgoutput = ^tdbgoutput;
-       tdbgoutput = object(tobjectoutput)
-         nsyms   : longint;
-         rawidx  : longint;
-         constructor init(smart:boolean);
-         destructor  done;virtual;
-         procedure initwriting(Aplace:tcutplace);virtual;
-         procedure donewriting;virtual;
-         procedure writebytes(var data;len:longint);virtual;
-         procedure writealloc(len:longint);virtual;
-         procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);virtual;
-         procedure writesymbol(p:pasmsymbol);virtual;
-         procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;
-       end;
-
-
-implementation
-
-{****************************************************************************
-                                Tdbgoutput
-****************************************************************************}
-
-    constructor tdbgoutput.init(smart:boolean);
-      begin
-        inherited init(smart);
-        rawidx:=-1;
-        nsyms:=0;
-      end;
-
-
-    destructor tdbgoutput.done;
-      begin
-      end;
-
-
-    procedure tdbgoutput.initwriting(Aplace:tcutplace);
-      begin
-        inherited initwriting(Aplace);
-        writeln('initwriting '+Objfile);
-      end;
-
-
-    procedure tdbgoutput.donewriting;
-      begin
-        if rawidx<>-1 then
-         begin
-           writeln;
-           rawidx:=-1;
-         end;
-        writeln('donewriting');
-      end;
-
-
-    procedure tdbgoutput.writesymbol(p:pasmsymbol);
-      begin
-        if rawidx<>-1 then
-         begin
-           writeln;
-           rawidx:=-1;
-         end;
-        p^.idx:=nsyms;
-        write('symbol [',nsyms,'] '+p^.name+' (',target_asm.secnames[p^.section],',',p^.address,',',p^.size,',');
-        case p^.bind of
-          AB_LOCAL :
-            writeln('local)');
-          AB_GLOBAL :
-            writeln('global)');
-          AB_EXTERNAL :
-            writeln('extern)');
-        else
-          writeln('unknown)');
-        end;
-        inc(nsyms);
-      end;
-
-
-    procedure tdbgoutput.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
-      begin
-        if rawidx<>-1 then
-         begin
-           writeln;
-           rawidx:=-1;
-         end;
-        if assigned(p) then
-          write('reloc: ',data,' [',target_asm.secnames[p^.section],',',p^.address,']')
-        else
-          write('reloc: ',data);
-        case relative of
-          relative_true : writeln(' relative');
-          relative_false: writeln(' not relative');
-          relative_rva  : writeln(' relative virtual address');
-        end;
-      end;
-
-
-    procedure tdbgoutput.writebytes(var data;len:longint);
-
-        function hexstr(val : longint;cnt : byte) : string;
-        const
-          HexTbl : array[0..15] of char='0123456789ABCDEF';
-        var
-          i : longint;
-        begin
-          hexstr[0]:=char(cnt);
-          for i:=cnt downto 1 do
-           begin
-             hexstr[i]:=hextbl[val and $f];
-             val:=val shr 4;
-           end;
-        end;
-
-      var
-        p : pchar;
-        i : longint;
-      begin
-        if len=0 then
-         exit;
-        p:=@data;
-        if rawidx=-1 then
-         begin
-           write('raw: ');
-           rawidx:=0;
-         end;
-        for i:=1to len do
-         begin
-           if rawidx>=16 then
-            begin
-              writeln;
-              write('raw: ');
-              rawidx:=0;
-            end;
-           write(hexstr(ord(p[i-1]),2),' ');
-           inc(rawidx);
-         end;
-      end;
-
-    procedure tdbgoutput.writealloc(len:longint);
-      begin
-        writeln('alloc: ',len);
-      end;
-
-    procedure tdbgoutput.writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);
-      begin
-        writeln('stabs: ',line,',',nidx,'"',p,'"');
-      end;
-
-
-end.
-{
-  $Log$
-  Revision 1.4  2000-09-24 15:06:20  peter
-    * use defines.inc
-
-  Revision 1.3  2000/07/13 12:08:26  michael
-  + patched to 1.1.0 with former 1.09patch from peter
-
-  Revision 1.2  2000/07/13 11:32:43  michael
-  + removed logs
-
-}

compiler/og386.pas → compiler/ogbase.pas

@@ -2,11 +2,7 @@
     $Id$
     Copyright (c) 1998-2000 by Peter Vreman
 
-    Contains the base stuff for 386 binary object file writers
-
-    * This code was inspired by the NASM sources
-      The Netwide Assembler is copyright (C) 1996 Simon Tatham and
-      Julian Hall. All rights reserved.
+    Contains the base stuff for binary object file writers
 
     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
@@ -24,7 +20,7 @@
 
  ****************************************************************************
 }
-unit og386;
+unit ogbase;
 
 {$i defines.inc}
 
@@ -38,14 +34,68 @@ interface
        strings,
        dos,
 {$endif Delphi}
+       { common }
+       cobjects,
+       { targets }
+       systems,
+       { outputwriters }
        owbase,owar,
-       systems,cpubase,aasm;
+       { assembler }
+       cpubase,aasm;
 
     type
        tsecsize = array[tsection] of longint;
 
        relative_type = (relative_false,relative_true,relative_rva);
 
+       poutputreloc = ^toutputreloc;
+       toutputreloc = packed record
+          next     : poutputreloc;
+          address  : longint;
+          symbol   : pasmsymbol;
+          section  : tsection; { only used if symbol=nil }
+          typ      : relative_type;
+       end;
+
+       poutputsymbol = ^toutputsymbol;
+       toutputsymbol = packed record
+         namestr : string[8]; { namestr or nameidx is used }
+         nameidx : longint;
+         section : tsection;
+         value   : longint;
+         bind    : TAsmsymbind;
+         typ     : TAsmsymtype;
+         size    : longint;
+       end;
+
+       poutputsection = ^toutputsection;
+       toutputsection = object
+          name      : string[32];
+          secsymidx : longint; { index for the section in symtab }
+          addralign : longint;
+          { size of the data and in the file }
+          data      : PDynamicArray;
+          datasize   : longint;
+          datapos   : longint;
+          { size and position in memory, set by setsectionsize }
+          memsize,
+          mempos    : longint;
+          { relocation }
+          nrelocs   : longint;
+          relochead : POutputReloc;
+          reloctail : ^POutputReloc;
+          constructor init(const Aname:string;Aalign:longint;alloconly:boolean);
+          destructor  done;
+          function  write(var d;l:longint):longint;
+          function  writestr(const s:string):longint;
+          procedure writealign(l:longint);
+          function  aligneddatasize:longint;
+          procedure alignsection;
+          procedure alloc(l:longint);
+          procedure addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
+          procedure addsectionreloc(ofs:longint;sec:tsection;relative:relative_type);
+       end;
+
        pobjectalloc = ^tobjectalloc;
        tobjectalloc = object
          currsec : tsection;
@@ -62,31 +112,35 @@ interface
 
        pobjectoutput = ^tobjectoutput;
        tobjectoutput = object
-         SmartFilesCount,
-         SmartHeaderCount : longint;
-         objsmart  : boolean;
          writer    : pobjectwriter;
          path      : pathstr;
          ObjFile   : string;
+         { smartlinking }
+         objsmart  : boolean;
          place     : tcutplace;
+         SmartFilesCount,
+         SmartHeaderCount : longint;
+         { section }
          currsec   : tsection;
+         sects     : array[TSection] of POutputSection;
          constructor init(smart:boolean);
          destructor  done;virtual;
          { Writing }
          procedure NextSmartName;
          procedure initwriting(Aplace:tcutplace);virtual;
          procedure donewriting;virtual;
+         procedure createsection(sec:tsection);virtual;
+         procedure defaultsection(sec:tsection);
          function  sectionsize(s:tsection):longint;virtual;
          procedure setsectionsizes(var s:tsecsize);virtual;
+         procedure alloc(len:longint);virtual;
+         procedure allocalign(len:longint);virtual;
          procedure writebytes(var data;len:longint);virtual;
-         procedure writealloc(len:longint);virtual;
-         procedure writealign(len:longint);virtual;
          procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);virtual;
          procedure writesymbol(p:pasmsymbol);virtual;
          procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;
          procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
            nidx,nother,line:longint;reloc:boolean);virtual;
-         procedure defaultsection(sec:tsection);
        end;
 
     var
@@ -101,7 +155,7 @@ interface
 
 
 {****************************************************************************
-                                tobjectoutput
+                                tobjectalloc
 ****************************************************************************}
 
     constructor tobjectalloc.init;
@@ -153,6 +207,131 @@ interface
       end;
 
 
+{****************************************************************************
+                              TSectionOutput
+****************************************************************************}
+
+    constructor toutputsection.init(const Aname:string;Aalign:longint;alloconly:boolean);
+      begin
+        name:=Aname;
+        secsymidx:=0;
+        addralign:=Aalign;
+        { data }
+        datasize:=0;
+        datapos:=0;
+        if alloconly then
+         data:=nil
+        else
+         new(Data,Init(8192));
+        { position }
+        mempos:=0;
+        memsize:=0;
+        { relocation }
+        NRelocs:=0;
+        relocHead:=nil;
+        relocTail:=@relocHead;
+      end;
+
+
+    destructor toutputsection.done;
+      begin
+        if assigned(Data) then
+          dispose(Data,done);
+      end;
+
+
+    function toutputsection.write(var d;l:longint):longint;
+      begin
+        write:=datasize;
+        if not assigned(Data) then
+         Internalerror(3334441);
+        Data^.write(d,l);
+        inc(datasize,l);
+      end;
+
+
+    function toutputsection.writestr(const s:string):longint;
+      begin
+        writestr:=datasize;
+        if not assigned(Data) then
+         Internalerror(3334441);
+        Data^.write(s[1],length(s));
+        inc(datasize,length(s));
+      end;
+
+
+    procedure toutputsection.writealign(l:longint);
+      var
+        i : longint;
+        empty : array[0..63] of char;
+      begin
+        { no alignment needed for 0 or 1 }
+        if l<=1 then
+         exit;
+        i:=datasize mod l;
+        if i>0 then
+         begin
+           if assigned(data) then
+            begin
+              fillchar(empty,sizeof(empty),0);
+              data^.write(empty,l-i);
+            end;
+           inc(datasize,l-i);
+         end;
+      end;
+
+
+    function toutputsection.aligneddatasize:longint;
+      begin
+        aligneddatasize:=align(datasize,addralign);
+      end;
+
+
+    procedure toutputsection.alignsection;
+      begin
+        writealign(addralign);
+      end;
+
+
+    procedure toutputsection.alloc(l:longint);
+      begin
+        if assigned(Data) then
+         Internalerror(3334442);
+        inc(datasize,l);
+      end;
+
+
+    procedure toutputsection.addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
+      var
+        r : POutputReloc;
+      begin
+        new(r);
+        reloctail^:=r;
+        reloctail:=@r^.next;
+        r^.next:=nil;
+        r^.address:=ofs;
+        r^.symbol:=p;
+        r^.section:=sec_none;
+        r^.typ:=relative;
+        inc(nrelocs);
+      end;
+
+
+    procedure toutputsection.addsectionreloc(ofs:longint;sec:tsection;relative:relative_type);
+      var
+        r : POutputReloc;
+      begin
+        new(r);
+        reloctail^:=r;
+        reloctail:=@r^.next;
+        r^.next:=nil;
+        r^.address:=ofs;
+        r^.symbol:=nil;
+        r^.section:=sec;
+        r^.typ:=relative;
+        inc(nrelocs);
+      end;
+
 
 {****************************************************************************
                                 tobjectoutput
@@ -179,8 +358,7 @@ interface
          path:=current_module^.path^;
       { init writer }
         if objsmart and
-           not(cs_asm_leave in aktglobalswitches) then
-          writer:=New(parobjectwriter,Init(current_module^.staticlibfilename^))
+           not(cs_asm_leave in aktglobalswitches) then          writer:=New(parobjectwriter,Init(current_module^.staticlibfilename^))
         else
           writer:=New(pobjectwriter,Init);
       end;
@@ -221,63 +399,99 @@ interface
     procedure tobjectoutput.initwriting(Aplace:tcutplace);
       begin
         place:=Aplace;
+        { open the writer }
         if objsmart then
          NextSmartName;
         writer^.create(objfile);
+        { reset }
+        FillChar(Sects,sizeof(Sects),0);
       end;
 
 
     procedure tobjectoutput.donewriting;
+      var
+        sec : tsection;
       begin
+        { free memory }
+        for sec:=low(tsection) to high(tsection) do
+         if assigned(sects[sec]) then
+          dispose(sects[sec],done);
+        { close the writer }
         writer^.close;
       end;
 
+
+    procedure tobjectoutput.createsection(sec:tsection);
+      begin
+        sects[sec]:=new(poutputsection,init(target_asm.secnames[sec],1,(sec=sec_bss)));
+      end;
+
+
     function tobjectoutput.sectionsize(s:tsection):longint;
       begin
         sectionsize:=0;
       end;
 
+
     procedure tobjectoutput.setsectionsizes(var s:tsecsize);
       begin
       end;
 
+
     procedure tobjectoutput.defaultsection(sec:tsection);
       begin
         currsec:=sec;
       end;
 
-    procedure tobjectoutput.writesymbol(p:pasmsymbol);
+
+    procedure tobjectoutput.writebytes(var data;len:longint);
       begin
-        Do_halt(211);
+        if not assigned(sects[currsec]) then
+         createsection(currsec);
+        sects[currsec]^.write(data,len);
       end;
 
-    procedure tobjectoutput.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
+
+    procedure tobjectoutput.alloc(len:longint);
       begin
-        Do_halt(211);
+        if not assigned(sects[currsec]) then
+         createsection(currsec);
+        sects[currsec]^.alloc(len);
       end;
 
-    procedure tobjectoutput.writebytes(var data;len:longint);
+
+    procedure tobjectoutput.allocalign(len:longint);
+      var
+        modulo : longint;
       begin
-        Do_halt(211);
+        if not assigned(sects[currsec]) then
+         createsection(currsec);
+        modulo:=sects[currsec]^.datasize mod len;
+        if modulo > 0 then
+          sects[currsec]^.alloc(len-modulo);
       end;
 
-    procedure tobjectoutput.writealloc(len:longint);
+
+    procedure tobjectoutput.writesymbol(p:pasmsymbol);
       begin
         Do_halt(211);
       end;
 
-    procedure tobjectoutput.writealign(len:longint);
+
+    procedure tobjectoutput.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
       begin
         Do_halt(211);
       end;
 
+
    procedure tobjectoutput.writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);
       begin
         Do_halt(211);
       end;
 
+
    procedure tobjectoutput.writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
-     nidx,nother,line:longint;reloc:boolean);
+                                         nidx,nother,line:longint;reloc:boolean);
       begin
         Do_halt(211);
       end;
@@ -285,23 +499,7 @@ interface
 end.
 {
   $Log$
-  Revision 1.7  2000-10-01 19:48:25  peter
-    * lot of compile updates for cg11
+  Revision 1.1  2000-11-12 22:20:37  peter
+    * create generic toutputsection for binary writers
 
-  Revision 1.6  2000/09/24 15:06:19  peter
-    * use defines.inc
-
-  Revision 1.5  2000/08/27 16:11:51  peter
-    * moved some util functions from globals,cobjects to cutils
-    * splitted files into finput,fmodule
-
-  Revision 1.4  2000/08/06 10:42:29  peter
-    * merged patches name generation in lib and asm constant eval
-
-  Revision 1.3  2000/07/13 12:08:26  michael
-  + patched to 1.1.0 with former 1.09patch from peter
-
-  Revision 1.2  2000/07/13 11:32:43  michael
-  + removed logs
-
-}
+}

compiler/ogcoff.pas

@@ -0,0 +1,753 @@
+{
+    $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 }
+       cobjects,
+       { target }
+       systems,
+       { assembler }
+       cpubase,aasm,
+       { output }
+       ogbase;
+
+    type
+       pcoffsection = ^tcoffsection;
+       tcoffsection = object(toutputsection)
+          flags    : longint;
+          relocpos : longint;
+          constructor initsec(sec:TSection;AAlign,AFlags:longint);
+       end;
+
+       pcoffoutput = ^tcoffoutput;
+       tcoffoutput = object(tobjectoutput)
+         win32   : boolean;
+         strs,
+         syms    : Pdynamicarray;
+         initsym : longint;
+         constructor initdjgpp(smart:boolean);
+         constructor initwin32(smart:boolean);
+         destructor  done;virtual;
+         procedure initwriting(Aplace:tcutplace);virtual;
+         procedure donewriting;virtual;
+         procedure setsectionsizes(var s:tsecsize);virtual;
+         procedure createsection(sec:tsection);virtual;
+         procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);virtual;
+         procedure writesymbol(p:pasmsymbol);virtual;
+         procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;
+         procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
+                                 nidx,nother,line:longint;reloc:boolean);virtual;
+       private
+         procedure write_relocs(s:poutputsection);
+         procedure write_symbol(const name:string;strpos,value,section,typ,aux:longint);
+         procedure write_symbols;
+         procedure writetodisk;
+       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    : longint;
+       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.initsec(sec:TSection;AAlign,AFlags:longint);
+      begin
+        inherited init(target_asm.secnames[sec],AAlign,(sec=sec_bss));
+        Flags:=AFlags;
+      end;
+
+
+{****************************************************************************
+                                TCoffOutput
+****************************************************************************}
+
+    constructor tcoffoutput.initdjgpp(smart:boolean);
+      begin
+        inherited init(smart);
+        win32:=false;
+      end;
+
+
+    constructor tcoffoutput.initwin32(smart:boolean);
+      begin
+        inherited init(smart);
+        win32:=true;
+      end;
+
+
+    destructor tcoffoutput.done;
+      begin
+        inherited done;
+      end;
+
+
+    procedure tcoffoutput.initwriting(Aplace:tcutplace);
+      var
+        s : string;
+      begin
+        inherited initwriting(Aplace);
+        { reset }
+        initsym:=0;
+        new(syms,init(symbolresize));
+        new(strs,init(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 tcoffoutput.donewriting;
+      begin
+        { Only write the .o if there are no errors }
+        if errorcount=0 then
+          writetodisk;
+        dispose(syms,done);
+        dispose(strs,done);
+        inherited donewriting;
+      end;
+
+
+    procedure tcoffoutput.createsection(sec:TSection);
+      var
+        Flags,
+        AAlign : longint;
+      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]:=new(PcoffSection,InitSec(Sec,AAlign,Flags));
+      end;
+
+
+    procedure tcoffoutput.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;
+        { make the exported syms known to the objectwriter
+          (needed for .a generation) }
+        if (sym.bind in [AB_GLOBAL,AB_COMMON]) then
+          writer^.writesym(p^.name);
+      end;
+
+
+    procedure tcoffoutput.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 tcoffoutput.writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc : boolean);
+      var
+        stab : coffstab;
+        s : tsection;
+      begin
+        { This is wrong because
+          sec_none is used only for external bss
+        if section=sec_none then
+         s:=currsec
+        else }
+         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
+          if DLLSource and RelocSection then
+          { avoid relocation in the .stab section
+            because it ends up in the .reloc section instead }
+            sects[sec_stab]^.addsectionreloc(sects[sec_stab]^.datasize-4,s,relative_rva)
+          else
+            sects[sec_stab]^.addsectionreloc(sects[sec_stab]^.datasize-4,s,relative_false);
+      end;
+
+
+    procedure tcoffoutput.writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
+                                                 nidx,nother,line:longint;reloc:boolean);
+      var
+        stab : coffstab;
+      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
+           if DLLSource and RelocSection then
+            { avoid relocation in the .stab section
+              because it ends up in the .reloc section instead }
+            sects[sec_stab]^.addsymreloc(sects[sec_stab]^.datasize-4,ps,relative_rva)
+           else
+            sects[sec_stab]^.addsymreloc(sects[sec_stab]^.datasize-4,ps,relative_false);
+         end;
+      end;
+
+
+    procedure tcoffoutput.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;
+
+
+{***********************************************
+             Writing to disk
+***********************************************}
+
+    procedure tcoffoutput.write_relocs(s:poutputsection);
+      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*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*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;
+        value,
+        sectionval,
+        i         : longint;
+        globalval : byte;
+        secrec    : coffsectionrec;
+        sym       : toutputsymbol;
+      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;
+
+
+    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
+      { 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
+            PCoffSection(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:=PCoffSection(sects[sec])^.relocpos;
+            sechdr.flags:=PCoffSection(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.
+{
+  $Log$
+  Revision 1.1  2000-11-12 22:20:37  peter
+    * create generic toutputsection for binary writers
+
+}

compiler/og386elf.pas → compiler/ogelf.pas

@@ -24,76 +24,41 @@
 
  ****************************************************************************
 }
-unit og386elf;
+unit ogelf;
 
 {$i defines.inc}
 
 interface
 
     uses
+       { common }
        cobjects,
-       systems,cpubase,aasm,og386;
+       { target }
+       systems,
+       { assembler }
+       cpubase,aasm,
+       { output }
+       ogbase;
 
     type
-       preloc = ^treloc;
-       treloc = packed record
-          next     : preloc;
-          address  : longint;
-          symbol   : pasmsymbol;
-          section  : tsection; { only used if symbol=nil }
-          typ      : relative_type;
-       end;
-
-       psymbol = ^tsymbol;
-       tsymbol = packed record
-         name    : longint;
-         section : tsection;
-         value   : longint;
-         bind    : TAsmsymbind;
-         typ     : TAsmsymtype;
-         size    : longint;
-       end;
-
        pelf32section = ^telf32section;
-       telf32section = object
-          name      : string[16];
-          secshidx,
-          secsymidx : longint; { index for the section in symtab }
+       telf32section = object(toutputsection)
+          secshidx  : longint; { index for the section in symtab }
           shstridx,
           shtype,
           shflags,
           shlink,
           shinfo,
-          addralign,
           entsize   : longint;
-          { size of the data and in the file }
-          data  : PDynamicArray;
-          datalen,
-          datapos   : longint;
-          { settings after setsectionsize }
-          size      : longint;
-          fillsize  : longint;
           { relocation }
-          nrelocs   : longint;
-          relochead : PReloc;
-          reloctail : ^PReloc;
           relocsect : PElf32Section;
-          constructor init(sec:TSection);
+          constructor initsec(sec:TSection);
           constructor initname(const Aname:string;Atype,Aflags,Alink,Ainfo,Aalign,Aentsize:longint);
           destructor  done;
-          function  write(var d;l:longint):longint;
-          function  writestr(const s:string):longint;
-          procedure writealign(l:longint);
-          function  aligneddatalen:longint;
-          procedure alignsection;
-          procedure alloc(l:longint);
-          procedure addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
-          procedure addsectionreloc(ofs:longint;sec:tsection;relative:relative_type);
        end;
 
        pelf32output = ^telf32output;
        telf32output = object(tobjectoutput)
-         sects   : array[TSection] of pelf32Section;
          symtabsect,
          strtabsect,
          shstrtabsect,
@@ -103,24 +68,20 @@ interface
          pltsect,
          symsect  : pelf32Section;
          strs,
-         syms    : Pdynamicarray;
-         initsym : longint;
+         syms     : Pdynamicarray;
+         initsym  : longint;
          constructor init(smart:boolean);
          destructor  done;virtual;
          procedure initwriting(Aplace:tcutplace);virtual;
          procedure donewriting;virtual;
-         function  sectionsize(s:tsection):longint;virtual;
+         procedure createsection(sec:tsection);virtual;
          procedure setsectionsizes(var s:tsecsize);virtual;
-         procedure writebytes(var data;len:longint);virtual;
-         procedure writealloc(len:longint);virtual;
-         procedure writealign(len:longint);virtual;
          procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);virtual;
          procedure writesymbol(p:pasmsymbol);virtual;
          procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;
          procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
-           nidx,nother,line:longint;reloc:boolean);virtual;
+                                 nidx,nother,line:longint;reloc:boolean);virtual;
        private
-         procedure createsection(sec:tsection);
          procedure createrelocsection(s:pelf32section);
          procedure createshstrtab;
          procedure createsymtab;
@@ -246,7 +207,7 @@ interface
                                TSection
 ****************************************************************************}
 
-    constructor telf32section.init(sec:TSection);
+    constructor telf32section.initsec(sec:TSection);
       var
         Aflags,Atype,Aalign,Aentsize : longint;
       begin
@@ -291,133 +252,23 @@ interface
 
     constructor telf32section.initname(const Aname:string;Atype,Aflags,Alink,Ainfo,Aalign,Aentsize:longint);
       begin
-        name:=Aname;
+        inherited init(Aname,Aalign,(AType=SHT_NOBITS));
         secshidx:=0;
-        secsymidx:=0;
         shstridx:=0;
         shtype:=AType;
         shflags:=AFlags;
         shlink:=Alink;
         shinfo:=Ainfo;
-        addralign:=Aalign;
         entsize:=Aentsize;
-        { setsectionsize data }
-        fillsize:=0;
-        size:=0;
-        { data }
-        dataLen:=0;
-        dataPos:=0;
-        if shtype=SHT_NOBITS then
-         data:=nil
-        else
-         new(Data,Init(8192));
-        { relocation }
-        NRelocs:=0;
-        relocHead:=nil;
-        relocTail:=@relocHead;
         relocsect:=nil;
       end;
 
 
     destructor telf32section.done;
       begin
-        if assigned(Data) then
-          dispose(Data,done);
         if assigned(relocsect) then
           dispose(relocsect,done);
-      end;
-
-
-    function telf32section.write(var d;l:longint):longint;
-      begin
-        write:=datalen;
-        if not assigned(Data) then
-         Internalerror(3334441);
-        Data^.write(d,l);
-        inc(datalen,l);
-      end;
-
-
-    function telf32section.writestr(const s:string):longint;
-      begin
-        writestr:=datalen;
-        if not assigned(Data) then
-         Internalerror(3334441);
-        Data^.write(s[1],length(s));
-        inc(datalen,length(s));
-      end;
-
-
-    procedure telf32section.writealign(l:longint);
-      var
-        i : longint;
-        empty : array[0..63] of char;
-      begin
-        { no alignment needed for 0 or 1 }
-        if l<=1 then
-         exit;
-        i:=datalen mod l;
-        if i>0 then
-         begin
-           if assigned(data) then
-            begin
-              fillchar(empty,sizeof(empty),0);
-              data^.write(empty,l-i);
-            end;
-           inc(datalen,l-i);
-         end;
-      end;
-
-
-    function telf32section.aligneddatalen:longint;
-      begin
-        aligneddatalen:=align(datalen,addralign);
-      end;
-
-
-    procedure telf32section.alignsection;
-      begin
-        writealign(addralign);
-      end;
-
-
-    procedure telf32section.alloc(l:longint);
-      begin
-        if assigned(Data) then
-         Internalerror(3334442);
-        inc(datalen,l);
-      end;
-
-
-    procedure telf32section.addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
-      var
-        r : PReloc;
-      begin
-        new(r);
-        reloctail^:=r;
-        reloctail:=@r^.next;
-        r^.next:=nil;
-        r^.address:=ofs;
-        r^.symbol:=p;
-        r^.section:=sec_none;
-        r^.typ:=relative;
-        inc(nrelocs);
-      end;
-
-
-    procedure telf32section.addsectionreloc(ofs:longint;sec:tsection;relative:relative_type);
-      var
-        r : PReloc;
-      begin
-        new(r);
-        reloctail^:=r;
-        reloctail:=@r^.next;
-        r^.next:=nil;
-        r^.address:=ofs;
-        r^.symbol:=nil;
-        r^.section:=sec;
-        r^.typ:=relative;
-        inc(nrelocs);
+        inherited done;
       end;
 
 
@@ -445,7 +296,6 @@ interface
         { reset }
         initsym:=0;
         new(syms,init(symbolresize));
-        FillChar(Sects,sizeof(Sects),0);
         { default sections }
         new(symtabsect,initname('.symtab',2,0,0,0,4,16));
         new(strtabsect,initname('.strtab',3,0,0,0,1,0));
@@ -471,8 +321,6 @@ interface
 
 
     procedure telf32output.donewriting;
-      var
-        sec : tsection;
       begin
         writetodisk;
         { free memory }
@@ -480,31 +328,19 @@ interface
         dispose(symtabsect,done);
         dispose(strtabsect,done);
         dispose(shstrtabsect,done);
-        for sec:=low(tsection) to high(tsection) do
-         if assigned(sects[sec]) then
-          dispose(sects[sec],done);
         inherited donewriting;
       end;
 
 
-    function telf32output.sectionsize(s:tsection):longint;
-      begin
-        if assigned(sects[s]) then
-         sectionsize:=sects[s]^.datalen
-        else
-         sectionsize:=0;
-      end;
-
-
     procedure telf32output.createsection(sec:tsection);
       begin
-        sects[sec]:=new(pelf32Section,init(Sec));
+        sects[sec]:=new(pelf32Section,initsec(Sec))
       end;
 
 
     procedure telf32output.writesymbol(p:pasmsymbol);
       var
-        sym : tsymbol;
+        sym : toutputsymbol;
       begin
         { already written ? }
         if p^.idx<>-1 then
@@ -530,16 +366,21 @@ interface
               sym.value:=$10;
             end;
         end;
-        { update the asmsymbol index }
-        p^.idx:=syms^.size div sizeof(tsymbol);
-        { store the symbol, but not the local ones (PM) }
+        { store the symbol, but not the local ones }
         if (sym.bind<>AB_LOCAL) then
          begin
            { symbolname, write the #0 separate to overcome 255+1 char not possible }
-           sym.name:=strtabsect^.writestr(p^.name);
+           sym.nameidx:=strtabsect^.datasize;
+           strtabsect^.writestr(p^.name);
            strtabsect^.writestr(#0);
+           { update the asmsymbol index }
+           p^.idx:=syms^.size div sizeof(toutputsymbol);
            { symbol }
-           syms^.write(sym,sizeof(tsymbol));
+           syms^.write(sym,sizeof(toutputsymbol));
+         end
+        else
+         begin
+           p^.idx:=-2; { local }
          end;
         { make the exported syms known to the objectwriter
           (needed for .a generation) }
@@ -548,34 +389,6 @@ interface
       end;
 
 
-    procedure telf32output.writebytes(var data;len:longint);
-      begin
-        if not assigned(sects[currsec]) then
-         createsection(currsec);
-        sects[currsec]^.write(data,len);
-      end;
-
-
-    procedure telf32output.writealloc(len:longint);
-      begin
-        if not assigned(sects[currsec]) then
-         createsection(currsec);
-        sects[currsec]^.alloc(len);
-      end;
-
-
-    procedure telf32output.writealign(len:longint);
-      var
-        modulo : longint;
-      begin
-        if not assigned(sects[currsec]) then
-         createsection(currsec);
-        modulo:=sects[currsec]^.datalen mod len;
-        if modulo > 0 then
-          sects[currsec]^.alloc(len-modulo);
-      end;
-
-
     procedure telf32output.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
       var
         symaddr : longint;
@@ -592,12 +405,12 @@ interface
                case relative of
                  relative_false :
                    begin
-                     sects[currsec]^.addsectionreloc(sects[currsec]^.datalen,currsec,relative_false);
+                     sects[currsec]^.addsectionreloc(sects[currsec]^.datasize,currsec,relative_false);
                      inc(data,symaddr);
                    end;
                  relative_true :
                    begin
-                     inc(data,symaddr-len-sects[currsec]^.datalen);
+                     inc(data,symaddr-len-sects[currsec]^.datasize);
                    end;
                  relative_rva :
                    internalerror(3219583);
@@ -608,17 +421,17 @@ interface
                writesymbol(p);
                if (p^.section<>sec_none) and (relative<>relative_true) then
                 begin
-                  sects[currsec]^.addsectionreloc(sects[currsec]^.datalen,p^.section,relative);
+                  sects[currsec]^.addsectionreloc(sects[currsec]^.datasize,p^.section,relative);
                   inc(data,symaddr);
                 end
                else
-                sects[currsec]^.addsymreloc(sects[currsec]^.datalen,p,relative);
+                sects[currsec]^.addsymreloc(sects[currsec]^.datasize,p,relative);
                if relative=relative_true then
                 begin
                   if p^.bind=AB_EXTERNAL then
                    dec(data,len)
                   else
-                   dec(data,len+sects[currsec]^.datalen);
+                   dec(data,len+sects[currsec]^.datasize);
                 end;
             end;
          end;
@@ -639,13 +452,13 @@ interface
               if s=sec_none then
                offset:=0
               else
-               offset:=sects[s]^.datalen;
+               offset:=sects[s]^.datasize;
             end;
          end;
         fillchar(stab,sizeof(telf32stab),0);
         if assigned(p) and (p[0]<>#0) then
          begin
-           stab.strpos:=sects[sec_stabstr]^.datalen;
+           stab.strpos:=sects[sec_stabstr]^.datasize;
            sects[sec_stabstr]^.write(p^,strlen(p)+1);
          end;
         stab.ntype:=nidx;
@@ -656,7 +469,7 @@ interface
         { when the offset is not 0 then write a relocation, take also the
           hdrstab into account with the offset }
         if reloc then
-         sects[sec_stab]^.addsectionreloc(sects[sec_stab]^.datalen-4,s,relative_false);
+         sects[sec_stab]^.addsectionreloc(sects[sec_stab]^.datasize-4,s,relative_false);
       end;
 
 
@@ -664,23 +477,21 @@ interface
                                                  nidx,nother,line:longint;reloc:boolean);
       var
         stab : telf32stab;
-        s : tsection;
       begin
-        s:=section;
         if reloc then
          begin
            if (offset=-1) then
             begin
-              if s=sec_none then
+              if section=sec_none then
                offset:=0
               else
-               offset:=sects[s]^.datalen;
+               offset:=sects[section]^.datasize;
             end;
          end;
         fillchar(stab,sizeof(telf32stab),0);
         if assigned(p) and (p[0]<>#0) then
          begin
-           stab.strpos:=sects[sec_stabstr]^.datalen;
+           stab.strpos:=sects[sec_stabstr]^.datasize;
            sects[sec_stabstr]^.write(p^,strlen(p)+1);
          end;
         stab.ntype:=nidx;
@@ -691,38 +502,12 @@ interface
         { when the offset is not 0 then write a relocation, take also the
           hdrstab into account with the offset }
         if reloc then
-         sects[sec_stab]^.addsymreloc(sects[sec_stab]^.datalen-4,ps,relative_false);
+         sects[sec_stab]^.addsymreloc(sects[sec_stab]^.datasize-4,ps,relative_false);
       end;
 
 
     procedure telf32output.setsectionsizes(var s:tsecsize);
-      var
-        align : longint;
-        sec : tsection;
       begin
-        { multiply stab with real size }
-        s[sec_stab]:=s[sec_stab]*sizeof(telf32stab);
-        { if debug then also count header stab }
-        if (cs_debuginfo in aktmoduleswitches) then
-         begin
-           inc(s[sec_stab],sizeof(telf32stab));
-           inc(s[sec_stabstr],length(SplitFileName(current_module^.mainsource^))+2);
-         end;
-        { fix all section }
-        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]^.size:=s[sec];
-              { calculate the alignment }
-              align:=sects[sec]^.addralign;
-              sects[sec]^.fillsize:=align-(sects[sec]^.size and (align-1));
-              if sects[sec]^.fillsize=align then
-               sects[sec]^.fillsize:=0;
-            end;
-         end;
       end;
 
 
@@ -733,7 +518,7 @@ interface
     procedure telf32output.createrelocsection(s:pelf32section);
       var
         rel  : telf32reloc;
-        hr,r : preloc;
+        hr,r : poutputreloc;
         relsym,reltyp : longint;
       begin
         { create the reloc section }
@@ -779,7 +564,7 @@ interface
     procedure telf32output.createsymtab;
       var
         elfsym : telf32symbol;
-        sym : tsymbol;
+        sym : toutputsymbol;
         sec : tsection;
         locals,
         i : longint;
@@ -798,19 +583,19 @@ interface
          if assigned(sects[sec]) then
           begin
             fillchar(elfsym,sizeof(elfsym),0);
-            elfsym.st_name:=sects[sec]^.shstridx;
+            elfsym.st_name:=pelf32section(sects[sec])^.shstridx;
             elfsym.st_info:=STT_SECTION;
-            elfsym.st_shndx:=sects[sec]^.secshidx;
+            elfsym.st_shndx:=pelf32section(sects[sec])^.secshidx;
             symtabsect^.write(elfsym,sizeof(elfsym));
             inc(locals);
           end;
       { symbols }
         syms^.seek(0);
-        for i:=1 to (syms^.size div sizeof(TSymbol)) do
+        for i:=1 to (syms^.size div sizeof(toutputsymbol)) do
          begin
-           syms^.read(sym,sizeof(TSymbol));
+           syms^.read(sym,sizeof(toutputsymbol));
            fillchar(elfsym,sizeof(elfsym),0);
-           elfsym.st_name:=sym.name;
+           elfsym.st_name:=sym.nameidx;
            elfsym.st_value:=sym.value;
            elfsym.st_size:=sym.size;
            case sym.bind of
@@ -837,7 +622,7 @@ interface
             elfsym.st_shndx:=SHN_COMMON
            else
             if assigned(sects[sym.section]) then
-             elfsym.st_shndx:=sects[sym.section]^.secshidx
+             elfsym.st_shndx:=pelf32section(sects[sym.section])^.secshidx
             else
              elfsym.st_shndx:=SHN_UNDEF;
            symtabsect^.write(elfsym,sizeof(elfsym));
@@ -861,9 +646,9 @@ interface
            for sec:=low(tsection) to high(tsection) do
             if assigned(sects[sec]) then
              begin
-               sects[sec]^.shstridx:=writestr(sects[sec]^.name+#0);
-               if assigned(sects[sec]^.relocsect) then
-                sects[sec]^.relocsect^.shstridx:=writestr(sects[sec]^.relocsect^.name+#0);
+               pelf32section(sects[sec])^.shstridx:=writestr(sects[sec]^.name+#0);
+               if assigned(pelf32section(sects[sec])^.relocsect) then
+                pelf32section(sects[sec])^.relocsect^.shstridx:=writestr(pelf32section(sects[sec])^.relocsect^.name+#0);
              end;
          end;
       end;
@@ -878,7 +663,7 @@ interface
         sechdr.sh_type:=s^.shtype;
         sechdr.sh_flags:=s^.shflags;
         sechdr.sh_offset:=s^.datapos;
-        sechdr.sh_size:=s^.datalen;
+        sechdr.sh_size:=s^.datasize;
         sechdr.sh_link:=s^.shlink;
         sechdr.sh_info:=s^.shinfo;
         sechdr.sh_addralign:=s^.addralign;
@@ -898,7 +683,7 @@ interface
         empty  : array[0..63] of byte;
         hp     : pdynamicblock;
       begin
-      { calc amount of sections we have and align sections at 4 bytes }
+      { calc amount of sections we have }
         fillchar(empty,sizeof(empty),0);
         nsects:=1;
         initsym:=2;
@@ -909,7 +694,7 @@ interface
             sects[sec]^.secsymidx:=initsym;
             inc(initsym);
             { also create the index in the section header table }
-            sects[sec]^.secshidx:=nsects;
+            pelf32section(sects[sec])^.secshidx:=nsects;
             inc(nsects);
             if assigned(sects[sec]^.relochead) then
              inc(nsects);
@@ -925,7 +710,7 @@ interface
         for sec:=low(tsection) to high(tsection) do
          if assigned(sects[sec]) and
             (sects[sec]^.nrelocs>0) then
-           createrelocsection(sects[sec]);
+           createrelocsection(pelf32section(sects[sec]));
       { create .symtab }
         createsymtab;
       { create .shstrtab }
@@ -938,27 +723,27 @@ interface
           begin
             sects[sec]^.datapos:=datapos;
             if assigned(sects[sec]^.data) then
-              inc(datapos,sects[sec]^.aligneddatalen);
+              inc(datapos,sects[sec]^.aligneddatasize);
           end;
         { shstrtab }
         shstrtabsect^.datapos:=datapos;
-        inc(datapos,shstrtabsect^.aligneddatalen);
+        inc(datapos,shstrtabsect^.aligneddatasize);
         { section headers }
         shoffset:=datapos;
         inc(datapos,nsects*sizeof(telf32sechdr));
         { symtab }
         symtabsect^.datapos:=datapos;
-        inc(datapos,symtabsect^.aligneddatalen);
+        inc(datapos,symtabsect^.aligneddatasize);
         { strtab }
         strtabsect^.datapos:=datapos;
-        inc(datapos,align(strtabsect^.datalen,4));
+        inc(datapos,align(strtabsect^.datasize,4));
         { .rel sections }
         for sec:=low(tsection) to high(tsection) do
          if assigned(sects[sec]) and
-            assigned(sects[sec]^.relocsect) then
+            assigned(pelf32section(sects[sec])^.relocsect) then
           begin
-            sects[sec]^.relocsect^.datapos:=datapos;
-            inc(datapos,sects[sec]^.relocsect^.aligneddatalen);
+            pelf32section(sects[sec])^.relocsect^.datapos:=datapos;
+            inc(datapos,pelf32section(sects[sec])^.relocsect^.aligneddatasize);
           end;
       { Write ELF Header }
         fillchar(header,sizeof(header),0);
@@ -988,8 +773,8 @@ interface
                hstab.strpos:=1;
                hstab.ntype:=0;
                hstab.nother:=0;
-               hstab.ndesc:=(sects[sec_stab]^.datalen div sizeof(telf32stab))-1{+1 according to gas output PM};
-               hstab.nvalue:=sects[sec_stabstr]^.datalen;
+               hstab.ndesc:=(sects[sec_stab]^.datasize div sizeof(telf32stab))-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;
@@ -1014,9 +799,9 @@ interface
         for sec:=low(tsection) to high(tsection) do
          if assigned(sects[sec]) then
           begin
-            writesectionheader(sects[sec]);
-            if assigned(sects[sec]^.relocsect) then
-             writesectionheader(sects[sec]^.relocsect);
+            writesectionheader(pelf32section(sects[sec]));
+            if assigned(pelf32section(sects[sec])^.relocsect) then
+             writesectionheader(pelf32section(sects[sec])^.relocsect);
           end;
         writesectionheader(shstrtabsect);
         writesectionheader(symtabsect);
@@ -1040,10 +825,10 @@ interface
       { .rel sections }
         for sec:=low(tsection) to high(tsection) do
          if assigned(sects[sec]) and
-            assigned(sects[sec]^.relocsect) then
+            assigned(pelf32section(sects[sec])^.relocsect) then
           begin
-            sects[sec]^.relocsect^.alignsection;
-            hp:=sects[sec]^.relocsect^.data^.firstblock;
+            pelf32section(sects[sec])^.relocsect^.alignsection;
+            hp:=pelf32section(sects[sec])^.relocsect^.data^.firstblock;
             while assigned(hp) do
              begin
                writer^.write(hp^.data,hp^.used);
@@ -1056,28 +841,7 @@ interface
 end.
 {
   $Log$
-  Revision 1.8  2000-10-14 21:52:55  peter
-    * fixed memory leaks
-
-  Revision 1.7  2000/09/24 15:06:20  peter
-    * use defines.inc
-
-  Revision 1.6  2000/08/27 16:11:51  peter
-    * moved some util functions from globals,cobjects to cutils
-    * splitted files into finput,fmodule
-
-  Revision 1.5  2000/08/19 18:44:27  peter
-    * new tdynamicarray implementation using blocks instead of
-      reallocmem (merged)
-
-  Revision 1.4  2000/08/12 19:14:58  peter
-    * ELF writer works now also with -g
-    * ELF writer is default again for linux
-
-  Revision 1.3  2000/07/13 12:08:26  michael
-  + patched to 1.1.0 with former 1.09patch from peter
-
-  Revision 1.2  2000/07/13 11:32:43  michael
-  + removed logs
+  Revision 1.1  2000-11-12 22:20:37  peter
+    * create generic toutputsection for binary writers
 
 }

compiler/options.pas

@@ -743,14 +743,14 @@ begin
                          {Remove non core targetname extra defines}
                          CASE target_info.target OF
                           target_i386_freebsd: begin
-						 undef_symbol('LINUX');
-						 undef_symbol('BSD');
- 					         undef_symbol('UNIX');
-					       end;
+                                                 undef_symbol('LINUX');
+                                                 undef_symbol('BSD');
+                                                 undef_symbol('UNIX');
+                                               end;
                           target_i386_linux:   undef_symbol('UNIX');
-		          end;
+                          end;
 
-			   { remove old target define }
+                           { remove old target define }
 
                          undef_symbol(target_info.short_name);
                        { load new target }
@@ -809,9 +809,9 @@ begin
                                  end;
                                break;
                              end;
-                        'C': apptype:=at_cui;
+                        'C': apptype:=app_cui;
                         'D': ForceDeffileForExport:=true;
-                        'G': apptype:=at_gui;
+                        'G': apptype:=app_gui;
                         'N': begin
                                RelocSection:=false;
                                RelocSectionSetExplicitly:=true;
@@ -1379,7 +1379,7 @@ begin
 
  if target_info.target=target_i386_linux then
   begin
-   def_symbol('LINUX'); 
+   def_symbol('LINUX');
    def_symbol('UNIX');
   end;
 
@@ -1515,7 +1515,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.15  2000-11-07 15:09:27  marco
+  Revision 1.16  2000-11-12 22:20:37  peter
+    * create generic toutputsection for binary writers
+
+  Revision 1.15  2000/11/07 15:09:27  marco
    * Define UNIX for FreeBSD and Linux. Checked crosscompile thingy.
 
   Revision 1.14  2000/11/07 14:25:08  marco
@@ -1564,4 +1567,4 @@ end.
   Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
 
-}
+}

compiler/t_win32.pas

@@ -962,7 +962,7 @@ begin
   if RelocSection then
    { Using short form to avoid problems with 128 char limitation under Dos. }
    RelocStr:='-b base.$$$';
-  if apptype=at_gui then
+  if apptype=app_gui then
    AppTypeStr:='--subsystem windows';
   if assigned(DLLImageBase) then
    ImageBaseStr:='--image-base=0x'+DLLImageBase^;
@@ -1043,7 +1043,7 @@ begin
   if RelocSection then
    { Using short form to avoid problems with 128 char limitation under Dos. }
    RelocStr:='-b base.$$$';
-  if apptype=at_gui then
+  if apptype=app_gui then
    AppTypeStr:='--subsystem windows';
   if assigned(DLLImageBase) then
    ImageBaseStr:='--image-base=0x'+DLLImageBase^;
@@ -1194,10 +1194,12 @@ begin
   { when -s is used or it's a dll then quit }
   if (cs_link_extern in aktglobalswitches) then
    begin
-     if apptype=at_gui then
-       cmdstr:='--subsystem gui'
-     else if apptype=at_cui then
-       cmdstr:='--subsystem console';
+     case apptype of
+       app_gui :
+         cmdstr:='--subsystem gui';
+       app_cui :
+         cmdstr:='--subsystem console';
+     end;
      if dllversion<>'' then
        cmdstr:=cmdstr+' --version '+dllversion;
      cmdstr:=cmdstr+' --input '+fn;
@@ -1228,10 +1230,12 @@ begin
   { sub system }
   { gui=2 }
   { cui=3 }
-  if apptype=at_gui then
-    peheader.Subsystem:=2
-  else if apptype=at_cui then
-    peheader.Subsystem:=3;
+  case apptype of
+    app_gui :
+      peheader.Subsystem:=2;
+    app_cui :
+      peheader.Subsystem:=3;
+  end;
   if dllversion<>'' then
     begin
      peheader.MajorImageVersion:=dllmajor;
@@ -1301,7 +1305,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2000-09-24 15:06:31  peter
+  Revision 1.6  2000-11-12 22:20:37  peter
+    * create generic toutputsection for binary writers
+
+  Revision 1.5  2000/09/24 15:06:31  peter
     * use defines.inc
 
   Revision 1.4  2000/08/27 16:11:54  peter