X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fmcl%2Fprimitives.cl;fp=src%2Fmcl%2Fprimitives.cl;h=4dac95437d62164bc9d328c8e9f7a59db3b9c2fb;hb=93d37518cbd27aa8b7f313bb89b9523d5a40ec88;hp=0000000000000000000000000000000000000000;hpb=6aca6ef38f1f406c9e7987e46cbaca3299c487fb;p=uffi.git

diff --git a/src/mcl/primitives.cl b/src/mcl/primitives.cl
new file mode 100644
index 0000000..4dac954
--- /dev/null
+++ b/src/mcl/primitives.cl
@@ -0,0 +1,91 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          primitives.cl
+;;;; Purpose:       UFFI source to handle immediate types
+;;;; Programmers:   Kevin M. Rosenberg and John DeSoi
+;;;; Date Started:  Feb 2002
+;;;;
+;;;; $Id: primitives.cl,v 1.6 2002/08/23 15:28:11 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)
+
+; Wrapper for unexported function we have to use
+(defmacro def-mcl-type (name type)
+  `(ccl::def-mactype (quote ,name) (ccl:find-mactype ,type)))
+
+
+(defmacro def-constant (name value &key (export nil))
+  "Macro to define a constant and to export it"
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (defconstant ,name ,value)
+     ,(if export (list 'export `(quote ,name)) (values))))
+
+(defmacro def-type (name type)
+  "Generates a (deftype) statement for CL. Currently, only CMUCL
+supports takes advantage of this optimization."
+  (declare (ignore type))
+  `(deftype ,name () t))
+
+(defmacro null-char-p (val)
+  "Returns T if character is NULL"
+  `(zerop ,val))
+      
+
+(defmacro def-foreign-type (name type)
+ `(def-mcl-type ,name (convert-from-uffi-type ,type :type)))
+
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar +type-conversion-hash+ (make-hash-table :size 20)))
+
+
+(defconstant +type-conversion-list+ 
+    '((* . :pointer) (:void . :void)
+      (:short . :short)
+      (:pointer-void . :pointer)
+      (:cstring . :string) 
+      (:char . :character)
+      (:unsigned-char . :unsigned-byte)
+      (:byte . :byte)
+      (:int . :integer) (:unsigned-int . :unsigned-integer) 
+      (:long . :long) (:unsigned-long . :unsigned-long)
+      (:float . :single-float) (:double . :double-float)
+      (:array . :array)))
+
+(dolist (type +type-conversion-list+)
+  (setf (gethash (car type) +type-conversion-hash+) (cdr type)))
+
+
+(defmethod ph (&optional (os *standard-output*))
+  (maphash #'(lambda (k v) (format os "~&~S => ~S" k v)) +type-conversion-hash+))
+
+(defun convert-from-uffi-type (type context)
+  "Converts from a uffi type to an implementation specific type"
+  (if (atom type)
+      (cond
+       #+mcl
+       ((and (eq type :void) (eq context :return)) nil)
+       (t
+	(let ((found-type (gethash type +type-conversion-hash+)))
+	  (if found-type
+	      found-type
+	    type))))
+    (cons (convert-from-uffi-type (first type) context) 
+	  (convert-from-uffi-type (rest type) context))))
+
+
+
+
+
+