Added c-peek-bytes, c-poke-bytes.

diff --git a/src/microcode/pruxffi.c b/src/microcode/pruxffi.c
index 2f45ea3da7c730a7c598ce76ba172dbc5f24f05e..b0bbc8bc03c9975ef63332fece8d39898e62d3e0 100644 (file)
--- a/src/microcode/pruxffi.c
+++ b/src/microcode/pruxffi.c
@@ -214,6 +214,23 @@ DEFINE_PRIMITIVE ("C-PEEK-CSTRINGP!", Prim_peek_cstringp_bang, 2, 2, 0)
       }
   }
 }
+
+DEFINE_PRIMITIVE ("C-PEEK-BYTES", Prim_peek_bytes, 5, 5, 0)
+{
+  /* Copy, from ALIEN+OFFSET, COUNT bytes to STRING[START..]. */
+
+  PRIMITIVE_HEADER (5);
+  CHECK_ARG (4, STRING_P);
+  {
+    const void * src = (ALIEN_ADDRESS_LOC (void *));
+    int count = (UNSIGNED_FIXNUM_ARG (3));
+    SCM string = (ARG_REF (4));
+    int index = arg_index_integer (5, (STRING_LENGTH (string)));
+    void * dest = STRING_LOC (string, index);
+    memcpy (dest, src, count);
+  }
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
 \f
 #define C_POKER(type, value_arg_ref)                                   \
 {                                                                      \
@@ -305,6 +322,23 @@ DEFINE_PRIMITIVE ("C-POKE-STRING!", Prim_poke_string_bang, 3, 3, 0)
   }
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
+
+DEFINE_PRIMITIVE ("C-POKE-BYTES", Prim_poke_bytes, 5, 5, 0)
+{
+  /* Copy to ALIEN+OFFSET COUNT bytes from STRING[START]. */
+
+  PRIMITIVE_HEADER (5);
+  CHECK_ARG (4, STRING_P);
+  {
+    void * dest = (ALIEN_ADDRESS_LOC (void *));
+    int count = (UNSIGNED_FIXNUM_ARG (3));
+    SCM string = (ARG_REF (4));
+    int index = arg_index_integer (5, (STRING_LENGTH (string)));
+    const void * src = STRING_LOC (string, index);
+    memcpy (dest, src, count);
+  }
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
 \f
 /* Malloc/Free. */
 

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 7ee4bd6a0cf61b3029337e771d8b10d69b6f516a..2e629e9204b4d1845510cde928d50b6aaac3bb98 100644 (file)
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -96,6 +96,11 @@ USA.
   (+ (* (%alien/high-bits alien) (radix))
      (%alien/low-bits alien)))
 
+(define (%set-alien/address! alien address)
+  (let ((qr (integer-divide address (radix))))
+    (set-%alien/high-bits! alien (integer-divide-quotient qr))
+    (set-%alien/low-bits! alien (integer-divide-remainder qr))))
+
 (declare (integrate-operator copy-alien-address!))
 (define (copy-alien-address! alien source)
   (if (not (eq? alien source))
@@ -267,19 +272,22 @@ USA.
            (error:bad-range-argument afunc 'alien-function-cache!))
        (set-%alien-function/band-id! afunc band-id))))
 
-(define (c-peek-cstring alien)
+(define-integrable (c-peek-cstring alien)
   ((ucode-primitive c-peek-cstring 2) alien 0))
 
-(define (c-peek-cstring! alien)
+(define-integrable (c-peek-cstring! alien)
   ((ucode-primitive c-peek-cstring! 2) alien 0))
 
-(define (c-peek-cstringp alien)
+(define-integrable (c-peek-cstringp alien)
   ((ucode-primitive c-peek-cstringp 2) alien 0))
 
-(define (c-peek-cstringp! alien)
+(define-integrable (c-peek-cstringp! alien)
   ((ucode-primitive c-peek-cstringp! 2) alien 0))
 
-(define (c-poke-pointer dest alien)
+(define-integrable (c-peek-bytes alien offset count buffer start)
+  ((ucode-primitive c-peek-bytes 5) alien offset count buffer start))
+
+(define-integrable (c-poke-pointer dest alien)
   ;; Sets the pointer at the alien DEST to point to the ALIEN.
   ((ucode-primitive c-poke-pointer 3) dest 0 alien))
 
@@ -298,6 +306,9 @@ USA.
   (guarantee-string string 'C-POKE-STRING)
   ((ucode-primitive c-poke-string! 3) alien 0 string))
 
+(define-integrable (c-poke-bytes alien offset count buffer start)
+  ((ucode-primitive c-poke-bytes 5) alien offset count buffer start))
+
 (define (c-enum-name value enum-name constants)
   enum-name
   (let loop ((consts constants))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 99cefe50ba324079f48f98a918337563ce5375fa..0dd1fef85f159e47af5d6c2b4f36455fea4242fc 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3271,10 +3271,12 @@ USA.
          c-peek-cstring!
          c-peek-cstringp
          c-peek-cstringp!
+         c-peek-bytes
          c-poke-pointer
          c-poke-pointer!
          c-poke-string
          c-poke-string!
+         c-poke-bytes
          c-enum-name
          call-alien
          make-alien-to-free