From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Sun, 31 Oct 2010 00:05:05 +0000 (-0700)
Subject: Added c-cast, struct member peeks, param syntax checking.
X-Git-Tag: 20101212-Gtk~14^2~4
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1ff7beaf87bad316c28162db3052009d3ca2c5c1;p=mit-scheme.git

Added c-cast, struct member peeks, param syntax checking.

* src/ffi/cdecls.scm (valid-param): Check that the param name does not
contain `-', nor any other non-C identifier chars.  These names go
into the generated .c files.

* src/ffi/syntax.scm (expand-peek): Allow peeks at struct members to
create or set an alien, just as peeking an array member does already.

* src/ffi/ffi.scm (c-cast): New.  Basically set-%alien/ctype! with a
convenient return value.

(alien/address, copy-alien-address!, alien-null?, alien-null!, alien=?):
Declare these as integrable operators, not via define-integrable.
Their arguments are referenced multiple times.

* src/runtime/runtime.pkg (runtime ffi): Export c-cast to ().
---

diff --git a/src/ffi/cdecls.scm b/src/ffi/cdecls.scm
index 5270c8189..1cf0e11e6 100644
--- a/src/ffi/cdecls.scm
+++ b/src/ffi/cdecls.scm
@@ -271,10 +271,17 @@ USA.
 		(pair? (cdr form))
 		(null? (cddr form))))
       (cerror form "malformed parameter declaration"))
+  (if (string-find-next-char-in-set
+       (symbol-name (car form)) char-set:not-c-symbol)
+      (cerror form "invalid parameter name"))
   (let ((name (car form))
 	(ctype (valid-ctype (cadr form) includes)))
     (list name ctype)))
 
+(define char-set:not-c-symbol (char-set-invert
+			       (char-set-union (char-set #\_)
+					       char-set:alphanumeric)))
+
 (define (valid-ctype form includes)
   ;; Returns a valid ctype expression, a copy of FORM.  Modifies
   ;; INCLUDES with any internal struct/union/enum declarations.
diff --git a/src/ffi/syntax.scm b/src/ffi/syntax.scm
index f69b2ea6b..0dc5f12eb 100644
--- a/src/ffi/syntax.scm
+++ b/src/ffi/syntax.scm
@@ -177,12 +177,12 @@ USA.
 	((ctype/pointer? ctype)
 	 `(,(ucode-primitive c-peek-pointer 3)
 	   ,alien-form ,offset ,(or value-form '(MAKE-ALIEN))))
-	((ctype/array? ctype)
+	((or (ctype/array? ctype) (ctype/struct? ctype))
 	 (if value-form
 	     `(LET ((VALUE ,value-form))
-		   (COPY-ALIEN-ADDRESS! VALUE ,alien-form)
-		   (ALIEN-BYTE-INCREMENT! VALUE ,offset)
-		   VALUE)
+		(COPY-ALIEN-ADDRESS! VALUE ,alien-form)
+		(ALIEN-BYTE-INCREMENT! VALUE ,offset)
+		VALUE)
 	     `(ALIEN-BYTE-INCREMENT ,alien-form ,offset)))
 	((or (ctype/enum? ctype) (eq? ctype 'ENUM))
 	 `(,(ucode-primitive c-peek-uint 2) ,alien-form ,offset))
diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 22344d01c..2ab9c878d 100644
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -51,6 +51,11 @@ USA.
 
 (define-integrable set-alien/ctype! set-%alien/ctype!)
 
+(declare (integrate-operator c-cast))
+(define (c-cast alien ctype)
+  (set-%alien/ctype! alien ctype)
+  alien)
+
 (define (alien/address-string alien)
   ;; Returns a string of length 8, e.g. "081adc60".
   (let ((high (%alien/high-bits alien)))
@@ -64,27 +69,32 @@ USA.
   (let ((ctype (if (default-object? ctype) #f ctype)))
     (%make-alien 0 0 ctype)))
 
-(define-integrable (alien/address alien)
+(declare (integrate-operator alien/address))
+(define (alien/address alien)
   (+ (* (%alien/high-bits alien) #x10000)
      (%alien/low-bits alien)))
 
-(define-integrable (copy-alien-address! alien source)
+(declare (integrate-operator copy-alien-address!))
+(define (copy-alien-address! alien source)
   (if (not (eq? alien source))
       (begin
 	(set-%alien/high-bits! alien (%alien/high-bits source))
 	(set-%alien/low-bits! alien (%alien/low-bits source)))))
 
-(define-integrable (alien-null? alien)
+(declare (integrate-operator alien-null?))
+(define (alien-null? alien)
   (and (fix:zero? (%alien/high-bits alien))
        (fix:zero? (%alien/low-bits alien))))
 
-(define-integrable (alien-null! alien)
+(declare (integrate-operator alien-null!))
+(define (alien-null! alien)
   (set-%alien/high-bits! alien 0)
   (set-%alien/low-bits! alien 0))
 
 (define null-alien (make-alien '|void|))
 
-(define-integrable (alien=? alien1 alien2)
+(declare (integrate-operator alien=?))
+(define (alien=? alien1 alien2)
   (and (fix:= (%alien/high-bits alien1) (%alien/high-bits alien2))
        (fix:= (%alien/low-bits alien1) (%alien/low-bits alien2))))
 
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 15edbc165..2c93ef3df 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3165,6 +3165,7 @@ USA.
 	  copy-alien
 	  alien/ctype
 	  set-alien/ctype!
+	  c-cast
 	  alien?
 	  alien-null?
 	  alien-null!