瀏覽代碼

+ added support for HeapMax in the far data i8086 memory models as well

git-svn-id: trunk@28051 -
nickysn 11 年之前
父節點
當前提交
9f31fcc2ca
共有 1 個文件被更改,包括 47 次插入1 次删除
  1. 47 1
      compiler/systems/t_msdos.pas

+ 47 - 1
compiler/systems/t_msdos.pas

@@ -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