Jelajahi Sumber

* output is more like as 2.9.1
* stabs really working for go32v2

peter 26 tahun lalu
induk
melakukan
6f8985406a
5 mengubah file dengan 328 tambahan dan 156 penghapusan
  1. 164 45
      compiler/ag386bin.pas
  2. 19 1
      compiler/og386.pas
  3. 114 65
      compiler/og386cff.pas
  4. 7 10
      compiler/og386dbg.pas
  5. 24 35
      compiler/systems.pas

+ 164 - 45
compiler/ag386bin.pas

@@ -43,6 +43,7 @@ unit ag386bin;
         destructor  done;
         procedure WriteBin;
       private
+        currpass : byte;
 {$ifdef GDB}
         n_line       : byte;     { different types of source lines }
         linecount,
@@ -50,13 +51,16 @@ unit ag386bin;
         funcname     : pasmsymbol;
         stabslastfileinfo : tfileposinfo;
         procedure convertstabs(p:pchar);
+{$ifdef unused}
         procedure emitsymbolstabs(s : string;nidx,nother,line : longint;firstasm,secondasm : pasmsymbol);
+{$endif}
         procedure emitlineinfostabs(nidx,line : longint);
         procedure emitstabs(s:string);
-        procedure WriteFileLineInfo(var fileinfo : tfileposinfo;pass : longint);
-        procedure StartFileLineInfo(pass:longint);
+        procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
+        procedure StartFileLineInfo;
 {$endif}
-        function  TreePass1(hp:pai;optimize:boolean):pai;
+        function  TreePass0(hp:pai):pai;
+        function  TreePass1(hp:pai):pai;
         function  TreePass2(hp:pai):pai;
         procedure writetree(p:paasmoutput);
       end;
@@ -103,6 +107,15 @@ unit ag386bin;
            hp:=nil;
            s:=StrPas(P);
          end;
+      { When in pass 1 then only alloc and leave }
+        if currpass=1 then
+         begin
+           objectalloc^.staballoc(hp);
+           if assigned(hp) then
+            p[i]:='"';
+           exit;
+         end;
+      { Parse the rest of the stabs }
         if s='' then
          internalerror(33000);
         j:=pos(',',s);
@@ -179,6 +192,7 @@ unit ag386bin;
       end;
 
 
+{$ifdef unused}
     procedure ti386binasmlist.emitsymbolstabs(s : string;nidx,nother,line : longint;
                 firstasm,secondasm : pasmsymbol);
       var
@@ -205,12 +219,19 @@ unit ag386bin;
               hp,nidx,nother,line,false);
           end;
       end;
+{$endif}
 
 
     procedure ti386binasmlist.emitlineinfostabs(nidx,line : longint);
       var
          sec : tsection;
       begin
+        if currpass=1 then
+          begin
+            objectalloc^.staballoc(nil);
+            exit;
+          end;
+
         if (nidx=n_textline) and assigned(funcname) and
            (target_os.use_function_relative_addresses) then
           objectoutput^.WriteStabs(sec_code,pgenericcoffoutput(objectoutput)^.sects[sec_code]^.len-funcname^.address,
@@ -235,7 +256,7 @@ unit ag386bin;
       end;
 
 
-    procedure ti386binasmlist.WriteFileLineInfo(var fileinfo : tfileposinfo;pass : longint);
+    procedure ti386binasmlist.WriteFileLineInfo(var fileinfo : tfileposinfo);
       var
         curr_n : byte;
         hp : pasmsymbol;
@@ -252,32 +273,31 @@ unit ag386bin;
             curr_n:=n_sourcefile
            else
             curr_n:=n_includefile;
+           { get symbol for this includefile }
            hp:=newasmsymbol('Ltext'+ToStr(IncludeCount));
-           { allocation pass or output pass ? }
-           if pass=1 then
+           if currpass=1 then
              begin
                 hp^.typ:=AS_LOCAL;
                 hp^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
              end
            else
-             begin
-               objectoutput^.writesymbol(hp);
-               if (infile^.path^<>'') then
-                EmitStabs('"'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+tostr(curr_n)+
-                  ',0,0,Ltext'+ToStr(IncludeCount));
-               EmitStabs('"'+lower(FixFileName(infile^.name^))+'",'+tostr(curr_n)+
-                 ',0,0,Ltext'+ToStr(IncludeCount));
-             end;
+             objectoutput^.writesymbol(hp);
+           { emit stabs }
+           if (infile^.path^<>'') then
+             EmitStabs('"'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+tostr(curr_n)+
+               ',0,0,Ltext'+ToStr(IncludeCount));
+           EmitStabs('"'+lower(FixFileName(infile^.name^))+'",'+tostr(curr_n)+
+             ',0,0,Ltext'+ToStr(IncludeCount));
            inc(includecount);
          end;
       { line changed ? }
-        if (pass=2) and (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
+        if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
           emitlineinfostabs(n_line,fileinfo.line);
         stabslastfileinfo:=fileinfo;
       end;
 
 
-    procedure ti386binasmlist.StartFileLineInfo(pass:longint);
+    procedure ti386binasmlist.StartFileLineInfo;
       var
         fileinfo : tfileposinfo;
       begin
@@ -288,24 +308,103 @@ unit ag386bin;
         includecount:=0;
         fileinfo.fileindex:=1;
         fileinfo.line:=1;
-        WriteFileLineInfo(fileinfo,pass);
+        WriteFileLineInfo(fileinfo);
       end;
 {$endif GDB}
 
-    function ti386binasmlist.TreePass1(hp:pai;optimize:boolean):pai;
+
+    function ti386binasmlist.TreePass0(hp:pai):pai;
+      var
+        lastsec : tsection;
+      begin
+        while assigned(hp) do
+         begin
+           case hp^.typ of
+             ait_align :
+               begin
+                 if objectalloc^.sectionsize mod pai_align(hp)^.aligntype<>0 then
+                   begin
+                     pai_align(hp)^.fillsize:=pai_align(hp)^.aligntype-
+                       (objectalloc^.sectionsize mod pai_align(hp)^.aligntype);
+                     objectalloc^.sectionalloc(pai_align(hp)^.fillsize);
+                   end
+                 else
+                   pai_align(hp)^.fillsize:=0;
+               end;
+             ait_datablock :
+               begin
+{$ifdef EXTERNALBSS}
+                 if not pai_datablock(hp)^.is_global then
+                  objectalloc^.sectionalloc(pai_datablock(hp)^.size);
+{$else}
+                 objectalloc^.sectionalloc(pai_datablock(hp)^.size);
+{$endif}
+               end;
+             ait_const_32bit :
+               objectalloc^.sectionalloc(4);
+             ait_const_16bit :
+               objectalloc^.sectionalloc(2);
+             ait_const_8bit :
+               objectalloc^.sectionalloc(1);
+             ait_real_64bit :
+               objectalloc^.sectionalloc(8);
+             ait_real_32bit :
+               objectalloc^.sectionalloc(4);
+             ait_real_extended :
+               objectalloc^.sectionalloc(10);
+             ait_const_rva,
+             ait_const_symbol :
+               objectalloc^.sectionalloc(4);
+             ait_section:
+               begin
+                 objectalloc^.setsection(pai_section(hp)^.sec);
+                 lastsec:=pai_section(hp)^.sec;
+               end;
+             ait_symbol :
+               pai_symbol(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
+             ait_label :
+               begin
+                 pai_label(hp)^.setaddress(objectalloc^.sectionsize);
+                 if pai_label(hp)^.l^.is_symbol then
+                   begin
+                     pai_label(hp)^.sym:=newasmsymbol(lab2str(pai_label(hp)^.l));
+                     if (pai_label(hp)^.l^.is_data) and (cs_smartlink in aktmoduleswitches) then
+                       pai_label(hp)^.sym^.typ:=AS_GLOBAL
+                     else
+                       pai_label(hp)^.sym^.typ:=AS_LOCAL;
+                     pai_label(hp)^.sym^.setaddress(objectalloc^.currsec,pai_label(hp)^.l^.address,0);
+                   end;
+               end;
+             ait_string :
+               objectalloc^.sectionalloc(pai_string(hp)^.len);
+             ait_labeled_instruction,
+             ait_instruction :
+               objectalloc^.sectionalloc(pai386(hp)^.Pass1(objectalloc^.sectionsize));
+             ait_cut :
+               begin
+                 objectalloc^.resetsections;
+                 objectalloc^.setsection(lastsec);
+               end;
+           end;
+           hp:=pai(hp^.next);
+         end;
+        TreePass0:=hp;
+      end;
+
+
+    function ti386binasmlist.TreePass1(hp:pai):pai;
       begin
         while assigned(hp) do
          begin
 {$ifdef GDB}
            { write stabs }
-           if (not optimize) and
-              (cs_debuginfo in aktmoduleswitches) then
+           if (cs_debuginfo in aktmoduleswitches) then
             begin
               if (objectalloc^.currsec<>sec_none) and
                  not(hp^.typ in  [ait_external,ait_regalloc, ait_tempalloc,
                      ait_stabn,ait_stabs,ait_section,
                      ait_label,ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
-               WriteFileLineInfo(hp^.fileinfo,1);
+               WriteFileLineInfo(hp^.fileinfo);
             end;
 {$endif GDB}
            case hp^.typ of
@@ -367,9 +466,29 @@ unit ag386bin;
                begin
                  objectalloc^.setsection(pai_section(hp)^.sec);
 {$ifdef GDB}
+                 case pai_section(hp)^.sec of
+                  sec_code : n_line:=n_textline;
+                  sec_data : n_line:=n_dataline;
+                   sec_bss : n_line:=n_bssline;
+                 else
+                  n_line:=n_dataline;
+                 end;
                  stabslastfileinfo.line:=-1;
-{$endif}
+{$endif GDB}
                end;
+{$ifdef GDB}
+             ait_stabn :
+               convertstabs(pai_stabn(hp)^.str);
+             ait_stabs :
+               convertstabs(pai_stabs(hp)^.str);
+             ait_stab_function_name :
+               if assigned(pai_stab_function_name(hp)^.str) then
+                 funcname:=getasmsymbol(pai_stab_function_name(hp)^.str)
+               else
+                 funcname:=nil;
+             ait_force_line :
+               stabslastfileinfo.line:=0;
+{$endif}
              ait_symbol :
                begin
                  if pai_symbol(hp)^.is_global then
@@ -396,24 +515,12 @@ unit ag386bin;
              ait_labeled_instruction,
              ait_instruction :
                objectalloc^.sectionalloc(pai386(hp)^.Pass1(objectalloc^.sectionsize));
-{$ifdef GDB}
-             ait_force_line :
-               stabslastfileinfo.line:=0;
-{$endif}
-             ait_cut :
-               begin
-                 if optimize then
-                  begin
-                    objectalloc^.resetsections;
-                    objectalloc^.setsection(sec_code);
-                  end
-                 else
-                  break;
-               end;
              ait_direct :
                Comment(V_Fatal,'direct asm not supported with binary writers');
              ait_comp :
                Comment(V_Fatal,'comp not supported');
+             ait_cut :
+               break;
            end;
            hp:=pai(hp^.next);
          end;
@@ -445,7 +552,7 @@ unit ag386bin;
                  not(hp^.typ in  [ait_external,ait_regalloc, ait_tempalloc,
                      ait_stabn,ait_stabs,ait_section,
                      ait_label,ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
-               WriteFileLineInfo(hp^.fileinfo,2);
+               WriteFileLineInfo(hp^.fileinfo);
             end;
 {$endif GDB}
            case hp^.typ of
@@ -543,15 +650,23 @@ unit ag386bin;
       begin
         if not assigned(p) then
          exit;
+        objectalloc^.setsection(sec_code);
+        objectoutput^.defaultsection(sec_code);
         hp:=pai(p^.first);
         while assigned(hp) do
          begin
+         { Pass 1 }
+           currpass:=1;
 {$ifdef GDB}
-           StartFileLineInfo(1);
+           StartFileLineInfo;
 {$endif GDB}
-           TreePass1(hp,false);
+           TreePass1(hp);
+         { set section sizes }
+           objectoutput^.setsectionsizes(objectalloc^.secsize);
+         { Pass 2 }
+           currpass:=2;
 {$ifdef GDB}
-           StartFileLineInfo(2);
+           StartFileLineInfo;
 {$endif GDB}
            hp:=TreePass2(hp);
          { if assigned then we have a ait_cut }
@@ -595,11 +710,10 @@ unit ag386bin;
 
       begin
 {$ifdef MULTIPASS}
-        { Process the codesegment twice so the jmp instructions can
+        { Process the codesegment twice so the short jmp instructions can
           be optimized }
-        TreePass1(pai(codesegment^.first),true);
-        if assigned(importssection) then
-          TreePass1(pai(importssection^.first),true);
+        currpass:=0;
+        TreePass0(pai(codesegment^.first));
 {$endif}
 
         objectalloc^.resetsections;
@@ -650,6 +764,7 @@ unit ag386bin;
             objectoutput:=new(pwin32coffoutput,init);
         end;
         objectalloc:=new(pobjectalloc,init);
+        currpass:=0;
       end;
 
 
@@ -662,7 +777,11 @@ unit ag386bin;
 end.
 {
   $Log$
-  Revision 1.2  1999-05-04 21:44:30  florian
+  Revision 1.3  1999-05-05 17:34:29  peter
+    * output is more like as 2.9.1
+    * stabs really working for go32v2
+
+  Revision 1.2  1999/05/04 21:44:30  florian
     * changes to compile it with Delphi 4.0
 
   Revision 1.1  1999/05/01 13:23:57  peter

+ 19 - 1
compiler/og386.pas

@@ -49,6 +49,7 @@ unit og386;
          procedure setsection(sec:tsection);
          function  sectionsize:longint;
          procedure sectionalloc(l:longint);
+         procedure staballoc(p:pchar);
          procedure resetsections;
        end;
 
@@ -65,6 +66,7 @@ unit og386;
          procedure NextSmartName;
          procedure initwriting;virtual;
          procedure donewriting;virtual;
+         procedure setsectionsizes(var s:tsecsize);virtual;
          procedure writebytes(var data;len:longint);virtual;
          procedure writealloc(len:longint);virtual;
          procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);virtual;
@@ -80,6 +82,7 @@ unit og386;
   implementation
 
     uses
+      strings,
       globtype,globals,verbose,files,
       assemble;
 
@@ -116,6 +119,14 @@ unit og386;
       end;
 
 
+    procedure tobjectalloc.staballoc(p:pchar);
+      begin
+        inc(secsize[sec_stab]);
+        if assigned(p) and (p[0]<>#0) then
+          inc(secsize[sec_stabstr],strlen(p)+1);
+      end;
+
+
     function tobjectalloc.sectionsize:longint;
       begin
         sectionsize:=secsize[currsec];
@@ -205,6 +216,9 @@ unit og386;
         writer^.close;
       end;
 
+    procedure tobjectoutput.setsectionsizes(var s:tsecsize);
+      begin
+      end;
 
     procedure tobjectoutput.defaultsection(sec:tsection);
       begin
@@ -239,7 +253,11 @@ unit og386;
 end.
 {
   $Log$
-  Revision 1.3  1999-05-04 21:44:50  florian
+  Revision 1.4  1999-05-05 17:34:30  peter
+    * output is more like as 2.9.1
+    * stabs really working for go32v2
+
+  Revision 1.3  1999/05/04 21:44:50  florian
     * changes to compile it with Delphi 4.0
 
   Revision 1.2  1999/05/02 22:41:54  peter

+ 114 - 65
compiler/og386cff.pas

@@ -93,11 +93,13 @@ unit og386cff;
 
        pcoffsection = ^tcoffsection;
        tcoffsection = object
-          index : tsection;
+          index  : tsection;
           secidx : longint;
-          data  : PDynamicArray;
+          data   : PDynamicArray;
+          size,
+          fillsize,
+          mempos,
           len,
-          pos,
           datapos,
           relocpos,
           nrelocs,
@@ -123,6 +125,7 @@ unit og386cff;
          destructor  done;virtual;
          procedure initwriting;virtual;
          procedure donewriting;virtual;
+         procedure setsectionsizes(var s:tsecsize);virtual;
          procedure writebytes(var data;len:longint);virtual;
          procedure writealloc(len:longint);virtual;
          procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);virtual;
@@ -226,6 +229,11 @@ unit og386cff;
         index:=sec;
         secidx:=0;
         flags:=AFlags;
+        { filled after pass 1 }
+        size:=0;
+        fillsize:=0;
+        mempos:=0;
+        { pass 2 data }
         relocHead:=nil;
         relocTail:=@relocHead;
         Len:=0;
@@ -269,7 +277,7 @@ unit og386cff;
         reloctail^:=r;
         reloctail:=@r^.next;
         r^.next:=nil;
-        r^.address:=ofs;
+        r^.address:=ofs+mempos;
         r^.symbol:=p;
         r^.section:=sec_none;
         r^.relative:=relative;
@@ -285,7 +293,7 @@ unit og386cff;
         reloctail^:=r;
         reloctail:=@r^.next;
         r^.next:=nil;
-        r^.address:=ofs;
+        r^.address:=ofs+mempos;
         r^.symbol:=nil;
         r^.section:=sec;
         r^.relative:=relative_false;
@@ -391,8 +399,6 @@ unit og386cff;
             Aflags:=data_flags;
           sec_bss :
             Aflags:=bss_flags;
-        { sec_info :
-            Aflags:=info_flags; }
           else
             Aflags:=0;
         end;
@@ -435,7 +441,7 @@ unit og386cff;
         if p^.typ in [AS_LOCAL,AS_GLOBAL] then
          begin
            sym.section:=p^.section;
-           sym.value:=p^.address;
+           sym.value:=p^.address+sects[p^.section]^.mempos;
          end;
         { update the asmsymbol index }
         p^.idx:=syms^.count;
@@ -468,57 +474,55 @@ unit og386cff;
 
 
     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
-               if relative=relative_false then
-                 begin
-                   sects[currsec]^.addsectionreloc(sects[currsec]^.len,currsec);
-                   inc(data,p^.address);
-                 end
-               else if relative=relative_true then
-                 begin
-                   inc(data,p^.address-len-sects[currsec]^.len);
-                 end
-               else if relative=relative_rva then
-                 begin
-                   { don't know if this can happens !! }
-                   { does this work ?? }
-                   sects[currsec]^.addsectionreloc(sects[currsec]^.len,currsec);
-                   inc(data,p^.address);
-                 end;
+               case relative of
+                 relative_false :
+                   begin
+                     sects[currsec]^.addsectionreloc(sects[currsec]^.len,currsec);
+                     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);
+                     inc(data,symaddr);
+                   end;
+               end;
              end
            else
              begin
                writesymbol(p);
                if (p^.section<>sec_none) and (relative=relative_false) then
-                 begin
-                   sects[currsec]^.addsectionreloc(sects[currsec]^.len,p^.section);
-                 end
+                 sects[currsec]^.addsectionreloc(sects[currsec]^.len,p^.section)
                else
                  sects[currsec]^.addsymreloc(sects[currsec]^.len,p,relative);
                if not win32 then {seems wrong to me (PM) }
-                begin
-                  {if p^.section<>sec_none then
-                    this is the cause of the strange
-                    feature see Note (5) before
-                    address contains the size for
-                    global vars switched to common }
-                    inc(data,p^.address);
-                end
+                inc(data,symaddr)
                else
                 if (relative<>relative_true) and (p^.section<>sec_none) then
-                 inc(data,p^.address);
+                 inc(data,symaddr);
                if relative=relative_true then
                 begin
                   if win32 then
-                    {inc(data,4-len)}
-                    dec(data,len-4{+p^.address})
+                    dec(data,len-4)
                   else
                     dec(data,len+sects[currsec]^.len);
                 end;
@@ -538,12 +542,17 @@ unit og386cff;
         else
          s:=section;
         { local var can be at offset -1 !! PM }
-        if (offset=-1) and reloc then
+        if reloc then
          begin
-           if s=sec_none then
-            offset:=0
-           else
-            offset:=sects[s]^.len;
+           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;
         fillchar(stab,sizeof(coffstab),0);
         if assigned(p) and (p[0]<>#0) then
@@ -632,7 +641,7 @@ unit og386cff;
         for sec:=low(tsection) to high(tsection) do
          if assigned(sects[sec]) then
           begin
-            write_symbol(target_asm.secnames[sec],-1,{sects[sec]^.pos}0,sects[sec]^.secidx,3,1);
+            write_symbol(target_asm.secnames[sec],-1,sects[sec]^.mempos,sects[sec]^.secidx,3,1);
             fillchar(secrec,sizeof(secrec),0);
             secrec.len:=sects[sec]^.len;
             secrec.nrelocs:=sects[sec]^.nrelocs;
@@ -656,10 +665,49 @@ unit og386cff;
       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
+         if s[sec]>0 then
+          begin
+            if not assigned(sects[sec]) then
+             createsection(sec);
+            sects[sec]^.size:=s[sec];
+            sects[sec]^.mempos:=mempos;
+            { calculate the alignment }
+            if sects[sec]^.flags=0 then
+             align:=1
+            else
+             align:=4;
+            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;
+
+
     procedure tgenericcoffoutput.writetodisk;
       var
         datapos,secidx,
-        nsects,pos,sympos,i,fillsize : longint;
+        nsects,sympos,i : longint;
         sec    : tsection;
         header : coffheader;
         sechdr : coffsechdr;
@@ -669,26 +717,24 @@ unit og386cff;
         fillchar(empty,sizeof(empty),0);
         nsects:=0;
         for sec:=low(tsection) to high(tsection) do
-        { .stabstr section length must be without alignment !! }
          if assigned(sects[sec]) then
           begin
+          { 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]+']');
           { fill with zero }
-            fillsize:=4-(sects[sec]^.len and 3);
-            if fillsize<>4 then
+            if sects[sec]^.fillsize>0 then
              begin
                if assigned(sects[sec]^.data) then
-                 sects[sec]^.write(empty,fillsize)
+                 sects[sec]^.write(empty,sects[sec]^.fillsize)
                else
-                 sects[sec]^.alloc(fillsize);
-               { .stabstr section length must be without alignment !! }
-               if (sec=sec_stabstr) then
-                 dec(sects[sec]^.len,fillsize);
+                 sects[sec]^.alloc(sects[sec]^.fillsize);
              end;
             inc(nsects);
           end;
       { Calculate the filepositions }
         datapos:=sizeof(coffheader)+sizeof(coffsechdr)*nsects;
-        pos:=0;
         initsym:=2; { 2 for the file }
         { sections first }
         secidx:=0;
@@ -697,14 +743,9 @@ unit og386cff;
           begin
             inc(secidx);
             sects[sec]^.secidx:=secidx;
-            sects[sec]^.pos:=pos;
             sects[sec]^.datapos:=datapos;
-            inc(pos,sects[sec]^.len);
             if assigned(sects[sec]^.data) then
               inc(datapos,sects[sec]^.len);
-            { align after stabstr section !! }
-            if (sec=sec_stabstr) and ((sects[sec]^.len and 3)<>0) then
-              inc(datapos,4-(sects[sec]^.len and 3));
             inc(initsym,2); { 2 for each section }
           end;
         { relocs }
@@ -731,12 +772,16 @@ unit og386cff;
             fillchar(sechdr,sizeof(sechdr),0);
             move(target_asm.secnames[sec][1],sechdr.name,length(target_asm.secnames[sec]));
             if not win32 then
-              sechdr.vsize:=sects[sec]^.pos
-            else if sec=sec_bss then
-              sechdr.vsize:=sects[sec]^.len;
+              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;
-            { apparently win32 asw leaves section at datapos zero }
-            { this was an error by me (PM) }
             if (sects[sec]^.len>0) and assigned(sects[sec]^.data) then
               sechdr.datapos:=sects[sec]^.datapos;
             sechdr.relocpos:=sects[sec]^.relocpos;
@@ -839,7 +884,11 @@ unit og386cff;
 end.
 {
   $Log$
-  Revision 1.2  1999-05-02 22:36:35  peter
+  Revision 1.3  1999-05-05 17:34:31  peter
+    * output is more like as 2.9.1
+    * stabs really working for go32v2
+
+  Revision 1.2  1999/05/02 22:36:35  peter
     * fixed section index when not all sections are used
 
   Revision 1.1  1999/05/01 13:24:24  peter

+ 7 - 10
compiler/og386dbg.pas

@@ -54,13 +54,6 @@ unit og386dbg;
                                 Tdbgoutput
 ****************************************************************************}
 
-      const
-        sec_2_str : array[tsection] of string[8]=('<none>',
-          '.text','.data','.bss',
-          '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
-          '.stab','.stabstr',''
-        );
-
     constructor tdbgoutput.init;
       begin
         inherited init;
@@ -100,7 +93,7 @@ unit og386dbg;
            rawidx:=-1;
          end;
         p^.idx:=nsyms;
-        write('symbol [',nsyms,'] '+p^.name+' (',sec_2_str[p^.section],',',p^.address,',',p^.size,',');
+        write('symbol [',nsyms,'] '+p^.name+' (',target_asm.secnames[p^.section],',',p^.address,',',p^.size,',');
         case p^.typ of
           AS_LOCAL :
             writeln('local)');
@@ -123,7 +116,7 @@ unit og386dbg;
            rawidx:=-1;
          end;
         if assigned(p) then
-          write('reloc: ',data,' [',sec_2_str[p^.section],',',p^.address,']')
+          write('reloc: ',data,' [',target_asm.secnames[p^.section],',',p^.address,']')
         else
           write('reloc: ',data);
         case relative of
@@ -189,7 +182,11 @@ unit og386dbg;
 end.
 {
   $Log$
-  Revision 1.2  1999-05-02 22:41:55  peter
+  Revision 1.3  1999-05-05 17:34:32  peter
+    * output is more like as 2.9.1
+    * stabs really working for go32v2
+
+  Revision 1.2  1999/05/02 22:41:55  peter
     * moved section names to systems
     * fixed nasm,intel writer
 

+ 24 - 35
compiler/systems.pas

@@ -39,9 +39,8 @@ unit systems;
 
        tsection=(sec_none,
          sec_code,sec_data,sec_bss,
-         sec_stab,sec_stabstr,
          sec_idata2,sec_idata4,sec_idata5,sec_idata6,sec_idata7,sec_edata,
-         sec_fake
+         sec_stab,sec_stabstr
        );
 
      type
@@ -483,9 +482,8 @@ implementation
             comment : '# ';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '','','','','','',
-              '')
+              '.stab','.stabstr')
           )
           ,(
             id     : as_i386_as_aout;
@@ -498,9 +496,8 @@ implementation
             comment : '# ';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '','','','','','',
-              '')
+              '.stab','.stabstr')
           )
           ,(
             id     : as_i386_asw;
@@ -513,10 +510,9 @@ implementation
             comment : '# ';
             secnames : ('',
               '.text','.data','.section .bss',
-              '.stab','.stabstr',
               '.section .idata$2','.section .idata$4','.section .idata$5',
                 '.section .idata$6','.section .idata$7','.section .edata',
-              '')
+              '.stab','.stabstr')
           )
           ,(
             id     : as_i386_nasmcoff;
@@ -529,9 +525,8 @@ implementation
             comment : '; ';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '')
+              '.stab','.stabstr')
           )
           ,(
             id     : as_i386_nasmelf;
@@ -544,9 +539,8 @@ implementation
             comment : '; ';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '')
+              '.stab','.stabstr')
           )
           ,(
             id     : as_i386_nasmobj;
@@ -559,9 +553,8 @@ implementation
             comment : '; ';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '')
+              '.stab','.stabstr')
           )
           ,(
             id     : as_i386_tasm;
@@ -574,8 +567,8 @@ implementation
             comment : '; ';
             secnames : ('',
               'CODE','DATA','BSS',
-              '','','','','','','','',
-              '')
+              '','','','','','',
+              '','')
           )
           ,(
             id     : as_i386_masm;
@@ -588,8 +581,8 @@ implementation
             comment : '; ';
             secnames : ('',
               'CODE','DATA','BSS',
-              '','','','','','','','',
-              '')
+              '','','','','','',
+              '','')
           )
           ,(
             id     : as_i386_dbg;
@@ -602,9 +595,8 @@ implementation
             comment : '';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
-              '.fake')
+              '.stab','.stabstr')
           )
           ,(
             id     : as_i386_coff;
@@ -617,9 +609,8 @@ implementation
             comment : '';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
-              '.fake')
+              '.stab','.stabstr')
           )
           ,(
             id     : as_i386_pecoff;
@@ -632,9 +623,8 @@ implementation
             comment : '';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
-              '.fake')
+              '.stab','.stabstr')
           )
 {$endif i386}
 {$ifdef m68k}
@@ -648,9 +638,8 @@ implementation
             comment : '# ';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
-              '.fake')
+              '.stab','.stabstr')
           )
           ,(
             id     : as_m68k_gas;
@@ -662,9 +651,8 @@ implementation
             comment : '| ';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
-              '.fake')
+              '.stab','.stabstr')
           )
           ,(
             id     : as_m68k_mit;
@@ -676,9 +664,8 @@ implementation
             comment : '| ';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
-              '.fake')
+              '.stab','.stabstr')
           )
           ,(
             id     : as_m68k_mot;
@@ -690,9 +677,8 @@ implementation
             comment : '| ';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
-              '.fake')
+              '.stab','.stabstr')
           )
           ,(
             id     : as_m68k_mpw;
@@ -704,9 +690,8 @@ implementation
             comment : '| ';
             secnames : ('',
               '.text','.data','.bss',
-              '.stab','.stabstr',
               '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
-              '.fake')
+              '.stab','.stabstr')
           )
 {$endif m68k}
           );
@@ -1467,7 +1452,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.70  1999-05-05 09:19:18  florian
+  Revision 1.71  1999-05-05 17:34:33  peter
+    * output is more like as 2.9.1
+    * stabs really working for go32v2
+
+  Revision 1.70  1999/05/05 09:19:18  florian
     * more fixes to get it with delphi running
 
   Revision 1.69  1999/05/03 18:03:29  peter