"
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
"
!
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) {
space = __stx_malloc(nBytes);
_addr = (unsigned long) space;
}
}
if (_addr > 0) {
if (_addr && (@global(TraceMalloc) == true)) {
printf("EXTBYTES: allocated %d bytes at: %08x\n", nBytes, _addr);
}
addr = __MKUINT(_addr);
}
%}.
addr isNil ifTrue:[
"
memory allocation failed
"
^ ObjectMemory mallocFailureSignal raise
].
^ self basicNew setAddress:addr size:numberOfBytes
!
newForText:numberOfBytes
"EXPERIMENTAL; do NEVER use this private method.
Allocate some memory usable to put machine executable instructions into;
return a corresponding ExternalBytes object or nil.
These bytes are NOT subject to garbage collection; therefore someone
must take care of freeing the memory when its no longer needed.
This method may not be available on all architectures
(i.e. those that do not allow allocating text-memory).
This is a private entry - no setup for memory reclamation is done here.
OBSOLETE: this method will vanish soon"
%{
#if ! defined(CAN_USE_DATA_FOR_TEXT)
/*
* this one should allocate some space, into which we can put
* some code to be executed. You are in bad luck, if running on
* a SepId machine or if data space cannot be executed.
* All you can do then, is to look for any OS-hooks and add more code here.
*/
#endif
%}.
"
assume data is ok for instructions as well ...
"
^ self newForData:numberOfBytes
! !
!ExternalBytes class methodsFor:'queries'!
isBuiltInClass
"return true if this class is known by the run-time-system.
Here, true is returned."
^ true
"Modified: 23.4.1996 / 15:57:50 / cg"
!
sizeofDouble
"return the number of bytes used by the machines native doubles"
%{ /* NOCONTEXT */
RETURN (__MKSMALLINT( sizeof(double)));
%}
"
ExternalBytes sizeofDouble
"
!
sizeofFloat
"return the number of bytes used by the machines native floats"
%{ /* NOCONTEXT */
RETURN (__MKSMALLINT( sizeof(float)));
%}
"
ExternalBytes sizeofFloat
"
!
sizeofInt
"return the number of bytes used by the machines native integer"
%{ /* NOCONTEXT */
RETURN (__MKSMALLINT( sizeof(int)));
%}
"
ExternalBytes sizeofInt
"
!
sizeofLong
"return the number of bytes used by the machines native longs"
%{ /* NOCONTEXT */
RETURN (__MKSMALLINT( sizeof(long)));
%}
"
ExternalBytes sizeofLong
"
!
sizeofPointer
"return the number of bytes used by the machines native pointer"
%{ /* NOCONTEXT */
RETURN (__MKSMALLINT( sizeof(char *)));
%}
"
ExternalBytes sizeofPointer
"
!
sizeofShort
"return the number of bytes used by the machines native short"
%{ /* NOCONTEXT */
RETURN (__MKSMALLINT( sizeof(short)));
%}
"
ExternalBytes sizeofShort
"
! !
!ExternalBytes methodsFor:'accessing'!
address
"return the start address as an integer"
%{ /* NOCONTEXT */
int addr;
if (__INST(address_) != nil) {
addr = (int)__INST(address_);
if (addr <= _MAX_INT) {
RETURN ( __MKSMALLINT(addr) );
}
RETURN ( __MKUINT(addr));
}
%}.
^ nil
!
basicAt:index
"return the byte at index, anInteger;
Indices are 1-based, therefore
this is the byte at (address + index - 1)"
%{ /* NOCONTEXT */
unsigned char *cp = (char *)(__INST(address_));
int idx;
if (cp && __isSmallInteger(index)) {
idx = __intVal(index);
if (idx > 0) {
if ((__INST(size) == nil)
|| (__intVal(__INST(size)) >= idx)) {
cp = cp + idx - 1;
RETURN ( __MKSMALLINT(*cp) );
}
}
}
%}.
(size notNil and:[self address notNil]) ifTrue:[
^ self subscriptBoundsError:index
].
"
invalid index or unallocated
"
self primitiveFailed
!
basicAt:index put:value
"set the byte at index, anInteger to value which must be 0..255.
Returns value (sigh).
Indices are 1-based, therefore
this is the byte at (address + index - 1)"
%{ /* NOCONTEXT */
unsigned char *cp = (char *)(__INST(address_));
int val;
int idx;
if (cp && __bothSmallInteger(index, value)) {
idx = __intVal(index);
if (idx > 0) {
if ((__INST(size) == nil)
|| (__intVal(__INST(size)) >= idx)) {
val = __intVal(value);
if ((val & ~0xFF) == 0) /* i.e. (val >= 0) && (val <= 255) */ {
cp[idx-1] = val;
RETURN ( value );
}
}
}
}
%}.
(size notNil and:[self address notNil]) ifTrue:[
^ self subscriptBoundsError:index
].
"
invalid index, invalid value or unallocated
"
self primitiveFailed
"Modified: 19.4.1996 / 11:15:05 / cg"
!
basicSize
"we do not know how many bytes are valid"
size isNil ifTrue:[^ 0].
^ size
!
byteAt:index
"return the unsigned byte at index, anInteger.
Indices are 1-based, therefore
this is the byte at (address + index - 1)"
^ self basicAt:index
!
byteAt:index put:aByteValuedInteger
"set the byte at index.
Indices are 1-based, therefore
this is the byte at (address + index - 1)"
^ self basicAt:index put:aByteValuedInteger
!
doubleWordAt:index
"return the unsigned long at index, anInteger. fetching in the machines natural byteorder.
Here, unaligned accesses are allowed - in C, this is usually an error."
^ self doubleWordAt:index MSB:(UninterpretedBytes isBigEndian)
!
doubleWordAt:index MSB:msb
"return the unsigned long at index, anInteger. fetching is MSB-first.
Here, unaligned accesses are allowed - in C, this is usually an error."
|val|
msb ifTrue:[
val := self at:index.
val := (val bitShift:8) + (self at:(index + 1)).
val := (val bitShift:8) + (self at:(index + 2)).
val := (val * 256) + (self at:(index + 3)).
] ifFalse:[
val := self at:index+3.
val := (val bitShift:8) + (self at:(index + 2)).
val := (val bitShift:8) + (self at:(index + 1)).
val := (val * 256) + (self at:(index)).
].
^ val
!
doubleWordAt:index put:aNumber
"set the long at index, index to aNumber; storing in the machines natural byteorder.
Here, unaligned accesses are allowed - in C, this is usually an error."
^ self doubleWordAt:index put:aNumber MSB:(UninterpretedBytes isBigEndian)
!
doubleWordAt:index put:aNumber MSB:msb
"set the long at index, index to aNumber; storing is MSB or LSB-first.
Here, unaligned accesses are allowed - in C, this is usually an error."
msb ifTrue:[
self at:index put:(aNumber digitAt:4).
self at:(index + 1) put:(aNumber digitAt:3).
self at:(index + 2) put:(aNumber digitAt:2).
self at:(index + 3) put:(aNumber digitAt:1).
] ifFalse:[
self at:index put:(aNumber digitAt:1).
self at:(index + 1) put:(aNumber digitAt:2).
self at:(index + 2) put:(aNumber digitAt:3).
self at:(index + 3) put:(aNumber digitAt:4).
].
^ aNumber
!
doubleWordAtDoubleWordIndex:index
"return the unsigned long at index, anInteger.
Fetching in the machines natural byte order.
Indices are 1-based and scaled as appropriate to allow
accessing the memory as an array of doubleWord entries.
(i.e. indices are 1, 2, ...)"
^ self doubleWordAtDoubleWordIndex:index MSB:(UninterpretedBytes isBigEndian)
!
doubleWordAtDoubleWordIndex:index MSB:msb
"return the unsigned long at index, anInteger.
Fetching is MSB if msb is true, LSB otherwise.
Indices are 1-based and scaled as appropriate to allow
accessing the memory as an array of doubleWord entries.
(i.e. indices are 1, 2, ...)"
^ self doubleWordAt:(index - 1 * 4 + 1) MSB:msb
!
doubleWordAtDoubleWordIndex:index put:value
"set the long at index, anInteger.
Storing in the machines natural byte order.
Indices are 1-based and scaled as appropriate to allow
accessing the memory as an array of doubleWord entries.
(i.e. indices are 1, 2, ...)"
^ self doubleWordAtDoubleWordIndex:index put:value MSB:(UninterpretedBytes isBigEndian)
!
doubleWordAtDoubleWordIndex:index put:value MSB:msb
"set the long at index, anInteger.
Storing is MSB if msb is true, LSB otherwise.
Indices are 1-based and scaled as appropriate to allow
accessing the memory as an array of doubleWord entries.
(i.e. indices are 1, 2, ...)"
^ self doubleWordAt:(index - 1 * 4 + 1) put:value MSB:msb
!
instVarAt:index
index == 1 ifTrue:[
^ self address
].
^ super instVarAt:index
!
stringAt:index
"return a string starting at index up to the 0-byte"
|stream i c|
stream := WriteStream on:''.
i := index.
[(c := self basicAt:i) ~~ 0] whileTrue:[
stream nextPut:(Character value:c).
i := i + 1.
].
^ stream contents
!
stringAt:index size:maxSize
"return a string starting at index up to maxSize, or a 0-byte"
|stream i c|
stream := WriteStream on:(String new:maxSize).
i := index.
[(i <= maxSize)
and:[(c := self basicAt:i) ~~ 0]] whileTrue:[
stream nextPut:(Character value:c).
i := i + 1.
].
^ stream contents
!
wordAt:index
"return the unsigned short at index, anInteger.
Fetching is in the machines natural byte order.
Indices are 1-based, therefore
this is the byte at (address + index - 1).
Here, unaligned accesses are allowed - in C, this is usually an error."
^ self wordAt:index msb:(UninterpretedBytes isBigEndian)
!
wordAt:index MSB:msb
"return the unsigned short at index, anInteger.
Fetching is MSB if msb is true, LSB otherwise.
Indices are 1-based,
therefore the first byte fetched is the byte at (address + index - 1).
Here, unaligned accesses are allowed - in C, this is usually an error."
msb ifTrue:[
^ ((self at:index) bitShift:8) + (self at:(index + 1))
] ifFalse:[
^ ((self at:index+1) bitShift:8) + (self at:(index))
]
!
wordAt:index put:aNumber
"set the short at index, index to aNumber; storing in the machines natural byte order.
Here, unaligned accesses are allowed - in C, this is usually an error."
^ self wordAt:index put:aNumber msb:(UninterpretedBytes isBigEndian)
!
wordAt:index put:aNumber MSB:msb
"set the short at index, index to aNumber.
Storing is MSB if msb is true, LSB otherwise.
Here, unaligned accesses are allowed - in C, this is usually an error."
msb ifTrue:[
self at:index put:(aNumber digitAt:2).
self at:(index + 1) put:(aNumber digitAt:1).
] ifFalse:[
self at:index put:(aNumber digitAt:1).
self at:(index + 1) put:(aNumber digitAt:2).
].
^ aNumber
!
wordAtWordIndex:index
"return the unsigned short at index, anInteger.
Fetching in the machines natural byte order.
Indices are 1-based and scaled as appropriate to allow
accessing the memory as an array of word entries.
(i.e. indices are 1, 2, ...)"
^ self wordAtWordIndex:index MSB:(UninterpretedBytes isBigEndian)
!
wordAtWordIndex:index MSB:msb
"return the unsigned short at index, anInteger.
Fetching is MSB if msb is true, LSB otherwise.
Indices are 1-based and scaled as appropriate to allow
accessing the memory as an array of word entries.
(i.e. indices are 1, 2, ...)"
^ self wordAt:(index - 1 * 2 + 1) MSB:msb
!
wordAtWordIndex:index put:value
"set the short at index, anInteger.
Storing in the machines natural byte order.
Indices are 1-based and scaled as appropriate to allow
accessing the memory as an array of word entries.
(i.e. indices are 1, 2, ...)"
^ self wordAtWordIndex:index put:value MSB:(UninterpretedBytes isBigEndian)
!
wordAtWordIndex:index put:value MSB:msb
"set the short at index, anInteger.
Storing is MSB if msb is true, LSB otherwise.
Indices are 1-based and scaled as appropriate to allow
accessing the memory as an array of word entries.
(i.e. indices are 1, 2, ...)"
^ self wordAt:(index - 1 * 2 + 1) put:value MSB:msb
! !
!ExternalBytes methodsFor:'freeing'!
free
"free a previously allocated piece of memory - be very careful, there
are no checks done here. All dangers you usually have with malloc/free
are present here ..."
"at least, we check for double freeing the same chunk"
self address isNil ifTrue:[
self error:'freeing memory twice'.
^ self
].
Lobby unregister:self.
self disposed. "/ does what we need here ..
self unprotectFromGC
! !
!ExternalBytes methodsFor:'instance release'!
disposed
%{ /* NOCONTEXT */
char *mem = (char *)0;
mem = (char *)(__INST(address_));
if (mem) {
__stx_free(mem);
}
__INST(address_) = __INST(size) = nil;
if (mem && (@global(TraceMalloc) == true)) {
printf("EXTBYTES: freed memory at: %08x\n", mem);
}
%}
!
shallowCopyForFinalization
"redefined to return a lightweight copy
- all we need is the memory handle"
^ ExternalBytes basicNew setAddress:self address size:size
"Modified: 20.4.1996 / 23:23:28 / cg"
! !
!ExternalBytes methodsFor:'printing & storing'!
displayString
^ 'ExternalBytes at:' , (self address printStringRadix:16)
! !
!ExternalBytes methodsFor:'private accessing'!
setAddress:aNumber size:sz
"set the start address and size"
%{ /* NOCONTEXT */
if (__INST(address_) == nil) {
if (aNumber == nil) {
__INST(address_) = nil;
} else {
if (__isSmallInteger(aNumber)) {
__INST(address_) = (OBJ)(__intVal(aNumber));
} else {
__INST(address_) = (OBJ) __longIntVal(aNumber);
}
}
__INST(size) = sz;
RETURN (self);
}
%}.
^ self error:'cannot change address'
! !
!ExternalBytes methodsFor:'registration'!
protectFromGC
"enter a reference to the receiver into the AllocatedInstances
class variable - this prevents it from ever being finalized by
the garbage collector, thus protecting the underlying memory."
AllocatedInstances isNil ifTrue:[
AllocatedInstances := IdentitySet new
].
AllocatedInstances add:self
!
unprotectFromGC
"remove the receiver from the AllocatedInstances
class variable - if there is no other reference to the receiver,
the next garbage collect will finalize the receiver and the underlying
memory be freed."
AllocatedInstances notNil ifTrue:[
AllocatedInstances remove:self ifAbsent:nil
]
! !
!ExternalBytes class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/ExternalBytes.st,v 1.7 1996-04-25 16:01:23 cg Exp $'
! !
ExternalBytes initialize!