X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fmcl%2Fprimitives.cl;fp=src%2Fmcl%2Fprimitives.cl;h=0000000000000000000000000000000000000000;hb=e59d8c7edc1d6b3d3e1f8351c8d9a58bff19030a;hp=4dac95437d62164bc9d328c8e9f7a59db3b9c2fb;hpb=93d37518cbd27aa8b7f313bb89b9523d5a40ec88;p=uffi.git diff --git a/src/mcl/primitives.cl b/src/mcl/primitives.cl deleted file mode 100644 index 4dac954..0000000 --- a/src/mcl/primitives.cl +++ /dev/null @@ -1,91 +0,0 @@ -;;;; -*- 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)))) - - - - - -