UninterpretedBytes.st
changeset 6492 61c212c8b3fb
parent 4782 04a2ea1ad3a5
child 6885 ee7f2ed913a1
--- a/UninterpretedBytes.st	Tue Apr 09 20:58:14 2002 +0200
+++ b/UninterpretedBytes.st	Tue Apr 09 21:00:21 2002 +0200
@@ -10,6 +10,8 @@
  hereby transferred.
 "
 
+"{ Package: 'stx:libbasic' }"
+
 ArrayedCollection subclass:#UninterpretedBytes
 	instanceVariableNames:''
 	classVariableNames:'IsBigEndian'
@@ -1268,6 +1270,59 @@
     "Modified: / 9.5.1998 / 01:13:34 / cg"
 !
 
+pointerAt:index put:value
+    "set the pointer starting at index from the signed Integer value.
+     The index is a smalltalk index (i.e. 1-based). 
+     Only aligned accesses are allowed.
+     The value is either an ExternalAddress or ExternalBytes"
+
+%{
+    OBJ *pointer;
+
+    if (__isExternalAddress(value)) {
+        pointer = __externalAddressVal(value);
+    } else if (__isExternalBytes(value)) {
+        pointer = __externalBytesVal(value);
+        if (pointer == nil)
+            pointer = 0;
+    } else goto bad;
+
+    if (__isSmallInteger(index)) {
+        unsigned char *cp;
+        int sz;
+
+        __fetchBytePointerAndSize__(self, &cp, &sz);
+        if (cp) {
+            unsigned INT idx = ((unsigned INT)__smallIntegerVal(index)) - 1;
+
+            if ((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"
+!
+
 signedDoubleWordAt:index
     "return the 4-bytes starting at index as a signed Integer.
      The index is a smalltalk index (i.e. 1-based).
@@ -2073,5 +2128,5 @@
 !UninterpretedBytes class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.40 1999-09-21 00:23:30 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.41 2002-04-09 19:00:21 stefan Exp $'
 ! !