r1608: Reworked LW cstring to use built-in LW conversion

[uffi.git] / src / aggregates.cl

diff --git a/src/aggregates.cl b/src/aggregates.cl
index 64a0e281f543409e4577479e5deff9b2ff748697..06dca81fe691b5fde374bc25abecf846db839c5e 100644 (file)
--- a/src/aggregates.cl
+++ b/src/aggregates.cl
@@ -1,4 +1,4 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-

 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;


@@ -7,24 +7,13 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;

-;;;; Copyright (c) 2002 Kevin M. Rosenberg
+;;;; $Id: aggregates.cl,v 1.7 2002/03/21 07:56:45 kevin Exp $

 ;;;;
 ;;;;

-;;;; $Id: aggregates.cl,v 1.3 2002/03/10 22:29:47 kevin Exp $
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg

 ;;;;
 ;;;;

-;;;; This file is part of the UFFI. 
-;;;;
-;;;; UFFI is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License (version 2) as
-;;;; published by the Free Software Foundation.
-;;;;
-;;;; UFFI is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with UFFI; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.

 ;;;; *************************************************************************
 
 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
 ;;;; *************************************************************************
 
 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))


@@ -37,6 +26,7 @@ of the enum-name name, separator-string, and field-name"
   (let ((counter 0)
        (cmds nil)
        (constants nil))
   (let ((counter 0)
        (cmds nil)
        (constants nil))

+    (declare (fixnum counter))

     (dolist (arg args)
       (let ((name (if (listp arg) (car arg) arg))
            (value (if (listp arg) 
     (dolist (arg args)
       (let ((name (if (listp arg) (car arg) arg))
            (value (if (listp arg) 


@@ -71,11 +61,11 @@ of the enum-name name, separator-string, and field-name"
        (* ,(convert-from-uffi-type type :array)))
   )
 
        (* ,(convert-from-uffi-type type :array)))
   )
 

-(defun process-struct-args (name args)
+(defun process-struct-fields (name fields)

   (let (processed)
   (let (processed)

-    (dolist (arg args)
-      (let ((field-name (car arg))
-           (type (cadr arg)))
+    (dolist (field fields)
+      (let ((field-name (car field))
+           (type (cadr field)))

        (push (append (list field-name)
                    (if (eq type :pointer-self)
                        #+cmu `((* (alien:struct ,name)))
        (push (append (list field-name)
                    (if (eq type :pointer-self)
                        #+cmu `((* (alien:struct ,name)))


@@ -85,13 +75,13 @@ of the enum-name name, separator-string, and field-name"
     (nreverse processed)))
        
            
     (nreverse processed)))
        
            

-(defmacro def-struct (name &rest args)
+(defmacro def-struct (name &rest fields)

   #+cmu
   #+cmu

-  `(alien:def-alien-type ,name (alien:struct ,name ,@(process-struct-args name args)))
+  `(alien:def-alien-type ,name (alien:struct ,name ,@(process-struct-fields name fields)))

   #+allegro
   #+allegro

-  `(ff:def-foreign-type ,name (:struct ,@(process-struct-args name args)))
+  `(ff:def-foreign-type ,name (:struct ,@(process-struct-fields name fields)))

   #+lispworks
   #+lispworks

-  `(fli:define-c-struct ,name ,@(process-struct-args name args))
+  `(fli:define-c-struct ,name ,@(process-struct-fields name fields))

   )
 
 
   )
 
 


@@ -123,7 +113,13 @@ of the enum-name name, separator-string, and field-name"
   #+allegro `(ff:fslot-value-typed ,type :c ,obj ,i)
   )
 
   #+allegro `(ff:fslot-value-typed ,type :c ,obj ,i)
   )
 

-
-
+(defmacro def-union (name &rest fields)
+  #+allegro
+  `(ff:def-foreign-type ,name (:union ,@(process-struct-fields name fields)))
+  #+lispworks
+  `(fli:define-c-union ,name ,@(process-struct-fields name fields))
+  #+cmu
+  `(alien:def-alien-type ,name (alien:union ,name ,@(process-struct-fields name fields)))
+)