src/objects.cl

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          objects.cl
   6 ;;;; Purpose:       UFFI source to handle objects and pointers
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Feb 2002
   9 ;;;;
  10 ;;;; Copyright (c) 2002 Kevin M. Rosenberg
  11 ;;;;
  12 ;;;; $Id: objects.cl,v 1.1 2002/03/09 19:55:33 kevin Exp $
  13 ;;;;
  14 ;;;; This file is part of the UFFI.
  15 ;;;;
  16 ;;;; UFFI is free software; you can redistribute it and/or modify
  17 ;;;; it under the terms of the GNU General Public License (version 2) as
  18 ;;;; published by the Free Software Foundation.
  19 ;;;;
  20 ;;;; UFFI is distributed in the hope that it will be useful,
  21 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;;;; GNU General Public License for more details.
  24 ;;;;
  25 ;;;; You should have received a copy of the GNU General Public License
  26 ;;;; along with UFFI; if not, write to the Free Software
  27 ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  28 ;;;; *************************************************************************
  29
  30 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
  31 (in-package :uffi)
  32
  33 (defmacro allocate-foreign-object (type)
  34   #+cmu
  35   `(alien:make-alien ,(convert-from-uffi-type type :allocation))
  36   #+lispworks
  37   `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate))
  38   #+allegro
  39   `(ff:allocate-fobject ',(convert-from-uffi-type type :allocate) :c)
  40   )
  41
  42 (defmacro free-foreign-object (obj)
  43   #+cmu
  44   `(alien:free-alien ,obj)
  45   #+lispworks
  46   `(fli:free-foreign-object ,obj)
  47   #+allegro
  48   `(ff:free-fobject ,obj)
  49   )
  50
  51 (defmacro null-pointer-p (obj)
  52   #+lispworks `(fli:null-pointer-p ,obj)
  53   #+allegro `(zerop ,obj)
  54   #+cmu   `(alien:null-alien ,obj)
  55   )
  56
  57 (def-constant +null-c-string-pointer+
  58     #+cmu nil
  59     #+allegro 0
  60     #+lispworks (fli:make-pointer :address 0 :type '(:unsigned :char)))
  61
  62 (defmacro make-null-pointer (type)
  63   #+(or allegro cmu) (declare (ignore type))
  64
  65   #+cmu `(system:int-sap 0)
  66   #+allegro 0
  67   #+lispworks `(fli:make-pointer :address 0 :type ,type)
  68   )
  69
  70 (defmacro deref-pointer (ptr type)
  71   "Returns a object pointed"
  72   #+(or lispworks cmu) (declare (ignore type))
  73   #+cmu  `(alien:deref ,ptr)
  74   #+lispworks `(fli:dereference ,ptr)
  75   #+allegro `(ff:fslot-value-typed ,type :c ,ptr)
  76   )
  77
  78 (defmacro pointer-address (obj)
  79   #+cmu
  80   `(system:sap-int (alien:alien-sap ,obj))
  81   #+lispworks
  82   `(fli:pointer-address ,obj)
  83   #+allegro
  84   obj
  85   )