hg/stx-libbasic: comparison UninterpretedBytes.st

equal deleted inserted replaced

-:bdad938cfe9d
+:a8e7825ad3c0
+"{ Encoding: utf8 }"
 "
 COPYRIGHT (c) 1993 by Claus Gittinger
 All Rights Reserved
 This software is furnished under a license and may be used
 "Modified: / 23.4.1996 / 15:56:25 / cg"
 "Modified: / 5.3.1998 / 14:56:22 / stefan"
 ! !
+!UninterpretedBytes methodsFor:'@ OLE Extensions'!
+addressAtOffset: index0Based
+"Answer the bytes starting at index0Based (0 based offset)
+as anExternalAddress.  Answer nil if there is no address.
+Notice: Offsets are zero relative."
+| address |
+address := self pointerValueAt: index0Based + 1.
+^ address = 0
+ifTrue: [ nil ]
+ifFalse: [ ExternalAddress newAddress: address  ]
+"Modified: / 30-03-2016 / 11:00:19 / cg"
+!
+addressAtOffset: index0Based put: anExternalAddress
+"Set the bytes starting at index0Based (0 based offset)
+from the contents of anExternalAddress.
+Notice: Offsets are zero relative."
+|anAddress |
+anAddress := anExternalAddress isNil
+ifTrue:[0]
+ifFalse:[anExternalAddress address].
+self pointerAt: index0Based + 1 put: anAddress
+!
+addressValueAtOffset: index0Based
+"Answer the pointer-value starting at index0Based (0 based offset)
+as unsigned integer.
+Notice: Offsets are zero relative."
+^ self pointerValueAt: index0Based + 1.
+!
+addressValueAtOffset: index0Based put:anAddress
+"Set the pointer-value starting at index0Based (0 based offset)
+as unsigned integer.
+Notice: Offsets are zero relative."
+self pointerAt: index0Based + 1 put:anAddress.
+!
+byteAtOffset:index0Based
+"return the byte at index0Based.
+For ByteArray, this is the same as basicAt:
+however, for strings or symbols,
+this returns a numeric byteValue instead of a character.
+Notice: Offsets are zero relative."
+^ self byteAt:(index0Based + 1)
+!
+byteAtOffset:index0Based put:value
+"set the byte at index. For ByteArray, this is the same as basicAt:put:.
+However, for Strings, this expects a byteValue to be stored.
+Notice: Offsets are zero relative."
+^ self byteAt:(index0Based + 1) put:value
+!
+bytesAtOffset: index0Based count: count
+"Answer a ByteArray with count bytes copied
+from the receiver starting at index0Based.
+Notice: Offsets are zero relative."
+|newBytes |
+newBytes := ByteArray new: count.
+newBytes replaceBytesFrom:1 to:count with:self startingAt:(index0Based + 1).
+^newBytes
+"
+#[83 0 0 0 0 0 0 0 120 237 14 0 4 0 0 ] bytesAtOffset: 9 count: 3
+"
+"Modified (comment): / 30-03-2016 / 11:24:41 / cg"
+!
+bytesAtOffset: index0Based put: aByteObject
+"Store aByteObject at anInteger in the receiver.
+Notice: Offsets are zero relative."
+^ self
+replaceBytesFrom:(index0Based + 1) to:(index0Based + aByteObject size)
+with:aByteObject startingAt:1.
+!
+fillFromAddress: anAddress
+"Fill the receiver by copying mySize bytes from host memory at anAddress.
+Warning: because anAddress might not know, how big it is,
+the size of the receiver must already be correct.
+(i.e. the receiver must have been allocated from a returned size value)"
+self
+replaceFrom:1 to:self size
+with:anAddress asExternalBytes
+startingAt:1
+!
+longAtOffset: index0Based
+"same as longAt:, but with a 0-based offset.
+Notice: Offsets are zero relative."
+^self signedInt32At:(index0Based + 1)
+!
+longAtOffset: index0Based put: value
+"same as longAtput::, but with a 0-based offset.
+Notice: Offsets are zero relative."
+^self signedInt32At:index0Based +1 put:value
+!
+shortAtOffset: index0Based
+"same as shortAt:, but with a 0-based offset.
+Notice: Offsets are zero relative."
+^self signedInt16At: index0Based + 1
+!
+shortAtOffset: index0Based put: value
+"same as shortAt:put:, but with a 0-based offset.
+Notice: Offsets are zero relative."
+^self signedInt16At: index0Based + 1 put: value
+!
+uLongAtOffset: index0Based
+"same as unsignedLongAt:, but with a 0-based offset.
+Notice: Offsets are zero relative."
+^ self unsignedInt32At:(index0Based + 1)
+!
+uLongAtOffset: index0Based put: value
+"same as unsignedLongAt:put:, but with a 0-based offset.
+Notice: Offsets are zero relative."
+^ self unsignedInt32At:(index0Based + 1) put: value
+!
+uShortAtOffset: index0Based
+"same as unsignedShortAt:, but with a 0-based offset.
+Notice: Offsets are zero relative."
+^ self unsignedInt16At:(index0Based + 1)
+!
+uShortAtOffset: index0Based put: value
+"same as unsignedShortAt:put:, but with a 0-based offset.
+Notice: Offsets are zero relative."
+^ self unsignedInt16At:(index0Based + 1) put: value
+!
+unsignedLongAtOffset: index0Based
+"same as unsignedLongAt:, but with a 0-based offset.
+Notice: Offsets are zero relative."
+^self unsignedInt32At: index0Based + 1
+!
+unsignedLongAtOffset: index0Based put: value
+"same as unsignedLongAt:put:, but with a 0-based offset.
+Notice: Offsets are zero relative."
+^self unsignedInt32At: index0Based + 1 put: value
+!
+unsignedShortAtOffset: index0Based
+"same as unsignedShortAt:, but with a 0-based offset.
+Notice: Offsets are zero relative."
+^self unsignedInt16At: index0Based + 1
+!
+unsignedShortAtOffset: index0Based put: value
+"same as unsignedShortAt:put:, but with a 0-based offset.
+Notice: Offsets are zero relative."
+^self unsignedInt16At:(index0Based + 1) put: value
+! !
 !UninterpretedBytes methodsFor:'Compatibility'!
 doubleWordAt:index
 "return the 4-bytes starting at index as an (unsigned) Integer.
 The index is a smalltalk index (i.e. 1-based).
 !
 longLongAt:index
 "return the 8-bytes starting at index as a signed Integer.
 The index is a smalltalk index (i.e. 1-based).
-The value is retrieved in the machine�s natural byte order.
+The value is retrieved in the machineÄs natural byte order.
 This may be worth a primitive."
 ^ self signedInt64At:index MSB:IsBigEndian
 "
 ^ self unsignedInt64At:byteIndex put:anInteger MSB:true
 ! !
 !UninterpretedBytes methodsFor:'accessing-longs (32bit)'!
-pointerAt:index
-"get a pointer starting at index as ExternalAddress.
-The index is a smalltalk index (i.e. 1-based).
-Only aligned accesses are allowed."
-%{
-if (__isSmallInteger(index)) {
-unsigned char *cp;
-INT sz;
-__fetchBytePointerAndSize__(self, &cp, &sz);
-if (cp) {
-INT idx = __smallIntegerVal(index) - 1;
-char *pointer;
-if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
-cp += idx;
-/*
-* aligned
-*/
-if (((INT)cp & (sizeof(pointer)-1)) == 0) {
-pointer = ((char **)cp)[0];
-RETURN (__MKEXTERNALADDRESS(pointer));
-} else {
-#if 0
-printf("cp UNALIGNED (%"_lx_")\n", (INT)cp);
-#endif
-}
-} else {
-#if 0
-printf("idx(%"_ld_")+(sizeof(pointer)-1) (%d) >= sz (%"_ld_")\n",
-idx, (int)(sizeof(pointer)-1), sz);
-#endif
-}
-} else {
-#if 0
-printf("cp is NULL\n");
-#endif
-}
-} else {
-#if 0
-printf("bad index\n");
-#endif
-}
-bad:;
-%}.
-self primitiveFailed.
-"
-|b|
-b := ByteArray new:(ExternalAddress pointerSize).
-b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
-Transcript showCR:((b unsignedInt32At:1) printStringRadix:16).
-Transcript showCR:((b pointerAt:1)).
-|b|
-b := ByteArray new:(ExternalAddress pointerSize).
-b pointerAt:1 put:(ExternalAddress newAddress:16r12345678abcdef).
-Transcript showCR:((b unsignedInt64At:1) printStringRadix:16).
-Transcript showCR:((b pointerAt:1)).
-"
-!
-pointerAt:index put:value
-"set the pointer starting at index from the integer or externalAddress value.
-The index is a smalltalk index (i.e. 1-based).
-Only aligned accesses are allowed.
-The value is either an ExternalAddress, ExternalBytes or an Integer"
-%{
-OBJ *pointer;
-if (__isExternalAddressLike(value)) {
-pointer = __externalAddressVal(value);
-} else if (__isExternalBytesLike(value)) {
-pointer = __externalBytesVal(value);
-if (pointer == (OBJ *)0)
-pointer = 0;
-} else if (value == nil) {
-pointer = 0;
-} else if (__isSmallInteger(value)) {
-pointer = (OBJ *)__intVal(value);
-} else {
-if ((pointer = (OBJ *)__unsignedLongIntVal(value)) == 0) {
-goto bad;
-}
-}
-if (__isSmallInteger(index)) {
-unsigned char *cp;
-INT sz;
-__fetchBytePointerAndSize__(self, &cp, &sz);
-if (cp) {
-INT idx = __smallIntegerVal(index) - 1;
-if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
-cp += idx;
-/*
-* aligned
-*/
-if (((INT)cp & (sizeof(pointer)-1)) == 0) {
-((char **)cp)[0] = (char *) pointer;
-RETURN (value);
-}
-}
-}
-}
-bad:;
-%}.
-self primitiveFailed.
-"
-|b|
-b := ByteArray new:ExternalAddress pointerSize.
-b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
-(b unsignedLongAt:1) printStringRadix:16
-"
-"Modified: / 1.7.1996 / 21:11:39 / cg"
-"Created: / 5.3.1998 / 10:57:18 / stefan"
-!
-pointerValueAt:index
-"get a pointer value starting at index as unsigned integer.
-The index is a smalltalk index (i.e. 1-based).
-Only aligned accesses are allowed.
-This returns an int with sizeof the machines's native pointer (4 or 8 bytes)"
-%{
-if (__isSmallInteger(index)) {
-unsigned char *cp;
-INT sz;
-__fetchBytePointerAndSize__(self, &cp, &sz);
-if (cp) {
-INT idx = __smallIntegerVal(index) - 1;
-char *pointer;
-if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
-cp += idx;
-/*
-* aligned
-*/
-if (((INT)cp & (sizeof(pointer)-1)) == 0) {
-pointer = ((char **)cp)[0];
-RETURN (__MKUINT((INT)(pointer)));
-} else {
-// printf("cp UNALIGNED (%"_lx_")\n", (INT)cp);
-}
-} else {
-// printf("idx(%"_ld_")+(sizeof(pointer)-1) (%d) >= sz (%"_ld_")\n",
-//        idx, (int)(sizeof(pointer)-1), sz);
-}
-} else {
-// printf("cp is NULL\n");
-}
-} else {
-// printf("bad index\n");
-}
-bad:;
-%}.
-self primitiveFailed.
-"
-|b|
-b := ByteArray new:(ExternalAddress pointerSize).
-b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
-Transcript showCR:((b unsignedLongAt:1) printStringRadix:16).
-Transcript showCR:((b pointerAt:1)).
-Transcript showCR:((b pointerValueAt:1)).
-"
-"Modified (comment): / 30-03-2016 / 11:01:55 / cg"
-!
 signedInt32At:byteIndex
 "return the 4-bytes starting at byteIndex as a signed Integer.
 The index is a smalltalk index (i.e. 1-based).
 The value is retrieved in the machine's natural byte order,
 The integer is stored with most significant byte first."
 ^ self unsignedInt32At:byteIndex put:anInteger MSB:true
 ! !
+!UninterpretedBytes methodsFor:'accessing-pointers'!
+pointerAt:byteIndex
+"get a pointer starting at byteIndex as ExternalAddress.
+The byteIndex is a smalltalk index (i.e. 1-based).
+Only aligned accesses are allowed.
+The pointer is of native cpu's size (4 or 8 bytes)"
+%{
+if (__isSmallInteger(byteIndex)) {
+unsigned char *cp;
+INT sz;
+__fetchBytePointerAndSize__(self, &cp, &sz);
+if (cp) {
+INT idx = __smallIntegerVal(byteIndex) - 1;
+char *pointer;
+if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
+cp += idx;
+/*
+* aligned
+*/
+if (((INT)cp & (sizeof(pointer)-1)) == 0) {
+pointer = ((char **)cp)[0];
+RETURN (__MKEXTERNALADDRESS(pointer));
+} else {
+#if 0
+printf("cp UNALIGNED (%"_lx_")\n", (INT)cp);
+#endif
+}
+} else {
+#if 0
+printf("idx(%"_ld_")+(sizeof(pointer)-1) (%d) >= sz (%"_ld_")\n",
+idx, (int)(sizeof(pointer)-1), sz);
+#endif
+}
+} else {
+#if 0
+printf("cp is NULL\n");
+#endif
+}
+} else {
+#if 0
+printf("bad index\n");
+#endif
+}
+bad:;
+%}.
+self primitiveFailed.
+"
+|b|
+b := ByteArray new:(ExternalAddress pointerSize).
+b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
+Transcript showCR:((b unsignedInt32At:1) printStringRadix:16).
+Transcript showCR:((b pointerAt:1)).
+|b|
+b := ByteArray new:(ExternalAddress pointerSize).
+b pointerAt:1 put:(ExternalAddress newAddress:16r12345678abcdef).
+Transcript showCR:((b unsignedInt64At:1) printStringRadix:16).
+Transcript showCR:((b pointerAt:1)).
+"
+"Modified (comment): / 14-11-2016 / 17:32:23 / cg"
+!
+pointerAt:byteIndex put:value
+"set the pointer starting at byteIndex from the integer or externalAddress value.
+The byteIndex is a smalltalk index (i.e. 1-based).
+Only aligned accesses are allowed.
+The pointer is of native cpu's size (4 or 8 bytes).
+The value may be either an ExternalAddress, ExternalBytes or an Integer"
+%{
+OBJ *pointer;
+if (__isExternalAddressLike(value)) {
+pointer = __externalAddressVal(value);
+} else if (__isExternalBytesLike(value)) {
+pointer = __externalBytesVal(value);
+if (pointer == (OBJ *)0)
+pointer = 0;
+} else if (value == nil) {
+pointer = 0;
+} else if (__isSmallInteger(value)) {
+pointer = (OBJ *)__intVal(value);
+} else {
+if ((pointer = (OBJ *)__unsignedLongIntVal(value)) == 0) {
+goto bad;
+}
+}
+if (__isSmallInteger(byteIndex)) {
+unsigned char *cp;
+INT sz;
+__fetchBytePointerAndSize__(self, &cp, &sz);
+if (cp) {
+INT idx = __smallIntegerVal(byteIndex) - 1;
+if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
+cp += idx;
+/*
+* aligned
+*/
+if (((INT)cp & (sizeof(pointer)-1)) == 0) {
+((char **)cp)[0] = (char *) pointer;
+RETURN (value);
+}
+}
+}
+}
+bad:;
+%}.
+self primitiveFailed.
+"
+|b|
+b := ByteArray new:ExternalAddress pointerSize.
+b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
+(b unsignedLongAt:1) printStringRadix:16
+"
+"Created: / 05-03-1998 / 10:57:18 / stefan"
+"Modified (comment): / 14-11-2016 / 17:28:27 / cg"
+!
+pointerValueAt:byteIndex
+"get a pointer value starting at byteIndex as unsigned integer.
+The byteIndex is a smalltalk index (i.e. 1-based).
+Only aligned accesses are allowed.
+The pointer is of native cpu's size (4 or 8 bytes).
+This returns an int with sizeof the machines's native pointer (4 or 8 bytes)"
+%{
+if (__isSmallInteger(byteIndex)) {
+unsigned char *cp;
+INT sz;
+__fetchBytePointerAndSize__(self, &cp, &sz);
+if (cp) {
+INT idx = __smallIntegerVal(byteIndex) - 1;
+char *pointer;
+if ((idx >= 0) && ((idx+(sizeof(pointer)-1)) < sz)) {
+cp += idx;
+/*
+* aligned
+*/
+if (((INT)cp & (sizeof(pointer)-1)) == 0) {
+pointer = ((char **)cp)[0];
+RETURN (__MKUINT((INT)(pointer)));
+} else {
+// printf("cp UNALIGNED (%"_lx_")\n", (INT)cp);
+}
+} else {
+// printf("idx(%"_ld_")+(sizeof(pointer)-1) (%d) >= sz (%"_ld_")\n",
+//        idx, (int)(sizeof(pointer)-1), sz);
+}
+} else {
+// printf("cp is NULL\n");
+}
+} else {
+// printf("bad index\n");
+}
+bad:;
+%}.
+self primitiveFailed.
+"
+|b|
+b := ByteArray new:(ExternalAddress pointerSize).
+b pointerAt:1 put:(ExternalAddress newAddress:16r12345678).
+Transcript showCR:((b unsignedLongAt:1) printStringRadix:16).
+Transcript showCR:((b pointerAt:1)).
+Transcript showCR:((b pointerValueAt:1)).
+"
+"Modified (comment): / 14-11-2016 / 17:28:33 / cg"
+! !
 !UninterpretedBytes methodsFor:'accessing-shorts (16bit)'!
 signedInt16At:byteIndex
 "return the 2-bytes starting at index as a signed Integer.
 The index is a smalltalk index (i.e. 1-based).
 #[1 2 3 4 5] swapBytes
 #[1 2 3 4] swapBytes
 "
 ! !
+!UninterpretedBytes methodsFor:'inspecting'!
+inspector2Tabs
+^ super inspector2Tabs , #( inspector2TabForHexDump )
+"Created: / 27-02-2012 / 21:51:36 / cg"
+"Modified: / 13-02-2015 / 21:03:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
 !UninterpretedBytes methodsFor:'misc'!
 swapLongAt:byteIndex
 "swap the byteOrder of a long.

changeset 20961	a8e7825ad3c0
parent 20960	bdad938cfe9d
child 21024	8734987eb5c7
child 21320	8b0aaee195e6