UninterpretedBytes.st
branchjv
changeset 21024 8734987eb5c7
parent 20600 222ed6c9364e
parent 20961 a8e7825ad3c0
child 21387 e3865533e6a6
--- a/UninterpretedBytes.st	Wed Oct 26 23:35:39 2016 +0100
+++ b/UninterpretedBytes.st	Fri Nov 18 20:48:04 2016 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1993 by Claus Gittinger
               All Rights Reserved
@@ -429,7 +431,7 @@
     RETURN (false);
 # else
     /*
-     * I dont like ifdefs - you always forget some ...
+     * I don't like ifdefs - you always forget some ...
      * therefore we look into a structure at run-time.
      * (also, there are CPUs around [mips], where the byteorder
      *  is programmable, and which come in different flavours)
@@ -467,6 +469,193 @@
     "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
@@ -743,7 +932,7 @@
 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
@@ -1499,7 +1688,7 @@
                 cp += idx;
 #if defined(__i386__)
                 /*
-                 * aligned or not, we dont care (i386 can do both)
+                 * aligned or not, we don't care (i386 can do both)
                  */
                 {
                     INT iVal = ((INT *)cp)[0];
@@ -2552,179 +2741,6 @@
 
 !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 unsignedLongAt: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).
@@ -3126,7 +3142,7 @@
                 } else {
 #if defined(__i386__) || (defined(UNALIGNED_FETCH_OK) && defined(__LSBFIRST__))
                     /*
-                     * aligned or not - we dont care
+                     * aligned or not - we don't care
                      * (i386 can fetch unaligned)
                      */
                     iVal = ((unsigned int *)cp)[0];
@@ -3343,6 +3359,192 @@
     ^ 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
@@ -3393,7 +3595,7 @@
                 if (msb == false) {
 #if defined(__i386__) || (defined(__LSBFIRST__) && defined(UNALIGNED_FETCH_OK))
                     /*
-                     * aligned or not, we dont care (i386 can do both)
+                     * aligned or not, we don't care (i386 can do both)
                      */
                     sVal = ((short *)cp)[0];
 #else
@@ -3614,7 +3816,7 @@
                 if (msb == false) {
 #if defined(__i386__) || (defined(__LSBFIRST__) && defined(UNALIGNED_FETCH_OK))
                     /*
-                     * aligned or not, we dont care (i386 can do both)
+                     * aligned or not, we don't care (i386 can do both)
                      */
                     iVal = ((unsigned short *)cp)[0];
 #else
@@ -4562,6 +4764,14 @@
     "
 ! !
 
+!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'!