paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-10 13:59:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Add -Xg to help pages

Browse Source 
* -Xg now produces a .dbg file with debuginfo
    that can be used by gdb. The main executable gets
    a debuglink section that references the .dbg file.

git-svn-id: trunk@9778 -
This commit is contained in:
peter 2008-01-17 01:20:37 +00:00
parent bd70396a93
commit 793fd8fc09
10 changed files with 351 additions and 278 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
compiler/fpccrc.pas
View File

@ -25,9 +25,7 @@ Unit fpccrc;
Interface
Function Crc32(Const HStr:String):cardinal;
Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:integer):cardinal;
Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
Implementation
@ -57,21 +55,6 @@ begin
end;
Function Crc32(Const HStr:String):cardinal;
var
i : integer;
InitCrc : cardinal;
begin
if Crc32Tbl[1]=0 then
MakeCrc32Tbl;
InitCrc:=cardinal($ffffffff);
for i:=1 to Length(Hstr) do
InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(Hstr[i])] xor (InitCrc shr 8);
Crc32:=InitCrc;
end;
Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:Integer):cardinal;
var
i : integer;
@ -80,21 +63,14 @@ begin
if Crc32Tbl[1]=0 then
MakeCrc32Tbl;
p:=@InBuf;
result:=not InitCrc;
for i:=1 to InLen do
begin
InitCrc:=Crc32Tbl[byte(InitCrc) xor byte(p^)] xor (InitCrc shr 8);
result:=Crc32Tbl[byte(result) xor byte(p^)] xor (result shr 8);
inc(p);
end;
UpdateCrc32:=InitCrc;
result:=not result;
end;
Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
begin
if Crc32Tbl[1]=0 then
MakeCrc32Tbl;
UpdCrc32:=Crc32Tbl[byte(InitCrc) xor b] xor (InitCrc shr 8);
end;
end.

101
compiler/link.pas
View File

@ -94,7 +94,8 @@ interface
procedure Load_ReadStaticLibrary(const para:TCmdStr);
procedure ParseScript_Load;
procedure ParseScript_Order;
procedure ParseScript_CalcPos;
procedure ParseScript_MemPos;
procedure ParseScript_DataPos;
procedure PrintLinkerScript;
function RunLinkScript(const outputname:TCmdStr):boolean;
protected
@ -127,8 +128,8 @@ interface
Implementation
uses
cutils,cfileutl,
script,globals,verbose,comphook,ppu,
cutils,cfileutl,cstreams,
script,globals,verbose,comphook,ppu,fpccrc,
aasmbase,aasmtai,aasmdata,aasmcpu,
owbase,owar,ogmap;
@ -139,6 +140,32 @@ Implementation
Helpers
*****************************************************************************}
function GetFileCRC(const fn:string):cardinal;
var
fs : TCStream;
bufcount,
bufsize : Integer;
buf : pbyte;
begin
result:=0;
bufsize:=64*1024;
fs:=TCFileStream.Create(fn,fmOpenRead or fmShareDenyNone);
if CStreamError<>0 then
begin
fs.Free;
Comment(V_Error,'Can''t open file: '+fn);
exit;
end;
getmem(buf,bufsize);
repeat
bufcount:=fs.Read(buf^,bufsize);
result:=UpdateCrc32(result,buf^,bufcount);
until bufcount<bufsize;
freemem(buf);
fs.Free;
end;
{ searches an object file }
function FindObjectFile(s:TCmdStr;const unitpath:TCmdStr;isunit:boolean) : TCmdStr;
var
@ -913,14 +940,14 @@ Implementation
end;
procedure TInternalLinker.ParseScript_CalcPos;
procedure TInternalLinker.ParseScript_MemPos;
var
s,
para,
keyword : String;
hp : TCmdStrListItem;
begin
exeoutput.CalcPos_Start;
exeoutput.MemPos_Start;
hp:=TCmdStrListItem(linkscript.first);
while assigned(hp) do
begin
@ -930,13 +957,40 @@ Implementation
keyword:=Upper(GetToken(s,' '));
para:=GetToken(s,' ');
if keyword='EXESECTION' then
ExeOutput.CalcPos_ExeSection(para)
ExeOutput.MemPos_ExeSection(para)
else if keyword='ENDEXESECTION' then
ExeOutput.CalcPos_EndExeSection
ExeOutput.MemPos_EndExeSection
else if keyword='HEADER' then
ExeOutput.CalcPos_Header
ExeOutput.MemPos_Header;
hp:=TCmdStrListItem(hp.next);
end;
end;
procedure TInternalLinker.ParseScript_DataPos;
var
s,
para,
keyword : String;
hp : TCmdStrListItem;
begin
exeoutput.DataPos_Start;
hp:=TCmdStrListItem(linkscript.first);
while assigned(hp) do
begin
s:=hp.str;
if (s='') or (s[1]='#') then
continue;
keyword:=Upper(GetToken(s,' '));
para:=GetToken(s,' ');
if keyword='EXESECTION' then
ExeOutput.DataPos_ExeSection(para)
else if keyword='ENDEXESECTION' then
ExeOutput.DataPos_EndExeSection
else if keyword='HEADER' then
ExeOutput.DataPos_Header
else if keyword='SYMBOLS' then
ExeOutput.CalcPos_Symbols;
ExeOutput.DataPos_Symbols;
hp:=TCmdStrListItem(hp.next);
end;
end;
@ -964,7 +1018,8 @@ Implementation
myexit;
var
bsssize : aint;
bsssec : TExeSection;
bsssec : TExeSection;
dbgname : TCmdStr;
begin
result:=false;
@ -999,16 +1054,34 @@ Implementation
if ErrorCount>0 then
goto myexit;
{ Calc positions in mem and file }
ParseScript_CalcPos;
{ Calc positions in mem }
ParseScript_MemPos;
exeoutput.FixupRelocations;
exeoutput.PrintMemoryMap;
if ErrorCount>0 then
goto myexit;
exeoutput.WriteExeFile(outputname);
if cs_link_separate_dbg_file in current_settings.globalswitches then
exeoutput.WriteDbgFile(ChangeFileExt(outputname,'.dbg'));
begin
{ create debuginfo, which is an executable without data on disk }
dbgname:=ChangeFileExt(outputname,'.dbg');
exeoutput.ExeWriteMode:=ewm_dbgonly;
ParseScript_DataPos;
exeoutput.WriteExeFile(dbgname);
{ create executable with link to just created debuginfo file }
exeoutput.ExeWriteMode:=ewm_exeonly;
exeoutput.RemoveDebugInfo;
exeoutput.GenerateDebugLink(dbgname,GetFileCRC(dbgname));
ParseScript_MemPos;
ParseScript_DataPos;
exeoutput.WriteExeFile(outputname);
end
else
begin
exeoutput.ExeWriteMode:=ewm_exefull;
ParseScript_DataPos;
exeoutput.WriteExeFile(outputname);
end;
{$warning TODO fixed section names}
status.codesize:=exeoutput.findexesection('.text').size;

1
compiler/msg/errore.msg
View File

@ -2686,6 +2686,7 @@ P*2WT_Specify MPW tool type application (Classic Mac OS)
**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Linux)
**2Xd_Do not use standard library search path (needed for cross compile)
**2Xe_Use external linker
**2Xg_Create debuginfo in a separate file and add a debuglink section to executable
**2XD_Try to link units dynamically (defines FPC_LINK_DYNAMIC)
**2Xi_Use internal linker
**2Xm_Generate link map

2
compiler/msgidx.inc
View File

@ -734,7 +734,7 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 45492;
MsgTxtSize = 45576;
MsgIdxMax : array[1..20] of longint=(
24,86,238,84,63,50,108,22,135,60,

19
compiler/msgtxt.inc
View File

@ -1071,19 +1071,22 @@ const msgtxt : array[0..000189,1..240] of char=(
'**2Xd_Do not use standard library search path (needed for cross compil'+
'e)'#010+
'**2Xe_Use external linker'#010+
'**2XD_Try to link units dynamically (defines FPC_LINK_DYNAMIC)'#010+
'**2Xg_Create debuginfo in a separate file and add a debuglink section '+
'to executable'#010+
'**2XD_Try to link units dynam','ically (defines FPC_LINK_DYNAMIC)'#010+
'**2Xi_Use internal linker'#010+
'**2Xm_Generate link',' map'#010+
'**2Xm_Generate link map'#010+
'**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
's '#039'main'#039')'#010+
'**2XP<x>_Prepend the binutils names with the prefix <x>'#010+
'**2Xr<x>_Set library search path to <x> (needed for cross compile) (Be'+
'OS, Linux)'#010+
'**2XR<x>_Prepend <x> to al','l linker search paths (BeOS, Darwin, FreeB'+
'SD, Linux, Mac OS, Solaris)'#010+
'**2Xr<x>_Set library se','arch path to <x> (needed for cross compile) ('+
'BeOS, Linux)'#010+
'**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD'+
', Linux, Mac OS, Solaris)'#010+
'**2Xs_Strip all symbols from executable'#010+
'**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
'**2Xt_Link with static libraries (-static is passed to linke','r)'#010+
'**2XS_Try to link units statically (default, d','efines FPC_LINK_STATIC'+
')'#010+
'**2Xt_Link with static libraries (-static is passed to linker)'#010+
'**2XX_Try to smartlink units (defines FPC_LINK_SMART)'#010+
'**1*_'#010+
'**1?_Show this help'#010+

349
compiler/ogbase.pas
View File

@ -102,6 +102,9 @@ interface
N_EXCL = $C2;
N_RBRAC = $E0;
{ GNU extensions }
debuglinkname='.gnu_debuglink';
type
TObjSectionOption = (
{ Has Data available in the file }
@ -388,6 +391,8 @@ interface
property IsVar: boolean read FIsVar;
end;
TExeWriteMode = (ewm_exefull,ewm_dbgonly,ewm_exeonly);
TExeOutput = class
private
{ ExeSectionList }
@ -395,7 +400,6 @@ interface
FCExeSection : TExeSectionClass;
FCurrExeSec : TExeSection;
FExeSectionList : TFPHashObjectList;
FDebugSectionList : TFPHashObjectList;
Fzeronr : longint;
{ Symbols }
FExeSymbolList : TFPHashObjectList;
@ -410,6 +414,7 @@ interface
FImageBase : aint;
protected
{ writer }
FExeWriteMode : TExeWriteMode;
FWriter : TObjectwriter;
commonObjSection : TObjSection;
internalObjData : TObjData;
@ -441,11 +446,15 @@ interface
procedure Order_Symbol(const aname:string);virtual;
procedure Order_EndExeSection;virtual;
procedure Order_ObjSection(const aname:string);virtual;
procedure CalcPos_ExeSection(const aname:string);virtual;
procedure CalcPos_EndExeSection;virtual;
procedure CalcPos_Header;virtual;
procedure CalcPos_Start;virtual;
procedure CalcPos_Symbols;virtual;
procedure MemPos_Start;virtual;
procedure MemPos_Header;virtual;
procedure MemPos_ExeSection(const aname:string);virtual;
procedure MemPos_EndExeSection;virtual;
procedure DataPos_Start;virtual;
procedure DataPos_Header;virtual;
procedure DataPos_ExeSection(const aname:string);virtual;
procedure DataPos_EndExeSection;virtual;
procedure DataPos_Symbols;virtual;
procedure BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
procedure PackUnresolvedExeSymbols(const s:string);
procedure ResolveSymbols(StaticLibraryList:TFPHashObjectList);
@ -455,12 +464,12 @@ interface
procedure MergeStabs;
procedure RemoveUnreferencedSections;
procedure RemoveEmptySections;
procedure RemoveDebugInfo;
procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);virtual;
function writedbgfile(const fn:string):boolean;
function writeexefile(const fn:string):boolean;
procedure GenerateDebugLink(const dbgname:string;dbgcrc:cardinal);
function WriteExeFile(const fn:string):boolean;
property Writer:TObjectWriter read FWriter;
property ExeSectionList:TFPHashObjectList read FExeSectionList;
property DebugSectionList:TFPHashObjectList read FDebugSectionList;
property ObjDataList:TFPObjectList read FObjDataList;
property ExeSymbolList:TFPHashObjectList read FExeSymbolList;
property UnresolvedExeSymbols:TFPObjectList read FUnresolvedExeSymbols;
@ -470,6 +479,7 @@ interface
property EntryName:string read FEntryName write FEntryName;
property ImageBase:aint read FImageBase write FImageBase;
property CurrExeSec:TExeSection read FCurrExeSec;
property ExeWriteMode:TExeWriteMode read FExeWriteMode write FExeWriteMode;
end;
TExeOutputClass=class of TExeOutput;
@ -1384,6 +1394,7 @@ implementation
begin
{ init writer }
FWriter:=TObjectwriter.create;
FExeWriteMode:=ewm_exefull;
{ object files }
FObjDataList:=TFPObjectList.Create(true);
{ symbols }
@ -1395,7 +1406,6 @@ implementation
FEntryName:='start';
{ sections }
FExeSectionList:=TFPHashObjectList.Create(true);
FDebugSectionList:=TFPHashObjectList.Create(true);
FImageBase:=0;
SectionMemAlign:=$1000;
SectionDataAlign:=$200;
@ -1412,102 +1422,20 @@ implementation
CommonObjSymbols.free;
ExeVTableList.free;
FExeSectionList.free;
FDebugSectionList.free;
ObjDatalist.free;
FWriter.free;
inherited destroy;
end;
function TExeOutput.writedbgfile(const fn:string):boolean;
var
ObjWriter : TObjectwriter;
exesec : TExeSection;
objsec : TObjSection;
header : string[6];
s : string;
i,j,
seccnt,
secstart : longint;
function TExeOutput.WriteExeFile(const fn:string):boolean;
begin
result:=false;
{
File layout:
<header> 6 bytes
<section count> 4 bytes
(
<section offset> 4 bytes
<section name> asciiz
...
)
(
<section data>
...
)
}
header:='FPCDBG';
{ Calculate file offsets }
secstart:=length(header)+sizeof(seccnt);
for i:=0 to DebugSectionList.Count-1 do
begin
exesec:=TExeSection(DebugSectionList[i]);
inc(secstart,sizeof(secstart)+length(exesec.Name)+1);
end;
for i:=0 to DebugSectionList.Count-1 do
begin
exesec:=TExeSection(DebugSectionList[i]);
exesec.DataPos:=secstart;
for j:=0 to exesec.ObjSectionList.Count-1 do
begin
objsec:=TObjSection(exesec.ObjSectionList[j]);
inc(secstart,objsec.size);
end;
end;
{ Create file }
ObjWriter:=TObjectwriter.Create;
if not ObjWriter.createfile(fn) then
begin
ObjWriter.Free;
exit;
end;
{ Header }
ObjWriter.Write(header[1], Length(header));
seccnt:=DebugSectionList.Count;
ObjWriter.Write(seccnt,sizeof(seccnt));
for i:=0 to DebugSectionList.Count-1 do
begin
exesec:=TExeSection(DebugSectionList[i]);
ObjWriter.Write(exesec.DataPos,sizeof(secstart));
s:=exesec.Name;
ObjWriter.Write(s[1],length(s));
ObjWriter.writezeros(1);
end;
{ Write section data }
for i:=0 to DebugSectionList.Count-1 do
begin
exesec:=TExeSection(DebugSectionList[i]);
if exesec.DataPos<>ObjWriter.ObjSize then
internalerror(200702241);
for j:=0 to exesec.ObjSectionList.Count-1 do
begin
objsec:=TObjSection(exesec.ObjSectionList[j]);
ObjWriter.writearray(objsec.data);
end;
end;
ObjWriter.Free;
result:=true;
end;
function TExeOutput.writeexefile(const fn:string):boolean;
begin
result:=false;
if FWriter.createfile(fn) then
begin
{ Only write the .o if there are no errors }
if errorcount=0 then
result:=writeData
result:=writedata
else
result:=true;
{ close the writer }
@ -1703,7 +1631,18 @@ implementation
end;
procedure TExeOutput.CalcPos_ExeSection(const aname:string);
procedure TExeOutput.MemPos_Start;
begin
CurrMemPos:=0;
end;
procedure TExeOutput.MemPos_Header;
begin
end;
procedure TExeOutput.MemPos_ExeSection(const aname:string);
var
i : longint;
objsec : TObjSection;
@ -1717,6 +1656,51 @@ implementation
CurrMemPos:=align(CurrMemPos,SectionMemAlign);
CurrExeSec.MemPos:=CurrMemPos;
{ set position of object ObjSections }
for i:=0 to CurrExeSec.ObjSectionList.Count-1 do
begin
objsec:=TObjSection(CurrExeSec.ObjSectionList[i]);
objsec.setmempos(CurrMemPos);
end;
{ calculate size of the section }
CurrExeSec.Size:=CurrMemPos-CurrExeSec.MemPos;
end;
procedure TExeOutput.MemPos_EndExeSection;
begin
if not assigned(CurrExeSec) then
exit;
FCurrExeSec:=nil;
end;
procedure TExeOutput.DataPos_Start;
begin
end;
procedure TExeOutput.DataPos_Header;
begin
end;
procedure TExeOutput.DataPos_ExeSection(const aname:string);
var
i : longint;
objsec : TObjSection;
begin
{ Section can be removed }
FCurrExeSec:=FindExeSection(aname);
if not assigned(CurrExeSec) then
exit;
{ don't write normal section if writing only debug info }
if (ExeWriteMode=ewm_dbgonly) and
not(oso_debug in CurrExeSec.SecOptions) then
exit;
if (oso_Data in currexesec.SecOptions) then
begin
CurrDataPos:=align(CurrDataPos,SectionDataAlign);
@ -1727,26 +1711,19 @@ implementation
for i:=0 to CurrExeSec.ObjSectionList.Count-1 do
begin
objsec:=TObjSection(CurrExeSec.ObjSectionList[i]);
{ Position in memory }
objsec.setmempos(CurrMemPos);
{ Position in File }
if (oso_Data in objsec.SecOptions) then
begin
if not (oso_Data in currexesec.SecOptions) then
if not(oso_Data in currexesec.SecOptions) then
internalerror(200603043);
if not assigned(objsec.Data) then
internalerror(200603044);
objsec.setDatapos(CurrDataPos);
end;
end;
{ calculate size of the section }
CurrExeSec.Size:=CurrMemPos-CurrExeSec.MemPos;
end;
procedure TExeOutput.CalcPos_EndExeSection;
procedure TExeOutput.DataPos_EndExeSection;
begin
if not assigned(CurrExeSec) then
exit;
@ -1754,19 +1731,7 @@ implementation
end;
procedure TExeOutput.CalcPos_Start;
begin
CurrMemPos:=0;
CurrDataPos:=0;
end;
procedure TExeOutput.CalcPos_Header;
begin
end;
procedure TExeOutput.CalcPos_Symbols;
procedure TExeOutput.DataPos_Symbols;
var
i : longint;
sym : TExeSymbol;
@ -2067,6 +2032,41 @@ implementation
end;
procedure TExeOutput.GenerateDebugLink(const dbgname:string;dbgcrc:cardinal);
var
debuglink : array[0..1023] of byte;
len : longint;
objsec : TObjSection;
exesec : TExeSection;
begin
{ From the gdb manual chapter 15. GDB Files:
* A filename, with any leading directory components removed, followed by a zero byte,
* zero to three bytes of padding, as needed to reach the next four-byte boundary within the section, and
* a four-byte CRC checksum, stored in the same endianness used for the executable file itself. The checksum is computed
on the debugging information file's full contents by the function given below, passing zero as the crc argument.
}
fillchar(debuglink,sizeof(debuglink),0);
len:=0;
move(dbgname[1],debuglink[len],length(dbgname));
inc(len,length(dbgname)+1);
len:=align(len,4);
if source_info.endian<>target_info.endian then
SwapEndian(dbgcrc);
move(dbgcrc,debuglink[len],sizeof(cardinal));
inc(len,4);
{ Add section }
exesec:=FindExeSection(debuglinkname);
if not assigned(exesec) then
exesec:=CExeSection.create(ExeSectionList,debuglinkname);
exesec.SecOptions:=[oso_data,oso_keep];
exesec.SecAlign:=4;
objsec:=internalObjData.createsection(exesec.name,0,exesec.SecOptions);
internalObjData.writebytes(debuglink,len);
exesec.AddObjSection(objsec);
end;
procedure TExeOutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);
begin
end;
@ -2184,7 +2184,7 @@ implementation
(stabexesec.ObjSectionlist.count=0) then
exit;
{ Create new stabsection }
stabRelocofs:=pointer(@hstab.nvalue)-@hstab;
stabRelocofs:=pbyte(@hstab.nvalue)-pbyte(@hstab);
mergedstabsec:=internalObjData.CreateSection(sec_stab,'');
mergedstabstrsec:=internalObjData.CreateSection(sec_stabstr,'');
@ -2338,42 +2338,46 @@ implementation
begin
exesec:=TExeSection(ExeSectionList[i]);
if (cs_link_separate_dbg_file in current_settings.globalswitches) and
(oso_debug in exesec.SecOptions) then
doremove:=not(oso_keep in exesec.SecOptions) and
(
(exesec.ObjSectionlist.count=0) or
(
(cs_link_strip in current_settings.globalswitches) and
not(cs_link_separate_dbg_file in current_settings.globalswitches) and
(oso_debug in exesec.SecOptions)
)
);
if not doremove then
begin
Comment(V_Debug,'Adding debug section '+exesec.name+' to debugfile');
ExeSectionList.OwnsObjects:=false;
ExeSectionList[i]:=nil;
ExeSectionList.OwnsObjects:=true;
DebugSectionList.Add(exesec.Name,exesec);
end
else
begin
doremove:=not(oso_keep in exesec.SecOptions) and
(
(exesec.ObjSectionlist.count=0) or
(
(cs_link_strip in current_settings.globalswitches) and
(oso_debug in exesec.SecOptions)
)
);
if not doremove then
begin
{ Check if section has no actual data }
doremove:=true;
for j:=0 to exesec.ObjSectionList.Count-1 do
if TObjSection(exesec.ObjSectionList[j]).Size<>0 then
begin
doremove:=false;
break;
end;
end;
if doremove and not (RelocSection and (exesec.Name='.reloc')) then
begin
Comment(V_Debug,'Deleting empty section '+exesec.name);
ExeSectionList[i]:=nil;
end;
{ Check if section has no actual data }
doremove:=true;
for j:=0 to exesec.ObjSectionList.Count-1 do
if TObjSection(exesec.ObjSectionList[j]).Size<>0 then
begin
doremove:=false;
break;
end;
end;
if doremove and not (RelocSection and (exesec.Name='.reloc')) then
begin
Comment(V_Debug,'Deleting empty section '+exesec.name);
ExeSectionList[i]:=nil;
end;
end;
ExeSectionList.Pack;
end;
procedure TExeOutput.RemoveDebugInfo;
var
i : longint;
exesec : TExeSection;
begin
for i:=0 to ExeSectionList.Count-1 do
begin
exesec:=TExeSection(ExeSectionList[i]);
if (oso_debug in exesec.SecOptions) then
ExeSectionList[i]:=nil;
end;
ExeSectionList.Pack;
end;
@ -2551,31 +2555,24 @@ implementation
procedure TExeOutput.FixupRelocations;
procedure FixupSectionList(List:TFPHashObjectList);
var
i,j : longint;
exesec : TExeSection;
objsec : TObjSection;
begin
for i:=0 to List.Count-1 do
begin
exesec:=TExeSection(List[i]);
if not assigned(exesec) then
continue;
for j:=0 to exesec.ObjSectionlist.count-1 do
begin
objsec:=TObjSection(exesec.ObjSectionlist[j]);
if not objsec.Used then
internalerror(200603301);
objsec.FixupRelocs;
end;
end;
end;
var
i,j : longint;
exesec : TExeSection;
objsec : TObjSection;
begin
FixupSectionList(ExeSectionList);
FixupSectionList(DebugSectionList);
for i:=0 to ExeSectionList.Count-1 do
begin
exesec:=TExeSection(ExeSectionList[i]);
if not assigned(exesec) then
continue;
for j:=0 to exesec.ObjSectionlist.count-1 do
begin
objsec:=TObjSection(exesec.ObjSectionlist[j]);
if not objsec.Used then
internalerror(200603301);
objsec.FixupRelocs;
end;
end;
end;

115
compiler/ogcoff.pas
View File

@ -227,14 +227,16 @@ interface
nsects : smallint;
nsyms,
sympos : aint;
function totalheadersize:longint;
procedure ExeSectionList_pass2_header(p:TObject;arg:pointer);
procedure write_symbol(const name:string;value:aint;section:smallint;typ,aux:byte);
procedure globalsyms_write_symbol(p:TObject;arg:pointer);
procedure ExeSectionList_write_header(p:TObject;arg:pointer);
procedure ExeSectionList_write_data(p:TObject;arg:pointer);
protected
procedure CalcPos_Header;override;
procedure CalcPos_Symbols;override;
procedure MemPos_Header;override;
procedure DataPos_Header;override;
procedure DataPos_Symbols;override;
function writedata:boolean;override;
procedure Order_ObjSectionList(ObjSectionList : TFPObjectList);override;
public
@ -253,7 +255,7 @@ interface
constructor create;override;
procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);override;
procedure Order_End;override;
procedure CalcPos_ExeSection(const aname:string);override;
procedure MemPos_ExeSection(const aname:string);override;
end;
TObjSymbolrec = record
@ -1697,7 +1699,7 @@ const pemagic : array[0..3] of byte = (
with TCoffObjSection(p) do
begin
{ Skip debug sections }
if (oso_debug in secoptions) and
if (oso_debug in secoptions) and
(cs_link_strip in current_settings.globalswitches) and
not(cs_link_separate_dbg_file in current_settings.globalswitches) then
exit;
@ -1988,17 +1990,13 @@ const pemagic : array[0..3] of byte = (
sechdr.vsize:=Size
else
sechdr.vsize:=mempos;
{ sechdr.dataSize is size of initilized data. For .bss section it must be zero }
if Name <> '.bss' then
begin
if oso_data in SecOptions then
begin
sechdr.dataSize:=Size;
sechdr.datapos:=datapos;
end
else
sechdr.dataSize:=Size;
end;
if (Name <> '.bss') then
sechdr.dataSize:=Size;
if (sechdr.dataSize>0) and
(oso_data in SecOptions) then
sechdr.datapos:=datapos;
sechdr.nrelocs:=0;
sechdr.relocpos:=0;
if win32 then
@ -2014,6 +2012,10 @@ const pemagic : array[0..3] of byte = (
begin
with TExeSection(p) do
begin
{ The debuginfo sections should already be stripped }
{ if (ExeWriteMode=ewm_exeonly) and
(oso_debug in SecOptions) then
internalerror(200801161); }
inc(plongint(arg)^);
secsymidx:=plongint(arg)^;
end;
@ -2024,9 +2026,15 @@ const pemagic : array[0..3] of byte = (
var
objsec : TObjSection;
i : longint;
b : boolean;
begin
with texesection(p) do
begin
{ don't write normal section if writing only debug info }
if (ExeWriteMode=ewm_dbgonly) and
not(oso_debug in SecOptions) then
exit;
if oso_data in secoptions then
begin
FWriter.Writezeros(Align(FWriter.Size,SectionDataAlign)-FWriter.Size);
@ -2048,7 +2056,7 @@ const pemagic : array[0..3] of byte = (
end;
procedure tcoffexeoutput.CalcPos_Header;
function tcoffexeoutput.totalheadersize:longint;
var
stubsize,
optheadersize : longint;
@ -2063,20 +2071,30 @@ const pemagic : array[0..3] of byte = (
stubsize:=sizeof(go32v2stub);
optheadersize:=sizeof(coffdjoptheader);
end;
{ retrieve amount of ObjSections }
nsects:=0;
ExeSectionList.ForEachCall(@ExeSectionList_pass2_header,@nsects);
{ calculate start positions after the headers }
currdatapos:=stubsize+optheadersize+sizeof(tcoffsechdr)*nsects;
currmempos:=stubsize+optheadersize+sizeof(tcoffsechdr)*nsects;
result:=stubsize+sizeof(tcoffheader)+optheadersize;
end;
procedure tcoffexeoutput.CalcPos_Symbols;
procedure tcoffexeoutput.MemPos_Header;
begin
inherited CalcPos_Symbols;
nsyms:=0;
sympos:=0;
{ calculate start positions after the headers }
currmempos:=totalheadersize+sizeof(tcoffsechdr)*(ExeSectionList.Count-2);
end;
procedure tcoffexeoutput.DataPos_Header;
begin
{ retrieve amount of sections }
nsects:=0;
ExeSectionList.ForEachCall(@ExeSectionList_pass2_header,@nsects);
{ calculate start positions after the headers }
currdatapos:=totalheadersize+sizeof(tcoffsechdr)*nsects;
end;
procedure tcoffexeoutput.DataPos_Symbols;
begin
inherited DataPos_Symbols;
{ Calculating symbols position and size }
nsyms:=ExeSymbolList.Count;
sympos:=CurrDataPos;
@ -2093,6 +2111,7 @@ const pemagic : array[0..3] of byte = (
textExeSec,
dataExeSec,
bssExeSec : TExeSection;
hassymbols : boolean;
procedure UpdateDataDir(const secname:string;idx:longint);
var
@ -2116,6 +2135,12 @@ const pemagic : array[0..3] of byte = (
if not assigned(TextExeSec) or
not assigned(DataExeSec) then
internalerror(200602231);
{ do we need to write symbols? }
hassymbols:=(ExeWriteMode=ewm_dbgonly) or
(
(ExeWriteMode=ewm_exefull) and
not(cs_link_strip in current_settings.globalswitches)
);
{ Stub }
if win32 then
begin
@ -2124,12 +2149,13 @@ const pemagic : array[0..3] of byte = (
end
else
FWriter.write(go32v2stub,sizeof(go32v2stub));
{ COFF header }
{ Initial header, will be updated later }
fillchar(header,sizeof(header),0);
header.mach:=COFF_MAGIC;
header.nsects:=nsects;
header.sympos:=sympos;
header.syms:=nsyms;
if hassymbols then
header.syms:=nsyms;
if win32 then
header.opthdr:=sizeof(tcoffpeoptheader)
else
@ -2137,21 +2163,21 @@ const pemagic : array[0..3] of byte = (
if win32 then
begin
header.flag:=PE_FILE_EXECUTABLE_IMAGE or PE_FILE_LINE_NUMS_STRIPPED;
if target_info.system in [system_i386_win32,system_arm_wince,system_i386_wince] then
header.flag:=header.flag or PE_FILE_32BIT_MACHINE;
if IsSharedLibrary then
header.flag:=header.flag or PE_FILE_DLL;
if FindExeSection('.reloc')=nil then
header.flag:=header.flag or PE_FILE_RELOCS_STRIPPED;
if FindExeSection('.stab')=nil then
if (FindExeSection('.stab')=nil) and
(FindExeSection('.debug_info')=nil) and
(FindExeSection('.gnu_debuglink')=nil) then
header.flag:=header.flag or PE_FILE_DEBUG_STRIPPED;
if (cs_link_strip in current_settings.globalswitches) then
if not hassymbols then
header.flag:=header.flag or PE_FILE_LOCAL_SYMS_STRIPPED;
end
else
header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_EXE or COFF_FLAG_NORELOCS or COFF_FLAG_NOLINES;
if target_info.system in [system_i386_win32,system_arm_wince,system_i386_wince] then
header.flag:=header.flag or PE_FILE_32BIT_MACHINE;
FWriter.write(header,sizeof(header));
{ Optional COFF Header }
if win32 then
@ -2224,17 +2250,14 @@ const pemagic : array[0..3] of byte = (
{ Section data }
ExeSectionList.ForEachCall(@ExeSectionList_write_data,nil);
{ Optional Symbols }
if not(cs_link_strip in current_settings.globalswitches) then
begin
if SymPos<>FWriter.Size then
internalerror(200602252);
{ ObjSymbols }
ExeSymbolList.ForEachCall(@globalsyms_write_symbol,nil);
{ Strings }
i:=FCoffStrs.size+4;
FWriter.write(i,4);
FWriter.writearray(FCoffStrs);
end;
if SymPos<>FWriter.Size then
internalerror(200602252);
if hassymbols then
ExeSymbolList.ForEachCall(@globalsyms_write_symbol,nil);
{ Strings }
i:=FCoffStrs.size+4;
FWriter.write(i,4);
FWriter.writearray(FCoffStrs);
{ Release }
FCoffStrs.Free;
FCoffSyms.Free;
@ -2376,7 +2399,7 @@ const pemagic : array[0..3] of byte = (
secname,
num : string;
absordnr: word;
procedure WriteTableEntry;
var
ordint: dword;
@ -2583,7 +2606,7 @@ const pemagic : array[0..3] of byte = (
end;
procedure TPECoffexeoutput.CalcPos_ExeSection(const aname:string);
procedure TPECoffexeoutput.MemPos_ExeSection(const aname:string);
begin
if aname='.reloc' then
GenerateRelocs;

4
compiler/ppu.pas
View File

@ -786,8 +786,8 @@ begin
bufstart:=sizeof(tppuheader);
bufidx:=0;
{reset}
crc:=cardinal($ffffffff);
interface_crc:=cardinal($ffffffff);
crc:=0;
interface_crc:=0;
do_interface_crc:=true;
Error:=false;
do_crc:=true;

4
compiler/symdef.pas
View File

@ -774,7 +774,7 @@ implementation
if (newlen-oldlen>12) and
((newlen+length(prefix)>128) or (newlen-oldlen>32)) then
begin
crc:=$ffffffff;
crc:=0;
for i:=0 to tprocdef(st.defowner).paras.count-1 do
begin
hp:=tparavarsym(tprocdef(st.defowner).paras[i]);
@ -3336,7 +3336,7 @@ implementation
if (newlen-oldlen>12) and
((newlen>128) or (newlen-oldlen>64)) then
begin
crc:=$ffffffff;
crc:=0;
for i:=0 to paras.count-1 do
begin
hp:=tparavarsym(paras[i]);

4
compiler/systems/t_win.pas
View File

@ -336,7 +336,7 @@ implementation
end;
end;
end;
begin
objdata:=CreateObjData(cut_normal);
if not isvar then
@ -1050,7 +1050,7 @@ implementation
Concat(' OBJSECTION .idata$6*');
Concat(' OBJSECTION .idata$7*');
Concat('ENDEXESECTION');
secnames:='.edata,.rsrc,.reloc,'+
secnames:='.edata,.rsrc,.reloc,.gnu_debuglink,'+
'.debug_aranges,.debug_pubnames,.debug_info,.debug_abbrev,.debug_line,.debug_frame,.debug_str,.debug_loc,'+
'.debug_macinfo,.debug_weaknames,.debug_funcnames,.debug_typenames,.debug_varnames,.debug_ranges';
repeat