Skip to content
Snippets Groups Projects
Commit b3c65d75 authored by Liam Healy's avatar Liam Healy
Browse files

Port to non-native implementation and CLISP

Make functional for non-native CL implementation, with allocation of C
arrays and correct copying between CL and C sides.  Testbed for this
is CLISP, but CLISP has several problems which may be a problem with
the GSLL code or may be in CLISP:
 - need to set sys::*inhibit-floating-point-underflow*
 - CLISP doesn't see defconstant defined when it's used in the same file
 - many tests give "Program stack overflow" error and debugging
    procedure not clear
 - failure on amd64 bit platform
parent 38ddfa1a
No related branches found
No related tags found
No related merge requests found
;; Foreign arrays (usually in C)
;; Liam Healy 2008-12-28 10:44:22EST foreign-array.lisp
;; Time-stamp: <2008-12-28 15:53:06EST foreign-array.lisp>
;; Time-stamp: <2008-12-28 21:39:02EST foreign-array.lisp>
;; $Id: $
(in-package :gsl)
......@@ -49,6 +49,12 @@
(setf cl-array ffa
dimensions (array-dimensions ffa)
total-size (array-total-size ffa)))
#-native
(let ((cptr (cffi:foreign-alloc
(cl-cffi (element-type object))
:count (total-size object))))
(setf (c-pointer object) cptr)
(tg:finalize object (lambda () (cffi:foreign-free cptr))))
#-native (setf (cl-invalid object) nil)
(multiple-value-bind (oa index-offset)
(find-original-array (cl-array object))
......@@ -91,9 +97,9 @@
(copy-array-to-pointer
(cl-array object)
(c-pointer object)
(component-type (element-type object))
(element-type object)
0
(component-size object))
(total-size object))
(setf (c-invalid object) nil)))
;;; Called right before maref
......@@ -104,9 +110,9 @@
(copy-array-from-pointer
(cl-array object)
(c-pointer object)
(component-type (element-type object))
(element-type object)
0
(component-size object))
(total-size object))
(setf (cl-invalid object) nil)))
#-native
......@@ -115,11 +121,9 @@
lisp-type to the memory area that starts at pointer, coercing the
elements if necessary."
(let ((cffi-type (component-type lisp-type)))
(loop
for pointer-index :from 0
:below (if (subtypep lisp-type 'complex) (* 2 length) length)
:by (if (subtypep lisp-type 'complex) 2 1)
(loop :repeat length
for array-index :from index-offset
for pointer-index :from 0 :by (if (subtypep lisp-type 'complex) 2 1)
do
(if (subtypep lisp-type 'complex)
(setf (cffi:mem-aref pointer cffi-type pointer-index)
......@@ -135,10 +139,8 @@
lisp-type from the memory area that starts at pointer, coercing the
elements if necessary."
(let ((cffi-type (component-type lisp-type)))
(loop
for pointer-index :from 0
:below (if (subtypep lisp-type 'complex) (* 2 length) length)
:by (if (subtypep lisp-type 'complex) 2 1)
(loop :repeat length
for pointer-index :from 0 :by (if (subtypep lisp-type 'complex) 2 1)
for array-index :from index-offset
do
(setf (row-major-aref array array-index)
......
;; IEEE 754 Modes and masks
;; Liam Healy 2008-01-29 21:35:50EST ieee-modes.lisp
;; Time-stamp: <2008-02-17 18:36:37EST ieee-modes.lisp>
;; Time-stamp: <2008-12-28 20:59:16EST ieee-modes.lisp>
;; $Id$
(in-package :gsl)
......@@ -30,3 +30,6 @@
((cffi:foreign-enum-value 'ieee-mask exception-mask) :int))
:documentation
"Set the IEEE 754 precision, rounding mode, and exception mask.")
#+clisp
(setf sys::*inhibit-floating-point-underflow* t)
;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2008-12-28 18:25:33EST mobject.lisp>
;; Time-stamp: <2008-12-28 20:45:50EST mobject.lisp>
;; $Id$
;;; GSL objects are represented in GSLL as and instance of a 'mobject.
......@@ -151,5 +151,7 @@
"Create a contents list from the GSL object of type struct-type
referenced by pointer."))
;;; CLISP bug? doesn't know about +foreign-pointer-class+ defined above
#-clisp
(defmethod mpointer ((object #.+foreign-pointer-class+))
object)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment