cffiglue.lsp

   1 ;;  -*- mode: lisp -*-
   2
   3 ;;;; cffiglue -- Interface to C library
   4 ;;;;
   5 ;;;; Copyright (c) 1991, by Luke Tierney.
   6 ;;;; Copyright (c) 2007, by Carlos Ungil.
   7 ;;;; Copyright (c) 2007, by AJ Rossini <blindglobe@gmail.com>.
   8 ;;;; Permission is granted for unrestricted use.
   9
  10 ;;;; Tested (but the results have not been checked):
  11 ;;;;    Probability Distributions
  12 ;;;;    Internal Error Message Emulation
  13 ;;;;    Matrix Manipulation
  14
  15 ;;;; Untested
  16 ;;;;    numgrad numhess minfo-maximize
  17
  18 (defpackage :lisp-stat-ffi-int
  19   (:use :common-lisp
  20         :cffi)
  21   (:export ccl-store-integer ccl-store-double ccl-store-ptr))
  22
  23 ;; are there any error message components that need to be exported?
  24 ;; More importantly, should we factor them out into a logging package?
  25
  26 ;; This package initially loads the liblispstat library for access.
  27
  28
  29 ;; formerly exported:
  30
  31 #|
  32    chol-decomp-front
  33    lu-decomp-front lu-solve-front
  34    sv-decomp-front
  35    qr-decomp-front
  36
  37    rcondest-front
  38    make-rotation-front
  39
  40    eigen-front
  41
  42    la-range-to-rseq
  43    spline-front
  44
  45    kernel-dens-front
  46    kernel-smooth-front
  47
  48    base-lowess-front
  49
  50    numgrad-front
  51    numhess-front
  52    base-minfo-maximize
  53
  54    one-uniform-rand
  55    base-log-gamma
  56
  57    base-normal-cdf
  58    base-normal-quant
  59    base-normal-dens
  60    one-normal-rand
  61    base-bivnorm-cdf
  62
  63    base-cauchy-cdf
  64    base-cauchy-quant
  65    base-cauchy-dens
  66    one-cauchy-rand
  67
  68    base-gamma-cdf
  69    base-gamma-quant
  70    base-gamma-dens
  71    one-gamma-rand
  72
  73    base-chisq-cdf
  74    base-chisq-quant
  75    base-chisq-dens
  76    one-chisq-rand
  77
  78    base-beta-cdf
  79    base-beta-quant
  80    base-beta-dens
  81    one-beta-rand
  82
  83    base-t-cdf
  84    base-t-quant
  85    base-t-dens
  86    one-t-rand
  87
  88    base-f-cdf
  89    base-f-quant
  90    base-f-dens
  91    one-f-rand
  92
  93    base-poisson-cdf
  94    base-poisson-quant
  95    base-poisson-dens
  96    one-poisson-rand
  97
  98    base-binomial-cdf
  99    base-binomial-quant
 100    base-binomial-dens
 101    one-binomial-rand
 102 |#
 103
 104 (in-package :lisp-stat-ffi-int)
 105
 106 (cffi:load-foreign-library
 107  (concatenate 'string
 108               (namestring cl-user::*lispstat-home-dir*)
 109               "lib/liblispstat"
 110               #+darwin ".dylib"
 111               #-darwin ".so"))
 112
 113 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 114 ;;;
 115 ;;;                     Callback Support Functions
 116 ;;;
 117 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 118
 119 (cffi:defcfun ("ccl_store_integer" ccl-store-integer)
 120     :void (x :int))
 121 (cffi:defcfun ("ccl_store_double" ccl-store-double)
 122     :void (x :double))
 123 (cffi:defcfun ("ccl_store_ptr" ccl-store-ptr)
 124     :void (x :pointer))
 125
 126 ;;;
 127 ;;;                  Lisp-Managed Calloc/Free
 128 ;;;
 129
 130 ;;; this section is commented out in mclglue.lsp
 131 ;;; and the relevant fragment in cffi-glue.c is not compiled (ifdef DODO)
 132
 133
 134
 135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 136 ;;;
 137 ;;;                 XLISP Internal Error Message Emulation
 138 ;;;
 139 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 140
 141 (defvar *buf* (make-string 1000))
 142
 143 (defun set-buf-char (i c) (setf (elt *buf* i) (code-char c)))
 144
 145 (defun get-buf (&optional (n (position (code-char 0) *buf*)))
 146   (subseq *buf* 0 n))
 147
 148 (cffi:defcfun ("register_set_buf_char" register-set-buf-char)
 149     :void (p :pointer))
 150 (cffi:defcallback ccl-set-buf-char :void ((n :int) (c :int))
 151   (set-buf-char n c))
 152 (register-set-buf-char (cffi:callback ccl-set-buf-char))
 153
 154 (cffi:defcfun ("register_print_buffer" register-print-buffer)
 155     :void (p :pointer))
 156 (cffi:defcallback ccl-print-buffer :void ((n :int) (type :int))
 157   (case type
 158     (0 (princ (get-buf n)))
 159     (1 (error (get-buf n))))
 160   n)
 161 (register-print-buffer (cffi:callback ccl-print-buffer))
 162
 163 (cffi:defcfun ("stdputstr" stdputstr)
 164     :void (string :string))
 165 (cffi:defcfun ("xlfail" xlfail)
 166     :void (string :string))
 167
 168
 169
 170