X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=uffi%2Fmcl%2Faggregates.cl;fp=uffi%2Fmcl%2Faggregates.cl;h=0000000000000000000000000000000000000000;hb=0eaed82d93e9d2afbdcbdb8b49b0fc2386f86963;hp=1318769ca8477e78fa87f28048883f79c2c4794b;hpb=39af1ecd34f7cefc376c62a005939f849f135629;p=uffi.git

diff --git a/uffi/mcl/aggregates.cl b/uffi/mcl/aggregates.cl
deleted file mode 100644
index 1318769..0000000
--- a/uffi/mcl/aggregates.cl
+++ /dev/null
@@ -1,122 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          aggregates.cl
-;;;; Purpose:       UFFI source to handle aggregate types
-;;;; Programmers:   Kevin M. Rosenberg and John DeSoi
-;;;; Date Started:  Feb 2002
-;;;;
-;;;; $Id: aggregates.cl,v 1.3 2002/08/23 19:21:54 kevin Exp $
-;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;; and John DeSoi
-;;;;
-;;;; 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)))
-(in-package :uffi)
-
-
-
-(defmacro def-enum (enum-name args &key (separator-string "#"))
-  "Creates a constants for a C type enum list, symbols are created
-in the created in the current package. The symbol is the concatenation
-of the enum-name name, separator-string, and field-name"
-  (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) 
-		       (prog1
-			   (setq counter (cadr arg))
-			 (incf counter))
-		     (prog1 
-			 counter
-		       (incf counter)))))
-	(setq name (intern (concatenate 'string
-			     (symbol-name enum-name)
-			     separator-string
-			     (symbol-name name))))
-	(push `(uffi:def-constant ,name ,value) constants)))
-    (setf cmds (append '(progn)
-		       #+allegro `((ff:def-foreign-type ,enum-name :int))
-		       #+lispworks `((fli:define-c-typedef ,enum-name :int))
-		       #+cmu `((alien:def-alien-type ,enum-name alien:signed))
-                       #+mcl `((def-mcl-type ,enum-name :integer))
-		       (nreverse constants)))
-    cmds))
-
-
-
-(defmacro def-array-pointer (name-array type)
-  `(def-mcl-type ,name-array '(:array ,type)))
-
-
-; this is how rref expands array slot access (minus adding the struct offset)
-(defmacro deref-array (obj type i)
-  "Returns a field from a row"
-  `(,(accessor-symbol type :get) ,obj (* (the fixnum ,i) ,(foreign-object-size type))))
-
-(defmacro deref-array-set (obj type i value)
-    `(,(accessor-symbol type :set) ,obj ,value (* (the fixnum ,i) ,(foreign-object-size type))))
-
-(defsetf deref-array deref-array-set)
-
-
-(defun process-struct-fields (name fields variant)
-  (let (processed)
-    (dolist (field fields)
-      (let* ((field-name (car field))
-	     (type (cadr field))
-             (def  (append (list field-name)
-		    (if (eq type :pointer-self)
-			#+cmu `((* (alien:struct ,name)))
-			#-cmu `((* ,name))
-			`(,(convert-from-uffi-type type :struct))))))
-        (if variant
-          (push (list def) processed)
-          (push def processed))))
-    (nreverse processed)))
-	
-	    
-(defmacro def-struct (name &rest fields)
-  `(ccl:defrecord ,name ,@(process-struct-fields name fields nil)))
-
-
-(defmacro def-union (name &rest fields)
-  `(ccl:defrecord ,name (:variant ,@(process-struct-fields name fields t))))
-
-
-; Assuming everything is pointer based - no support for Mac handles
-(defmacro get-slot-value (obj type slot) ;use setf to set values
-   `(ccl:pref ,obj ,(read-from-string (format nil "~a.~a" type slot))))
-
-
-(defmacro get-slot-pointer (obj type slot)
-  `(ccl:%int-to-ptr (+ (ccl:%ptr-to-int ,obj) (the fixnum (ccl:field-info ,type ,slot)))))
-
-
-
-#| a few simple tests
-(def-union union
-  (l1 :long)
-  (s1 :short))
-
-(def-struct struct
-  (s1 :short)
-   (l1 :long)
-   (u1 :union))
-
-(defvar s (allocate-foreign-object :struct))
-(setf (get-slot-value s :struct :s1) 3)
-(get-slot-value s :struct :s1)
-(setf (get-slot-value s :struct :u1.s1) 5)
-(get-slot-value s :struct :u1.s1)
-
-|#
\ No newline at end of file