mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 08:30:54 +02:00
sinclairql: when linking with vlink, generate an unrelocated binary with appended relocation info, so the startup code can relocate it
git-svn-id: trunk@47347 -
This commit is contained in:
parent
47066f0ce7
commit
954123deb3
@ -35,6 +35,7 @@ type
|
||||
private
|
||||
Origin: DWord;
|
||||
UseVLink: boolean;
|
||||
ExeLength: longint;
|
||||
function WriteResponseFile(isdll: boolean): boolean;
|
||||
procedure SetSinclairQLInfo;
|
||||
function MakeSinclairQLExe: boolean;
|
||||
@ -54,7 +55,7 @@ implementation
|
||||
|
||||
|
||||
const
|
||||
DefaultOrigin = $20000;
|
||||
DefaultOrigin = $0;
|
||||
|
||||
|
||||
constructor TLinkerSinclairQL.Create;
|
||||
@ -83,7 +84,7 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
ExeCmd[1]:='vlink -b rawbin1 $FLAGS $GCSECTIONS $OPT $STRIP -o $EXE -T $RES';
|
||||
ExeCmd[1]:='vlink -b rawseg -q $FLAGS $GCSECTIONS $OPT $STRIP -o $EXE -T $RES';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -105,10 +106,8 @@ end;
|
||||
function TLinkerSinclairQL.WriteResponseFile(isdll: boolean): boolean;
|
||||
var
|
||||
linkres : TLinkRes;
|
||||
i : longint;
|
||||
HPath : TCmdStrListItem;
|
||||
s : string;
|
||||
linklibc : boolean;
|
||||
begin
|
||||
WriteResponseFile:=False;
|
||||
|
||||
@ -177,9 +176,13 @@ begin
|
||||
Add('SECTIONS');
|
||||
Add('{');
|
||||
Add(' . = 0x'+hexstr(Origin,8)+';');
|
||||
Add(' .text : { *(.text .text.* _CODE _CODE.* ) }');
|
||||
Add(' .data : { *(.data .data.* .rodata .rodata.* .fpc.* ) }');
|
||||
Add(' .bss : { *(_BSS _BSS.*) *(.bss .bss.*) *(_BSSEND _BSSEND.*) *(_HEAP _HEAP.*) *(.stack .stack.*) *(_STACK _STACK.*) }');
|
||||
Add(' .text : {');
|
||||
Add(' _stext = .;');
|
||||
Add(' *(.text .text.* _CODE _CODE.* ) ');
|
||||
Add(' *(.data .data.* .rodata .rodata.* .fpc.* ) ');
|
||||
Add(' *(_BSS _BSS.*) *(.bss .bss.*) *(_BSSEND _BSSEND.*) *(_HEAP _HEAP.*) *(.stack .stack.*) *(_STACK _STACK.*) ');
|
||||
Add(' _etext = .;');
|
||||
Add(' }');
|
||||
Add('}');
|
||||
end;
|
||||
|
||||
@ -200,6 +203,9 @@ var
|
||||
GCSectionsStr : string;
|
||||
FlagsStr : string;
|
||||
ExeName: string;
|
||||
fd,fs: file;
|
||||
buf: pointer;
|
||||
bufread,bufsize: longint;
|
||||
begin
|
||||
StripStr:='';
|
||||
GCSectionsStr:='';
|
||||
@ -213,12 +219,10 @@ begin
|
||||
if UseVLink then
|
||||
begin
|
||||
if create_smartlink_sections then
|
||||
GCSectionsStr:='-gc-all -sc';
|
||||
GCSectionsStr:='-gc-all';
|
||||
end;
|
||||
|
||||
ExeName:=current_module.exefilename;
|
||||
if apptype = app_gui then
|
||||
Replace(ExeName,target_info.exeext,'.prg');
|
||||
|
||||
{ Call linker }
|
||||
SplitBinCmd(Info.ExeCmd[1],BinStr,CmdStr);
|
||||
@ -232,12 +236,57 @@ begin
|
||||
Replace(cmdstr,'$DYNLINK',DynLinkStr);
|
||||
|
||||
MakeSinclairQLExe:=DoExec(BinStr,CmdStr,true,false);
|
||||
|
||||
{ Kludge:
|
||||
With the above linker script, vlink will produce two files,
|
||||
"exename. text" and "exename. text.rel text". The former is the
|
||||
binary itself, the second is the relocation info. Here we copy
|
||||
the two together. I'll try to get vlink to do this for me in the
|
||||
future. (KB) }
|
||||
if MakeSinclairQLExe then
|
||||
begin
|
||||
ExeLength:=0;
|
||||
bufsize:=16384;
|
||||
{$push}
|
||||
{$i-}
|
||||
buf:=GetMem(bufsize);
|
||||
assign(fd,exename);
|
||||
rewrite(fd,1);
|
||||
|
||||
assign(fs,exename+'. text');
|
||||
reset(fs,1);
|
||||
repeat
|
||||
blockread(fs,buf^,bufsize,bufread);
|
||||
blockwrite(fd,buf^,bufread);
|
||||
until eof(fs);
|
||||
close(fs);
|
||||
// erase(fs);
|
||||
|
||||
assign(fs,exename+'. text.rel text');
|
||||
reset(fs,1);
|
||||
repeat
|
||||
blockread(fs,buf^,bufsize,bufread);
|
||||
blockwrite(fd,buf^,bufread);
|
||||
until eof(fs);
|
||||
close(fs);
|
||||
// erase(fs);
|
||||
|
||||
ExeLength:=FileSize(fd);
|
||||
close(fd);
|
||||
{$pop}
|
||||
MakeSinclairQLExe:=not (ExeLength = 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TLinkerSinclairQL.MakeExecutable:boolean;
|
||||
const
|
||||
DefaultBootString = '10 $SYM=RESPR($BINSIZE):LBYTES"win1_$EXENAME",$SYM:CALL $SYM';
|
||||
var
|
||||
success : boolean;
|
||||
bootfile : TScript;
|
||||
ExeName: String;
|
||||
BootStr: String;
|
||||
begin
|
||||
if not(cs_link_nolink in current_settings.globalswitches) then
|
||||
Message1(exec_i_linking,current_module.exefilename);
|
||||
@ -251,6 +300,24 @@ begin
|
||||
if (success) and not(cs_link_nolink in current_settings.globalswitches) then
|
||||
DeleteFile(outputexedir+Info.ResName);
|
||||
|
||||
if (success) then
|
||||
begin
|
||||
ExeName:=current_module.exefilename;
|
||||
BootStr:=DefaultBootString;
|
||||
|
||||
Replace(BootStr,'$BINSIZE',tostr(ExeLength)); { FIX ME }
|
||||
Replace(BootStr,'$EXENAME',ExeName);
|
||||
|
||||
Replace(ExeName,target_info.exeext,'');
|
||||
Replace(BootStr,'$SYM',ExeName);
|
||||
|
||||
{ Write bootfile }
|
||||
bootfile:=TScript.Create(outputexedir+ExeName);
|
||||
bootfile.Add(BootStr);
|
||||
bootfile.writetodisk;
|
||||
bootfile.Free;
|
||||
end;
|
||||
|
||||
MakeExecutable:=success; { otherwise a recursive call to link method }
|
||||
end;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user