unit vstack;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}
(***************************************)
(* Copyright (C) 2003, SHIRAISHI Kazuo *)
(***************************************)

interface
function getmemory(size:NativeInt):pointer;
procedure freememory(size:NativeInt);
procedure InitMemory;
implementation
uses
{$IFDEF LINUX}
   baseunix,unix,unixtype,unixutil,linux,
{$ENDIF}
   base ;
var
  StackBase:pointer;
  StackBottom:pointer;
  StackLimit:pointer;
function getmemory(size:NativeInt):pointer;
begin
  if NativeInt(StackLimit)-NativeInt(StackBottom)<size then
                   setexception(VirtualStackOverflow);
  GetMemory:=StackBottom;
  Inc(StackBottom,size);
end;
procedure freememory(size:NativeInt);
begin
  Dec(StackBottom,size);
end;
procedure InitMemory;
begin
  StackBottom:=StackBase
end;

var
  {$IFDEF CPU64}
   StackSize:NativeInt=$C0000000; {3GB}
  {$ELSE}
   StackSize:Cardinal=$2000000;  {32MB}
  {$ENDIF}
{$IFDEF LINUX}
function PhysMemory:int64;
var
   Info : TSysInfo;
begin
  if SysInfo(@Info)<>0 then
     result:=Info.totalram
  else
     result:=0;
end;
procedure setMaxStackSize;
begin
  StackSize:= $2000000  {32MB} ;
  if physmemory>$24000000 {512MB+64MB} then
      stacksize:= $20000000 {512MB}
  else if physmemory>=$6000000 {32MB+64MB} then
      stacksize:=physmemory-$4000000 {64MB}
end;
{$ENDIF}
procedure ReadIniFile;
var
   IniFile:TMyIniFile;
begin
  IniFile:=TMyIniFile.create('Frame');
  with IniFile do
    begin
      StackSize:=ReadInteger('VirtualMemory',StackSize div $100000) * $100000;
      free;
    end;
  {$IFDEF CPU32}
  if StackSize> $40000000 {1GB} then StackSize:=$40000000;
  {$ENDIF}
end;
initialization
{$IFDEF LINUX}
 setmaxstacksize;
 ReadIniFile;
 StackBase:=fpmmap(nil, StackSize, PROT_READ or PROT_WRITE
                  , MAP_PRIVATE or MAP_ANONYMOUS, 0, 0);
 while StackBase=MAP_FAILED do
    begin
       dec(StackSize, $4000000{64MB});
       StackBase:=fpmmap(nil, StackSize, PROT_READ or PROT_WRITE
                          , MAP_PRIVATE or MAP_ANONYMOUS, 0, 0);
    end;
  //if StackBase=MAP_FAILED then
  //   SetException(TooLargeVirtualStack);
{$ELSE}
 GetMem(StackBase,StackSize);
{$ENDIF}
 StackBottom:=StackBase;
 StackLimit:=StackBase;
 Inc(StackLimit,StackSize);

finalization
{$IFDEF LINUX}
{$ELSE}
 FreeMem(stackBase,StackSize);
{$ENDIF}
end.
