unit vstack;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}

(***************************************)
(* Copyright (C) 2003, SHIRAISHI Kazuo *)
(***************************************)


interface

function getmemory(size:integer):pointer;
procedure freememory(size:integer);
procedure InitMemory;

implementation
{$IFDEF Linux}
{$IFDEF CPU32}
{$DEFINE Linux32}
{$ENDIF}
{$ENDIF}

uses
{$IFDEF LINUX32}
   baseunix,unix,unixtype,unixutil,linux,
{$ENDIF}
   base ;

var
  StackBase:pointer;
  StackBottom:pointer;
  StackLimit:pointer;

function getmemory(size:integer):pointer;
begin
  if NativeInt(StackLimit)-NativeInt(StackBottom)<size then
                   setexception(VirtualStackOverflow);
  GetMemory:=StackBottom;
  Inc(NativeInt(StackBottom),size);
end;

procedure freememory(size:integer);
begin
  Dec(NativeInt(StackBottom),size);
end;

procedure InitMemory;
begin
  StackBottom:=StackBase
end;


var
   StackSize:NativeUInt={$IFDEF CPU64} $10000000 {256MB} {$ELSE}$2000000 {32MB}{$ENDIF};

{$IFDEF Linux32}
procedure setMaxStackSize;
var
  pagesize, physpages:NativeInt;
  physmemory:int64;
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;
  if StackSize> $40000000 {1GB} then StackSize:=$40000000;
end;

initialization

{$IFDEF Linux32}

 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;

{$ELSE}
 GetMem(StackBase,StackSize);
{$ENDIF}
 StackBottom:=StackBase;
 NativeUInt(StackLimit):=NativeUInt(StackBase)+StackSize;


finalization
{$IFDEF Linux32}

{$ELSE}
 FreeMem(stackBase,StackSize);
{$ENDIF}

end.
