/* This class describes memory objects allocated by the system
global heap memory manager. */!!

inherit(MemoryObject, #Handle,
#(handle  /* global heap memory handle */
address /* non-nil if locked */
length  /* actual length of allocated memory */), 2, nil)!!

now(class(Handle))!!

/* Create a new Handle with the given handle value. */
Def set(self, h)
{ ^setHandle(new(self), h);
}!!

now(Handle)!!

/* Return the address of the block.  Locks it
  if not already locked. */
Def addr(self)
{ if not(address)
  then lock(self);
  endif;
  ^address;
}!!

/* Allocate a global memory block of the given type and
  length, and store its information. */
Def alloc(self, flags, len)
{ if handle cor (handle := Call GlobalAlloc(flags, len)) == 0
  then alert(System, self, #allocError);
  endif;
  length := len;
}!!

/* Return global heap handle.  Will return nil
 if memory not allocated. */
Def asHandle(self)
{ ^handle;
}!!

/* Return an Actor object representing the
  contents of this memory block as a string. */
Def asString(self)
{ ^asString(asStruct(self));
}!!

/* Return an Actor object representing the
  contents of this memory block as a struct. */
Def asStruct(self | str)
{ str := new(Struct, length cor 0);
  if length
  then
    if not(address)
    then lock(self);
      copyFromLong(str, address);
      unlock(self);
    else copyFromLong(str, address);
    endif;
  endif;
  ^str;
}!!

/* Returns the byte value at the specified byte offset.
  Locks the handle temporarily if not already locked. */
Def byteAt(self, idx | val)
{ checkHandle(self);
  if idx >= length
  then alert(System, self, #rangeError)
  endif;
  if address
  then ^byteAt(address+asLong(idx));
  endif;
  lock(self);
  val := byteAt(address+asLong(idx));
  unlock(self);
  ^val;
}!!

/* Check that memory has been
 allocated.  If not then error. */
Def checkHandle(self)
{ if not(handle) cor (handle = 0)
  then alert(System, self, #nilHandleError)
  endif;
}!!

/* Copies a ByteCollection into receiver, adjusts length of receiver if 
  required. */
Def copyInto(self, buffer | sz)
{ checkHandle(self);
  sz := size(buffer);
  if (length < sz)
  then reAlloc(self, 0, sz);
  endif;
  if address
  then memCopy(address, 0, sz, buffer, 0, sz);
  else memCopy(addr(self), 0, sz, buffer, 0, sz);
    unlock(self);
  endif;
}!!

/* Store a word value at the specified byte offset.  This method
 assumes that the receiver's memory had been previously
 locked in the global heap.  Not doing so will produce unknown
 results, possibly catastrophic in nature. */
Def fastPutWord(self, val, idx)
{ ^putWord(address+asLong(idx), val);
}!!

/* Returns the word value at the specified index.  This method
 assumes that the receiver's memory had been previously
 locked in the global heap.  Not doing so will produce unknown
 results, possibly catastrophic in nature. */
Def fastWordAt(self, idx | val)
{ ^wordAt(address+asLong(idx));
}!!

/* Return a new fixed handle. */
Def fixed(self, len)
{ ^alloc(self, GMEM_ZEROINIT + GMEM_FIXED, len);
}!!

/* Free the handle, returning true if freed. */
Def free(self)
{ checkHandle(self);
  if Call GlobalFree(handle) = 0
  then handle := length := address := nil;
  else ^nil;
  endif;
}!!

/* Return global heap handle. */
Def handle(self)
{ ^handle;
}!!

/* Return actual length of allocated memory.  If memory
 was not allocated nil is returned.  Otherwise the actual
 length is returned.  This lenght may be greater than or
 equal to the size requested when the memory was
 allocated but never less.  This is a function of how
 Windows allocates memory in the global heap. */
Def length(self | sz)
{ ^(handle cand ((sz := Call GlobalSize(handle)) > 0)) cand sz;
}!!

/* Lock the handle, returning the long address. */
Def lock(self)
{ checkHandle(self);
  if not(address)
  then address := Call GlobalLock(handle);
  endif;
  if (address = 0)
  then alert(System, self, #lockError);
    address := nil;
  endif;
  ^address
}!!

/* Reallocate a global memory block of the given type and
 length, and store its information. */
Def reAlloc(self, flags, len | tHandle)
{ if not(handle) cor
    ((tHandle := Call GlobalReAlloc(handle, len, flags)) == 0)
  then alert(System, self, #reAllocError);
  endif;
  handle := tHandle;
  length := len;
}

/* Allocate moveable memory from non-banked portion
 of Windows global heap. */
Def lower(self, len)
{ ^alloc(self, GMEM_ZEROINIT + GMEM_MOVEABLE + 0x1000, len);
}!!

/* Return a new moveable handle. */
Def moveable(self, len)
{ ^alloc(self, GMEM_ZEROINIT + GMEM_MOVEABLE, len);
}!!

/* Store a byte value at the indicated byte offset. */
Def putByte(self, val, idx)
{ checkHandle(self);
  if idx >= length
  then alert(System, self, #rangeError)
  endif;
  if address
  then ^putByte(address+asLong(idx), val);
  endif;
  lock(self);
  val := putByte(address+asLong(idx), val);
  unlock(self);
  ^val;
}!!

/* Store a word value at the indicated byte offset. */
Def putWord(self, val, idx)
{ checkHandle(self);
  if idx >= length
  then alert(System, self, #rangeError)
  endif;
  if address
  then ^putWord(address+asLong(idx), val);
  endif;
  lock(self);
  val := putWord(address+asLong(idx), val);
  unlock(self);
  ^val;
}!!

/* Set the handle. */
Def setHandle(self, h)
{ handle := h;
  length := Call GlobalSize(h);
}!!

/* Return a new shared-memory handle. */
Def shared(self, len)
{ ^alloc(self, GMEM_ZEROINIT + GMEM_MOVEABLE + 0x2000, len);
}!!

/* Return actual length of allocated memory.  Same as
 sending length message. */
Def size(self)
{ ^length;
}!!

/* Print Handle object to specified stream. */
Def sysPrintOn(self, stream)
{ printOn(class(self), stream);
  printOn(tuple('(', handle, ')'), stream);
}!!

/* Unlock the handle, returning true if ref count goes to 0. */
Def unlock(self)
{ checkHandle(self);
  if ((Call GlobalFlags(handle) bitAnd 0xFF) = 0) cor
    (Call GlobalUnlock(handle) = 0)
  then address := nil;
  else ^nil;
  endif;
}!!

/* Returns the word value at the specified index.  Note
  that the index is a byte offset, i.e. at(handle, 2)
  returns the word located at byte offset 2.  Locks the
  handle temporarily if not already locked. */
Def wordAt(self, idx | val)
{ checkHandle(self);
  if idx >= length
  then alert(System, self, #rangeError)
  endif;
  if address
  then ^wordAt(address+asLong(idx));
  endif;
  lock(self);
  val := wordAt(address+asLong(idx));
  unlock(self);
  ^val;
}!!
