From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Wed, 22 Jun 2011 14:58:06 +0000 (-0700)
Subject: Added %set-alien/address!, for gtk/gio.scm.
X-Git-Tag: mit-scheme-pucked-9.2.12~703
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1af74cf86e2498e15d6b089f7ab354814e07f92b;p=mit-scheme.git

Added %set-alien/address!, for gtk/gio.scm.

Needed to create an alien address from an external-string descriptor.
---

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 220e810a8..55db9b89b 100644
--- 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))