unit uHeapStatus;

interface

uses Rubies;

{
  THeapStatus = record
    TotalAddrSpace: Cardinal;
    TotalUncommitted: Cardinal;
    TotalCommitted: Cardinal;
    TotalAllocated: Cardinal;
    TotalFree: Cardinal;
    FreeSmall: Cardinal;
    FreeBig: Cardinal;
    Unused: Cardinal;
    Overhead: Cardinal;
    HeapErrorCode: Cardinal;
  end;
}
var
  sHeapStatus: Tvalue;

procedure Init_HeapStatus;

implementation

uses uStrUtils, uDefUtils, uPhi, uConv;

function HeapStatus_alloc(real: THeapStatus): Tvalue;
var
  ary: Tvalue;
begin
  ary := rb_ary_new;
  rb_ary_push(ary, INT2FIX(real.TotalAddrSpace));
  rb_ary_push(ary, INT2FIX(real.TotalUncommitted));
  rb_ary_push(ary, INT2FIX(real.TotalCommitted));
  rb_ary_push(ary, INT2FIX(real.TotalAllocated));
  rb_ary_push(ary, INT2FIX(real.TotalFree));
  rb_ary_push(ary, INT2FIX(real.FreeSmall));
  rb_ary_push(ary, INT2FIX(real.FreeBig));
  rb_ary_push(ary, INT2FIX(real.Unused));
  rb_ary_push(ary, INT2FIX(real.Overhead));
  rb_ary_push(ary, INT2FIX(real.HeapErrorCode));
  result := rb_struct_alloc(sHeapStatus, ary);
end;

function Phi_heap_status(This: Tvalue): Tvalue; cdecl;
begin
  result := HeapStatus_alloc(GetHeapStatus);
end;

const
  props: array[0..9] of PChar = (
    'TotalAddrSpace',
    'TotalUncommitted',
    'TotalCommitted',
    'TotalAllocated',
    'TotalFree',
    'FreeSmall',
    'FreeBig',
    'Unused',
    'Overhead',
    'HeapErrorCode'
  );

procedure Init_HeapStatus;
var
  ary: Tvalue;
  i: Integer;
begin
  ary := rb_ary_new;
  rb_ary_push(ary, rb_str_new2('HeapStatus'));
  for i := low(props) to high(props) do
    rb_ary_push(ary, ap_String(LowerCase1(props[i])));
  sHeapStatus := rb_apply(ap_cStruct, rb_intern('new'), ary);
  rb_global_variable(@sHeapStatus);

  DefineModuleAttrGet(mPhi, 'heap_status', Phi_heap_status);
end;

end.
