UninterpretedBytes.st
changeset 11850 ee84c01dc50d
parent 11756 2540924974a2
child 11852 6732161ece56
--- a/UninterpretedBytes.st	Thu Aug 13 13:48:43 2009 +0200
+++ b/UninterpretedBytes.st	Thu Aug 13 14:56:48 2009 +0200
@@ -1443,6 +1443,48 @@
     "Modified: / 9.5.1998 / 01:13:34 / cg"
 !
 
+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."
+
+%{
+    OBJ *pointer;
+
+    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) {
+                    pointer = ((char **)cp)[0];
+                    RETURN (__MKEXTERNALADDRESS(pointer));
+                }
+            }
+        }
+    }
+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 signed Integer value.
      The index is a smalltalk index (i.e. 1-based). 
@@ -2425,5 +2467,5 @@
 !UninterpretedBytes class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.68 2009-06-10 14:47:47 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.69 2009-08-13 12:56:48 cg Exp $'
 ! !