"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

ArrayedCollection subclass:#ExternalBytes

	instanceVariableNames:'address* size'

	classVariableNames:'AllocatedInstances Lobby DebugMalloc TraceMalloc'

	poolDictionaries:''

	category:'System-Support'

!

!ExternalBytes primitiveFunctions!

%{

struct mallocList {

	char *chunk;

	unsigned size;

	struct mallocList *next;

};

static struct mallocList *mallocList = (struct mallocList *)0;

static mallocCount = 0;

char *

__stx_malloc(nBytes) {

	char *ptr;

	char *malloc();

	struct mallocList *e, *this;

	int found;

	ptr = malloc(nBytes);

	if (@global(TraceMalloc) == true) {

	    printf("EXTBYTES: allocated %d bytes at: %08x\n", nBytes, ptr);

	}

	if (@global(DebugMalloc) == true) {

	    if (ptr) {

		found = 0;

		for (this=mallocList; this; this=this->next) {

		    if (this->chunk == ptr) {

			printf("EXTBYTES: **** %08x already allocated (freed somewhere else ?)\n", ptr);

			found++;

		    }

		}

		if (! found) {

		    e = (struct mallocList *) malloc(sizeof(struct mallocList));

		    e->next = mallocList;

		    e->chunk = ptr;

		    e->size = nBytes;

		    mallocList = e;

		    mallocCount++;

		}

	    }

	}

	return ptr;

}

char *

__stx_calloc(n, size) {

	char *ptr;

	ptr = __stx_malloc(n * size);

	if (ptr != (char *)0) {

	    bzero(ptr, (n * size));

	}

	return ptr;

}

char *

__stx_realloc(ptr, nBytes)

    char *ptr;

{

	char *newPtr;

	char *realloc(), *malloc();

	struct mallocList *this, *prev, *next, *e;

	int foundOld, foundNew;

	newPtr = realloc(ptr, nBytes);

	if (@global(TraceMalloc) == true) {

	    printf("EXTBYTES: reallocated %d bytes for %08x at: %08x\n", nBytes, ptr, newPtr);

	}

	if (@global(DebugMalloc) == true) {

	    if (newPtr) {

		foundNew = 0;

		for (this=mallocList; this; this=this->next) {

		    if (this->chunk == newPtr) {

			printf("EXTBYTES: **** %08x already allocated (freed somewhere else ?)\n", newPtr);

			foundNew = 1;

		    }

		}

	    }

	    if (ptr) {

		foundOld = 0;

		for (this=mallocList, prev=0; this; this=next) {

		    next = this->next;

		    if (this->chunk == ptr) {

			if (prev) {

			    prev->next = next;

			} else {

			    mallocList = next;

			}

			free(this);

			foundOld++;

		    } else {

			prev = this;

		    }

		}

		if (! foundOld) {

		    printf("EXTBYTES: **** realloc alien %x (allocated somewhere else ?)\n", ptr);

		}

	    }

	    if (! foundNew) {

		e = (struct mallocList *) malloc(sizeof(struct mallocList));

		e->next = mallocList;

		e->chunk = newPtr;

		e->size = nBytes;

		mallocList = e;

		if (! ptr) {

		    mallocCount++;

		}

	    }

	}

	return newPtr;

}

__stx_free(ptr)

    char *ptr;

{

	struct mallocList *this, *prev, *next;

	int found;

	if (@global(TraceMalloc) == true) {

	    printf("EXTBYTES: free bytes at: %08x\n", ptr);

	}

	if (@global(DebugMalloc) == true) {

	    if (ptr) {

		found = 0;

		for (this=mallocList, prev=0; this; this=next) {

		    next = this->next;

		    if (this->chunk == ptr) {

			if (prev) {

			    prev->next = next;

			} else {

			    mallocList = next;

			}

			free(this);

			found++;

			mallocCount--;

		    } else {

			prev = this;

		    }

		}

		if (! found) {

		    printf("EXTBYTES: **** free: alien %x (allocated somewhere else ?))\n", ptr);

		}

	    }

	}

	return free(ptr);

}

%}

! !

!ExternalBytes class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    This class provides access to any memory in the system. Its main purpose

    is to provide a baseclass for objects referencing structured external data. 

    Normally, instances are created by primitive code which wants to pass C-data

    to Smalltalk AND grants smalltalk access to individual bytes afterwards.

    Primitives which do not want to grant this access should return instances of

    ExternalAddress. See more info there. Also, have a look at ExternalFunction

    which is another similar class, but specialized to represent callable C-functions.

    Since the memory address of an instance stays fixed (once allocated),

    it can also be used to share data with external C-parts 

    (which are not prepared for objects to change their address).

    Use with great care - access is not always checked for out-of-bounds 

    or valid addresses.

    Since the data is allocated outside the garbage collected smalltalk space,

    its address stays fix. Thus, it can be passed to external C-functions without

    any danger. However, you have to take care for freeing the memory yourself.

    To help in avoiding memory bugs, instances created with #new: are 

    registered in a local classvar and deregistered when the underlying memory

    is explicitely freed. Since a life reference (from that classvar) exists,

    the garbage collector will never find these to be reclaimable, and the

    underlying memory stays allocated (at a fix address) forever.

    To release the memory, either #free it or #unprotect it.

    The first will immediately release the memory, while the second will delay

    freeing until the next garbage collect occurs.

    If you need memory which is automatically freed, create

    the instance via #unprotectedNew: right away; the underlying malloced-memory

    will be released as soon as no smalltalk reference to the ExtBytes object

    exists any more (however, you have to know for sure, that no C-references

    exist to this memory).

    To release all memory call #releaseAllMemory which simply sets the 

    AllocatedInstances class variable to nil (thus releasing those refs).

    Example (automatic freeing as soon as ref to buffer is gone):

	|buffer|

	buffer := ExternalBytes unprotectedNew:100.

	...

    Example (manual freeing - never freed, if ref to buffer is gone):

	|buffer|

	buffer := ExternalBytes new:100.

	...

	buffer free

    Example (delayed automatic freeing as soon as ref to buffer is gone):

	|buffer|

	buffer := ExternalBytes new:100.

	...

	buffer unregister

    This class only supports unstructured external data 

    - see the companion class ExternalStructure for more.

    Notice: support for external data is still being developed -

	    a parser for C structure syntax and typedefs is on the way,

	    making shared data with C programs much easier in the future.

    Also notice, that this class may not be available or behave different

    in other smalltalk systems, making code using it very unportable.

    It is provided for C interfacing only.

    Finally note, that ST/X's memory system is much faster than malloc/free

    in the normal case - especially for short term temporary objects,

    automatically reclaimed object memory is about 5-10 times faster than

    malloc/free.

    Things may be different for huge byte-valued objects, which are to be

    reclaimed by the oldspace colletor. 

    Anyway, for portability, we strongly warn from using this as a substitute 

    for byteArrays; it is meant for shared data with external C-functions ONLY.

    Debugging: 

	since all manual memory systems are subject of obscure errors,

	you may want to turn malloc-tracing on; this traces all allocations/frees

	done here. To do this, evaluate: 'ExternalBytes mallocTrace:true'.

	In addition, you may turn on full debugging (with 'ExternalBytes mallocDebug:true');

	if turned on, all malloc/realloc requests are remembered and later free / realloc

	requests validated against this list (i.e. to detect freeing unallocated chunks).

	To benefit from this in C-code, we recommend you use __stx_malloc() / __stx_free()

	instead of malloc() / free(). To do so, redefine them in a header file (or cc comand line)

	and recompile your external c-libraries with this.

	I used this here to find memory leaks in the Xt libraries (there are still some in

	the HTML widget ...). If mallocDebug is on, #dumpMallocChunks will print out what is

	leftOver. This may help to find trouble spots in your C-code.

    [author:]

	Claus Gittinger

    [see also:]

	ExternalAddress ExternalFunction

	ByteArray

	( how to write primitive code :html: programming/primitive.html )

"

!

examples 

"

    These examples below are not directly executable;

    some require primitive code to be compiled, or are simply given

    as sceletton.

    Notice, that in C, indexing is 0-based, while in Smalltalk, indices start

    at 1.

    allocating memory in ST, passing it to C:

      in smalltalk:

	...

	bytes := ExternalBytes new:100.

	...

      in C (assuming that the bytes-object has been passed):

	...

	char *bytePtr;

	bytePtr = (char *)(__externalBytesAddress(bytes));

	if (bytePtr) {

	    ... do something with bytes at bytePtr ...

	}

      freeing (in ST):

	...

	bytes free.

	...

    allocating memory in C, passing it to ST:

      in C:

	...

	char *bytePtr;

	bytePtr = (char *)(malloc(100));

	...

	RETURN (__MKEXTERNALBYTES(bytePtr));

      in Smalltalk (extracting bytes, integers or strings):

	byteVal := bytes byteAt:1.

	...

	intVal := bytes doubleWordAt:1 MSB:true.

	...

	string := bytes stringAt:20.    

	...

"

! !

!ExternalBytes class methodsFor:'initialization'!

initialize

    Lobby isNil ifTrue:[

	Lobby := Registry new

    ]

! !

!ExternalBytes class methodsFor:'instance creation'!

address:aNumber

    "return a new ExternalBytes object to access bytes starting at aNumber.

     The memory at aNumber has been allocated elsewhere. The size is not known,

     therefore byte accesses will NOT be checked for valid index.

     Use this, if you get a pointer from some external source (such as a

     C-callBack function) and you have to extract bytes from that.

     DANGER ALERT: this method allows very bad things to be done to the

		   system - use with GREAT care (better: do not use it)"

    ^ self basicNew setAddress:aNumber size:nil

!

address:aNumber size:size

    "return a new ExternalBytes object to access bytes starting at aNumber.

     The memory at aNumber has been allocated elsewhere. The size is known,

     which allows byte accesses to be checked for valid index.

     Use this, if you get a pointer to a structure from some external source 

     (such as a C-callBack function) and you have to extract things from that.

     DANGER ALERT: this method allows very bad things to be done to the

		   system - use with GREAT care (better: do not use it)"

    ^ self basicNew setAddress:aNumber size:size 

!

new:numberOfBytes

    "allocate some memory usable for data;

     return a corresponding ExternalBytes object or nil (if malloc fails).

     Use this, if you have to pass a block of bytes to some 

     external destination (such as a C function) which does not copy the

     data, but instead keeps a reference to it. For example, many functions

     which expect strings simply keep a ref to the passed string - for those,

     an ST/X string-pointer is not the right thing to pass, since ST/X objects

     may change their address.

     DANGER ALERT: the memory is NOT automatically freed until it is either

		   MANUALLY freed (see #free) or the returned externalBytes object

		   is unprotected or the classes releaseAllMemory method is called."

    |newInst|

    newInst := self unprotectedNew:numberOfBytes.

    newInst protectFromGC.

    ^ newInst

    "

     |bytes|

     bytes := ExternalBytes new:100.

     bytes wordAt:1 put:1.

     bytes doubleWordAt:3 put:16r12345678.

     bytes inspect

    "

!

unprotectedNew:numberOfBytes

    "allocate some memory usable for data;

     return a corresponding ExternalBytes object or nil (if malloc fails).

     DANGER ALERT: the memory block as allocated will be automatically freed

		   as soon as the reference to the returned externalBytes object

		   is gone (by the next garbage collect).

		   If the memory has been passed to a C-function which 

		   remembers this pointer, bad things may happen ...."

    |newInst|

    newInst := self newForData:numberOfBytes.

    Lobby register:newInst.

    ^ newInst

! !

!ExternalBytes class methodsFor:'instance release'!

releaseAllMemory

    AllocatedInstances := nil

    "

     ... the next GC will get 'em

    "

! !

!ExternalBytes class methodsFor:'malloc debug'!

dumpMallocChunks

%{  /* NOCONTEXT */

    struct mallocList *entry;

    for (entry = mallocList; entry; entry=entry->next) {

	printf("  %08x (%d)\n", entry->chunk, entry->size);

    }

%}

!

freeAllMallocChunks

    "free all stx_malloc'd memory. Be careful, this does no validation at all;

     It simply walks through all chunks and frees them unconditionally.

     This may be helpful during debugging memory-leaks, to release memory which

     was not correctly freed by C-code. Howeve, only memory which was allocated

     by __stx_malloc() is freed here - so you better compile your primitive code with

     malloc redefined to stx_malloc.

     Also, mallocDebug has to be on to do this."

    "first free my own memory ..."

    self releaseAllMemory.

    ObjectMemory garbageCollect.

%{

    struct mallocList *entry;

    while ((entry = mallocList) != (struct mallocList *)0) {

	if (@global(TraceMalloc) == true ) {

	    printf("EXTBYTES: **** forced free of %08x (%d)\n", entry->chunk, entry->size);

	}

	__stx_free(entry->chunk);

    }

%}

!

mallocDebug:aBoolean

    DebugMalloc := aBoolean

    "

     ExternalBytes mallocDebug:true

     ExternalBytes mallocDebug:false 

    "

!

mallocTrace:aBoolean

    TraceMalloc := aBoolean

    "

     ExternalBytes mallocTrace:true

     ExternalBytes mallocTrace:false

    "

!

numberOfAllocatedChunks

%{  /* NOCONTEXT */

    RETURN ( __MKSMALLINT(mallocCount) );

%}

! !

!ExternalBytes class methodsFor:'private instance creation/release'!

newForData:numberOfBytes

    "allocate some memory usable for data;

     return a corresponding ExternalBytes object or nil (if malloc fails).

     This is a private entry - no setup for memory reclamation is done here."

    |addr|

%{

    char *space;

    unsigned long _addr = 0;

    unsigned int nBytes;

    char *__stx_malloc();

    /*

     * this one is not at all critical - simply return some space

     * to be used for data space of loaded-in binaries.

     */

    if (__isSmallInteger(numberOfBytes)) {

	nBytes = __intVal(numberOfBytes);

	if (nBytes > 0) {