fixed loading issues related to configuration and packaging.
[CommonLispStat.git] / src / numerics / cffiglue.lsp
blob022e7f40aa795dbaaad1ee55d38c08a55f2c28cb
1 ;; -*- mode: lisp -*-
3 ;;; cffiglue -- Interface to C library. Based on the range of CL FFI
4 ;;; "glues" by Luke Tierney.
5 ;;;
6 ;;; Copyright (c) 1991, by Luke Tierney.
7 ;;; Copyright (c) 2007, by Carlos Ungil.
8 ;;; Copyright (c) 2007-2008, by AJ Rossini <blindglobe@gmail.com>.
9 ;;; Permission is granted for unrestricted use.
11 (in-package :lisp-stat-ffi-int)
13 ;; are there any error message components that need to be exported?
14 ;; More importantly, should we factor them out into a logging package?
16 ;; This package initially loads the liblispstat library for access.
18 (cffi:load-foreign-library
19 (concatenate 'string
20 (namestring lisp-stat-config::*lispstat-home-dir*)
21 "lib/liblispstat"
22 #+darwin ".dylib"
23 #-darwin ".so"))
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 ;;;
27 ;;; Callback Support Functions
28 ;;;
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31 (cffi:defcfun ("ccl_store_integer" ccl-store-integer)
32 :void (x :int))
33 (cffi:defcfun ("ccl_store_double" ccl-store-double)
34 :void (x :double))
35 (cffi:defcfun ("ccl_store_ptr" ccl-store-ptr)
36 :void (x :pointer))
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39 ;;;
40 ;;; XLISP Internal Error Message Emulation
41 ;;;
42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
44 (defvar *buf* (make-string 1000))
46 (defun set-buf-char (i c) (setf (elt *buf* i) (code-char c)))
48 (defun get-buf (&optional (n (position (code-char 0) *buf*)))
49 (subseq *buf* 0 n))
51 (cffi:defcfun ("register_set_buf_char" register-set-buf-char)
52 :void (p :pointer))
53 (cffi:defcallback ccl-set-buf-char :void ((n :int) (c :int))
54 (set-buf-char n c))
55 (register-set-buf-char (cffi:callback ccl-set-buf-char))
57 (cffi:defcfun ("register_print_buffer" register-print-buffer)
58 :void (p :pointer))
59 (cffi:defcallback ccl-print-buffer :void ((n :int) (type :int))
60 (case type
61 (0 (princ (get-buf n)))
62 (1 (error (get-buf n))))
64 (register-print-buffer (cffi:callback ccl-print-buffer))
66 (cffi:defcfun ("stdputstr" stdputstr)
67 :void (string :string))
68 (cffi:defcfun ("xlfail" xlfail)
69 :void (string :string))