/* C style Malloc & Free: cMalloc & cFree
USAGE:
   require(MallocLib); /* only loads once; defines MallocLibClass$Inst *
   cPtr := cMalloc( MallocLibClass$Inst, 200 ) ; /* returns pointer or 0 *
   cFree( MallocLibClass$Inst, cPtr) ;           /* frees a malloc'ed ptr *
 */!!

inherit(ProvidedLibs, #MallocLib, nil, 2, nil)!!

now(class(MallocLib))!!

/* semiPRIVATE -- should only be called via require(MallocLib)
   Define entry points and load library.  Define any structs required.
*/
Def provide(self, path)
{
  ^initialise( new(self:ancestor), path )
}
!!

now(MallocLib)!!

/* 9/10/1992 11:32 - PUBLIC
  Return the heap information according to mode.
  if convetToStr = #true then the result is a text string, else
    return number of bytes actively allocated
*/
Def heapDump(self, convertToStr | memAlloc, memFree, memActive )
{ 
  memAlloc := new(Struct, 4);
  memFree  := new(Struct, 4);
  
  if pcallLock(self)
  then
    lastError := pcall( procs[#HEAPDUMP], memAlloc, memFree);
    pcallUNLock(self);
  else 
    lastError := ERR_PCALL_RECURSION ;
  endif ;

  if (lastError <> GOOD) then
    displayError(ErrorTextLibClass$Inst, lastError, CHECK_MODE);
    if convertToStr then ^"Error"; else ^0; endif;
  endif;
  
  memActive := (longAt(memAlloc, 0) - longAt(memFree, 0));
  if convertToStr then
    ^"Mem Active: "+asString(memActive);  
  endif;
  ^memActive;
}
!!

/* PRIVATE
   Define all entry points for library as prototypes.
*/
Def addImportProcs(self)
{
  add( self , #INITCSERVER,   1, #(0, 0) ) ;
  add( self , #TMALLOC,       1, #(1) ) ;
  add( self , #TFREE,         1, #(1) ) ;
  add( self , #HEAPDUMP,      1, #(1, 1) );
}!!

/* PUBLIC */
Def cFree(self, cPointer | err)
{
  if pcallLock(self) then
    err := pcall( procs[#TFREE], asLong(cPointer) );
    pcallUNLock(self);
  else 
    err := ERR_PCALL_RECURSION ;
  endif ;
  
  if (err <> GOOD)
    displayError(ErrorTextLibClass$Inst, err,FORCE_POPUP);
  endif;  
  ^err;
}
!!

/* PUBLIC */
Def cMalloc(self, numBytes | ptr)
{
  if pcallLock(self)
  then
    ptr := pcall( procs[#TMALLOC], asLong(numBytes) );
    pcallUNLock(self);
  else 
    ptr := 0 /* ERR_PCALL_RECURSION - NULL pointer */ ;
  endif ;

  /* NOTES: positive ptr is valid pointer, not error code return.  
  ** Should other error check be done? Server already handled.
  ** displayError(ErrorTextLibClass$Inst,rc,FORCE_POPUP);
  */

  ^ptr;
}
!!

/* PRIVATE 
   Open and initialize variable server library & load trigger dll
*/
Def initialise(self, path)
{
   setName( self, path ) ;
   addImportProcs( self ) ;
   load( self ) ;  /* raises alert if fails: alert(System, self, #libLoad) */
}
!!
