mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-01 12:30:20 +02:00
+ added support for HeapMax in the far data i8086 memory models as well
git-svn-id: trunk@28051 -
This commit is contained in:
parent
3952f8830c
commit
9f31fcc2ca
@ -36,7 +36,7 @@ implementation
|
|||||||
cutils,cfileutl,cclasses,
|
cutils,cfileutl,cclasses,
|
||||||
globtype,globals,systems,verbose,script,
|
globtype,globals,systems,verbose,script,
|
||||||
fmodule,i_msdos,
|
fmodule,i_msdos,
|
||||||
link,aasmbase;
|
link,aasmbase,cpuinfo;
|
||||||
|
|
||||||
type
|
type
|
||||||
{ Borland TLINK support }
|
{ Borland TLINK support }
|
||||||
@ -63,6 +63,7 @@ implementation
|
|||||||
TExternalLinkerMsDosWLink=class(texternallinker)
|
TExternalLinkerMsDosWLink=class(texternallinker)
|
||||||
private
|
private
|
||||||
Function WriteResponseFile(isdll:boolean) : Boolean;
|
Function WriteResponseFile(isdll:boolean) : Boolean;
|
||||||
|
Function PostProcessExecutable(const fn:string) : Boolean;
|
||||||
public
|
public
|
||||||
constructor Create;override;
|
constructor Create;override;
|
||||||
procedure SetDefaultInfo;override;
|
procedure SetDefaultInfo;override;
|
||||||
@ -326,6 +327,10 @@ begin
|
|||||||
Replace(cmdstr,'$OPT',Info.ExtraOptions);
|
Replace(cmdstr,'$OPT',Info.ExtraOptions);
|
||||||
success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false);
|
success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false);
|
||||||
|
|
||||||
|
{ Post process }
|
||||||
|
if success then
|
||||||
|
success:=PostProcessExecutable(current_module.exefilename);
|
||||||
|
|
||||||
{ Remove ReponseFile }
|
{ Remove ReponseFile }
|
||||||
if (success) and not(cs_link_nolink in current_settings.globalswitches) then
|
if (success) and not(cs_link_nolink in current_settings.globalswitches) then
|
||||||
DeleteFile(outputexedir+Info.ResName);
|
DeleteFile(outputexedir+Info.ResName);
|
||||||
@ -333,6 +338,47 @@ begin
|
|||||||
MakeExecutable:=success; { otherwise a recursive call to link method }
|
MakeExecutable:=success; { otherwise a recursive call to link method }
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ In far data memory models, this function sets the MaxAlloc value in the DOS MZ
|
||||||
|
header according to the difference between HeapMin and HeapMax. We have to do
|
||||||
|
this manually, because WLink sets MaxAlloc to $FFFF and there seems to be no
|
||||||
|
way to specify a different value with a linker option. }
|
||||||
|
function TExternalLinkerMsDosWLink.PostProcessExecutable(const fn: string): Boolean;
|
||||||
|
var
|
||||||
|
f: file;
|
||||||
|
minalloc,maxalloc: Word;
|
||||||
|
heapmin_paragraphs, heapmax_paragraphs: Integer;
|
||||||
|
begin
|
||||||
|
{ nothing to do in the near data memory models }
|
||||||
|
if current_settings.x86memorymodel in x86_near_data_models then
|
||||||
|
exit(true);
|
||||||
|
{ .COM files are not supported in the far data memory models }
|
||||||
|
if apptype=app_com then
|
||||||
|
internalerror(2014062501);
|
||||||
|
{ open file }
|
||||||
|
assign(f,fn);
|
||||||
|
{$push}{$I-}
|
||||||
|
reset(f,1);
|
||||||
|
if ioresult<>0 then
|
||||||
|
Message1(execinfo_f_cant_open_executable,fn);
|
||||||
|
{ read minalloc }
|
||||||
|
seek(f,$A);
|
||||||
|
BlockRead(f,minalloc,2);
|
||||||
|
if source_info.endian<>target_info.endian then
|
||||||
|
minalloc:=SwapEndian(minalloc);
|
||||||
|
{ calculate the additional number of paragraphs needed }
|
||||||
|
heapmin_paragraphs:=(heapsize + 15) div 16;
|
||||||
|
heapmax_paragraphs:=(maxheapsize + 15) div 16;
|
||||||
|
maxalloc:=min(minalloc-heapmin_paragraphs+heapmax_paragraphs,$FFFF);
|
||||||
|
{ write maxalloc }
|
||||||
|
seek(f,$C);
|
||||||
|
if source_info.endian<>target_info.endian then
|
||||||
|
maxalloc:=SwapEndian(maxalloc);
|
||||||
|
BlockWrite(f,maxalloc,2);
|
||||||
|
close(f);
|
||||||
|
{$pop}
|
||||||
|
if ioresult<>0 then;
|
||||||
|
Result:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
Initialize
|
Initialize
|
||||||
|
Loading…
Reference in New Issue
Block a user