hg/stx-libbasic: comparison ExternalBytes.st

equal deleted inserted replaced

-:2c4768bb2e89
+:b37704e992e1
 char *
 __stx_malloc(size_t nBytes) {
 	char *ptr = malloc(nBytes);
 	if (@global(TraceMalloc) == true) {
-	    console_printf("ExternalBytes [info]: allocated %d bytes at: %016"_lx_"\n", nBytes, (INT)ptr);
+	    console_printf("ExternalBytes [info]: allocated %ld bytes at: %p\n", (long)nBytes, ptr);
 	}
 	addToMallocList(ptr, nBytes);
 	return ptr;
 }
 	removeFromMallocList(ptr);
 	newPtr = realloc(ptr, nBytes);
 	addToMallocList(newPtr, nBytes);
 	if (@global(TraceMalloc) == true) {
-	    console_printf("ExternalBytes [info]: realloc %d bytes for %"_lx_" at: %"_lx_"\n", nBytes, (INT)ptr, (INT)newPtr);
+	    console_printf("ExternalBytes [info]: realloc %ld bytes for %p at: %p\n", (long)nBytes, ptr, newPtr);
 	}
 	return newPtr;
 }
 void
 "return a new ExternalBytes object to access bytes starting at anAddressInteger.
 The memory at anAddressInteger 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.
 The pointer is protected from GC
 (i.e. I will not free the heap memory,
 once the returned reference is no longer in use).
 Be careful to avoid memory leaks, when getting malloc'd memory from an external function.
 DANGER ALERT: this method allows very bad things to be done to the
-system - use with GREAT care (better: do not use it)"
+		   system - use with GREAT care (better: do not use it)"
 ^ self basicNew setAddress:anAddressInteger size:size
 "Modified (comment): / 31-03-2016 / 11:04:27 / cg"
 !
 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
+		   MANUALLY freed (see #free) or the returned externalBytes object
-is unprotected or the classes releaseAllMemory method is called."
+		   is unprotected or the classes releaseAllMemory method is called."
 "/ ^ self protectedNew:numberOfBytes.
 ^ self unprotectedNew:numberOfBytes.
 "
 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
+		   MANUALLY freed (see #free) or the returned externalBytes object
-is unprotected or the classes releaseAllMemory method is called."
+		   is unprotected or the classes releaseAllMemory method is called."
 |newInst|
 newInst := self unprotectedNew:numberOfBytes.
 newInst protectFromGC.
 dumpMallocChunks
 %{  /* NOCONTEXT */
 struct mallocList *entry;
 for (entry = mallocList; entry; entry=entry->next) {
-	console_printf("  %"_lx_" (%d)\n", (INT)(entry->chunk), entry->size);
+	console_printf("  %p (%ld)\n", (entry->chunk), (long)(entry->size));
 }
 %}
 "
 self dumpMallocChunks
 "
 %{
 struct mallocList *entry;
 while ((entry = mallocList) != (struct mallocList *)0) {
 	if (@global(TraceMalloc) == true ) {
-	    console_printf("ExternalBytes [info]: **** forced free of %"_lx_" (%d)\n", (INT)entry->chunk, entry->size);
+	    console_printf("ExternalBytes [info]: **** forced free of %p (%ld)\n", entry->chunk, (long)(entry->size));
 	}
 	__stx_free(entry->chunk);
 }
 %}
 !
 pointerAlignment
 "return the alignement of pointers in structs and unions"
 %{  /* NOCONTEXT */
 struct {
-char c;
+	char c;
-void* p;
+	void* p;
 } dummy;
 RETURN (__mkSmallInteger( (char *)&dummy.p - (char *)&dummy.c ));
 %}
 "
 ExternalBytes pointerAlignment
 !
 sizeofPointer
 "return the number of bytes used by the machine's native pointer.
 Notice: this is inlined by the compiler(s) as a constant,
 therefore, queries like
-'ExternalAddress pointerSize == 8'
+	'ExternalAddress pointerSize == 8'
 cost nothing; they are compiled in as a constant
 (and even conditionals are eliminated)."
 %{  /* NOCONTEXT */
 RETURN (__mkSmallInteger( sizeof(char *)));
 %}
 |idx byte s|
 idx := 1.
 s := WriteStream on:''.
 [(byte := self at:idx) ~~ 0] whileTrue:[
-s nextPut:(Character value:byte).
+	s nextPut:(Character value:byte).
-idx := idx + 1.
+	idx := idx + 1.
 ].
 ^ s contents
 !
 copyUnicodeStringFromHeap
 "speed up string conversions"
 |size|
 self class == ExternalBytes ifTrue:[
-size := self size.
+	size := self size.
-^ (String uninitializedNew:size) replaceBytesFrom:1 to:size with:self startingAt:1.
+	^ (String uninitializedNew:size) replaceBytesFrom:1 to:size with:self startingAt:1.
 ].
 ^ super asString.
 "
 #[16r41 16r42 16r43] asExternalBytes asString
 |addr|
 "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
 "/ old ST80 means: draw-yourself on a GC.
 (aGCOrStream isStream) ifFalse:[
-^ super displayOn:aGCOrStream
+	^ super displayOn:aGCOrStream
 ].
 aGCOrStream nextPutAll:self className.
 addr := self address.
 addr isNil ifTrue:[
-aGCOrStream nextPutAll:'[free]'.
+	aGCOrStream nextPutAll:'[free]'.
 ] ifFalse:[
-size notNil ifTrue:[
+	size notNil ifTrue:[
-aGCOrStream nextPutAll:'[sz:'.
+	    aGCOrStream nextPutAll:'[sz:'.
-size printOn:aGCOrStream.
+	    size printOn:aGCOrStream.
-aGCOrStream space.
+	    aGCOrStream space.
-] ifFalse:[
+	] ifFalse:[
-aGCOrStream nextPut:$[.
+	    aGCOrStream nextPut:$[.
-].
+	].
-aGCOrStream nextPutAll:'@'.
+	aGCOrStream nextPutAll:'@'.
-addr printOn:aGCOrStream base:16.
+	addr printOn:aGCOrStream base:16.
-aGCOrStream nextPut:$].
+	aGCOrStream nextPut:$].
 ].
 "
-self new printString
+	self new printString
-(self new:5) displayString
+	(self new:5) displayString
 "
 "Modified: / 24-02-2000 / 19:02:19 / cg"
 "Modified (comment): / 22-02-2017 / 16:54:08 / cg"
 ! !
 setAddress:aNumberOrExternalAddress size:sz
 "set the start address and size"
 %{  /* NOCONTEXT */
 if (__INST(address_) == nil) {
-if (aNumberOrExternalAddress == nil) {
+	if (aNumberOrExternalAddress == nil) {
-__INST(address_) = nil;
+	    __INST(address_) = nil;
-} else {
+	} else {
-if (__isSmallInteger(aNumberOrExternalAddress)) {
+	    if (__isSmallInteger(aNumberOrExternalAddress)) {
-__INST(address_) = (OBJ) __intVal(aNumberOrExternalAddress);
+		__INST(address_) = (OBJ) __intVal(aNumberOrExternalAddress);
-} else if(__isInteger(aNumberOrExternalAddress)) {
+	    } else if(__isInteger(aNumberOrExternalAddress)) {
-__INST(address_) = (OBJ) __unsignedLongIntVal(aNumberOrExternalAddress);
+		__INST(address_) = (OBJ) __unsignedLongIntVal(aNumberOrExternalAddress);
-} else if(__isExternalAddressLike(aNumberOrExternalAddress)) {
+	    } else if(__isExternalAddressLike(aNumberOrExternalAddress)) {
-__INST(address_) = __externalAddressVal(aNumberOrExternalAddress);
+		__INST(address_) = __externalAddressVal(aNumberOrExternalAddress);
-}
+	    }
-}
+	}
-__INST(size) = sz;
+	__INST(size) = sz;
-RETURN (self);
+	RETURN (self);
 }
 %}.
 ^ self error:'cannot change address'
 "Modified: / 12-02-2017 / 16:22:47 / cg"
 forgetMemory
 "forget the underlying memory - i.e. it will NOT be freed by me,
 and actually no reference to the underlying memory is kept.
 Warning:
-Unless freed by someone else (typically a C-program/client),
+	 Unless freed by someone else (typically a C-program/client),
-this leads to a memory leak.
+	 this leads to a memory leak.
-Use this only, if memory which was allocated by me
+	 Use this only, if memory which was allocated by me
-is given to a C-program which frees the memory."
+	 is given to a C-program which frees the memory."
 Lobby unregister:self.      "/ prevents finalization
 self unprotectFromGC.       "/ no longer remembered
 self setAddress:0 size:0.   "/ no longer accessible
 "using a Semaphore can cause a deadlock, since unprotectFromGC may be called by
 a finalization method"
 wasBlocked := OperatingSystem blockInterrupts.
 "/    AccessLock critical:[
-AllocatedInstances isNil ifTrue:[
+	AllocatedInstances isNil ifTrue:[
-AllocatedInstances := IdentitySet new
+	    AllocatedInstances := IdentitySet new
-].
+	].
-AllocatedInstances add:self.
+	AllocatedInstances add:self.
 "/    ]
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified (format): / 26-07-2017 / 11:21:46 / cg"
 !
 "using a Semaphore can cause a deadlock, since protectFromGC may be interrupted by me
 being called by a finalization method"
 wasBlocked := OperatingSystem blockInterrupts.
 "/ AccessLock critical:[
-AllocatedInstances notNil ifTrue:[
+	AllocatedInstances notNil ifTrue:[
-AllocatedInstances remove:self ifAbsent:nil.
+	    AllocatedInstances remove:self ifAbsent:nil.
-].
+	].
 "/ ]
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified (format): / 26-07-2017 / 11:21:59 / cg"
 ! !

changeset 24043	b37704e992e1
parent 23932	01800d8961bd
child 24056	a7b360193da5