From: Sam S. <sd...@po...> - 2006-09-18 23:03:13
|
Hi, I am trying to write an FFI module interface to libsvm http://www.csie.ntu.edu.tw/~cjlin/libsvm/ the untested code is appended for comments. Specifically, why doesn't this work: (defun alist-to-nodes (alist) ;; ((index . value) ...) --> ;; C [index;value]...[-1;*] (let* ((len (length alist)) (ret (allocate-shallow 'svm_node :count (1+ len)))) (with-c-place (v ret) (loop :for i :upfrom 0 :for (index . value) :in alist :do (setf (svm_node-index (element v i)) index (svm_node-value (element v i)) value)) (setf (svm_node-index (element v len)) -1)) (foreign-value ret))) Joerg, is your patch adding :COUNT to WITH-FOREIGN-OBJECT ready? I thing it would come handy in several functions in this module. thanks. -- Sam Steingold (http://www.podval.org/~sds) on Fedora Core release 5 (Bordeaux) http://ffii.org http://palestinefacts.org http://iris.org.il http://pmw.org.il http://openvotingconsortium.org http://mideasttruth.com He who laughs last thinks slowest. (defpackage "LIBSVM" (:modern t) (:use "CL" "FFI") (:shadowing-import-from "EXPORTING" #:def-c-enum #:def-c-struct #:def-call-out #:def-c-type #:defun)) (in-package "LIBSVM") (setf (documentation (find-package "LIBSVM") 'sys::impnotes) "libsvm") (default-foreign-language :stdc) (defconstant svm-so (namestring (merge-pathnames "svm.so" *load-pathname*))) ;;; types and constants (def-c-struct svm_node (index int) (value double-float)) (def-c-struct svm_problem (l int) ; number of records (y (c-array-ptr double-float)) ; of length l (targets) (x (c-array-ptr (c-array-ptr svm_node)))) ; of length l (predictors) (def-c-enum svm_type C_SVC NU_SVC ONE_CLASS EPSILON_SVR NU_SVR) (def-c-enum kernel_type LINEAR POLY RBF SIGMOID PRECOMPUTED) (def-c-struct svm_parameter (svm_type int) (kernel_type int) (degree int) ; for poly (gamma double-float) ; for poly/rbf/sigmoid (coef0 double-float) ; for poly/sigmoid ;; these are for training only (cache_size double-float) ; in MB (eps double-float) ; stopping criteria (C double-float) ; for C_SVC, EPSILON_SVR and NU_SVR (nr_weight int) ; for C_SVC (weight_label (c-array-ptr int)) ; for C_SVC (weight (c-array-ptr double-float)) ; for C_SVC (nu double-float) ; for NU_SVC, ONE_CLASS, and NU_SVR (P double-float) ; for EPSILON_SVR (shrinking int) ; use the shrinking heuristics (probability int)) ; do probability estimates (def-c-type svm_model c-pointer) (def-call-out svm_train (:library svm-so) (:arguments (problem (c-ptr svm_problem)) (param (c-ptr svm_parameter))) (:return-type svm_model)) (ffi:def-call-out %svm_cross_validation (:name "svm_cross_validation") (:arguments (problem (c-ptr svm_problem)) (param (c-ptr svm_parameter)) (nr_fold int) (target c-pointer)) (:return-type nil) (:library svm-so)) (defun svm_cross_validation (problem param nr_fold) (with-foreign-object (target `(c-array double-float ,(svm_problem-l problem))) (%svm_cross_validation problem param nr_fold (foreign-address target)) (foreign-value target))) (def-call-out svm_save_model (:library svm-so) (:arguments (model_file_name c-string) (model svm_model)) (:return-type int)) (def-call-out svm_load_model (:library svm-so) (:arguments (model_file_name c-string)) (:return-type svm_model)) (def-call-out svm_get_svm_type (:library svm-so) (:arguments (model svm_model)) (:return-type int)) (def-call-out svm_get_nr_class (:library svm-so) (:arguments (model svm_model)) (:return-type int)) (ffi:def-call-out %svm_get_labels (:library svm-so) (:name "svm_get_labels") (:arguments (model svm_model) (label c-pointer)) (:return-type nil)) (defun svm_get_labels (model) (with-foreign-object (label `(c-array int ,(svm_get_nr_class model))) (%svm_get_labels model (foreign-address label)) (foreign-value label))) (def-call-out svm_get_svr_probability (:library svm-so) (:arguments (model svm_model)) (:return-type double-float)) (ffi:def-call-out %svm_predict_values1 (:name "svm_predict_values") (:arguments (model svm_model) (x (c-array-ptr svm_node)) (dec_values (c-ptr double-float) :out)) (:return-type nil) (:library svm-so)) (ffi:def-call-out %svm_predict_values2 (:name "svm_predict_values") (:arguments (model svm_model) (x (c-array-ptr svm_node)) (dec_values c-pointer)) (:return-type nil) (:library svm-so)) (defun svm_predict_values (model x) (case (svm_get_svm_type model) ((ONE_CLASS EPSILON_SVR NU_SVR) (%svm_predict_values1 model x)) (t (let* ((nr_class (svm_get_nr_class model)) (len (/ (* nr_class (1- nr_class)) 2))) (with-foreign-object (dec_values `(c-array double-float ,len)) (%svm_predict_values2 model x (foreign-address dec_values)) (foreign-value dec_values)))))) (def-call-out svm_predict (:library svm-so) (:arguments (model svm_model) (x (c-ptr svm_node))) (:return-type double-float)) (ffi:def-call-out %svm_predict_probability (:name "svm_predict_probability") (:arguments (model svm_model) (x (c-array-ptr svm_node)) (prob_estimates c-pointer)) (:return-type double-float) (:library svm-so)) (defun svm_predict_probability (model x) (with-foreign-object (prob_estimates `(c-array int ,(svm_get_nr_class model))) (%svm_predict_probability model x (foreign-address prob_estimates)) (foreign-value prob_estimates))) (def-call-out svm_destroy_model (:library svm-so) (:arguments (model svm_model)) (:return-type nil)) (def-call-out svm_destroy_param (:library svm-so) (:arguments (param (c-ptr svm_parameter))) (:return-type nil)) (def-call-out svm_check_parameter (:library svm-so) (:arguments (problem (c-ptr svm_problem)) (param (c-ptr svm_parameter))) (:return-type c-string)) (def-call-out svm_check_probability_model (:library svm-so) (:arguments (model svm_model)) (:return-type int)) ;;; high-level helpers (defun alist-to-nodes (alist) ;; ((index . value) ...) --> ;; C [index;value]...[-1;*] (let* ((len (length alist)) (ret (allocate-shallow 'svm_node :count (1+ len)))) (with-c-place (v ret) (loop :for i :upfrom 0 :for (index . value) :in alist :do (setf (svm_node-index (element v i)) index (svm_node-value (element v i)) value)) (setf (svm_node-index (element v len)) -1)) (foreign-value ret))) (pushnew :libsvm *features*) (provide "libsvm") (pushnew "LIBSVM" custom:*system-package-list* :test #'string=) (setf (ext:package-lock "LIBSVM") t) |
From: Sam S. <sd...@gn...> - 2006-09-19 17:05:39
|
Sam Steingold wrote: > I am trying to write an FFI module interface to libsvm > http://www.csie.ntu.edu.tw/~cjlin/libsvm/ > the untested code is appended for comments. > Specifically, why doesn't this work: > > (defun alist-to-nodes (alist) > ;; ((index . value) ...) --> > ;; C [index;value]...[-1;*] > (let* ((len (length alist)) > (ret (allocate-shallow 'svm_node :count (1+ len)))) > (with-c-place (v ret) > (loop :for i :upfrom 0 :for (index . value) :in alist :do > (setf (svm_node-index (element v i)) index > (svm_node-value (element v i)) value)) > (setf (svm_node-index (element v len)) -1)) > (foreign-value ret))) > > Joerg, is your patch adding :COUNT to WITH-FOREIGN-OBJECT ready? > I thing it would come handy in several functions in this module. I fixed alist-to-nodes, but I don't see a way to put its return value into an svm_problem, i.e., how to convert a foreign variable that points to a #(c-array double-float 4) into something that that would fit into a slot of type #(c-array-ptr double-float): (def-c-struct svm_problem (l int) ; number of records (y (c-array-ptr double-float)) ; of length l (targets) (x (c-array-ptr (c-array-ptr svm_node)))) ; of length l (predictors) (defun alist-to-nodes (alist) ;; ((index . value) ...) --> ;; C [index;value]...[-1;*] (let* ((len (length alist)) (ret (allocate-shallow 'svm_node :count (1+ len)))) (with-c-place (v ret) (loop :for i :upfrom 0 :for (index . value) :in alist :do (setf (slot (element v i) 'index) index (slot (element v i) 'value) value)) (setf (slot (element v len) 'index) -1)) ret)) (defun list-to-vector (list) (let* ((len (length list)) (ret (allocate-shallow 'double-float :count len))) (with-c-place (v ret) (loop :for i :upfrom 0 :for value :in list :do (setf (element v i) value))) ret)) (defun load-problem (file &key (out *standard-output*)) ;; load the problem object from a standard libsvm/svmlight problem file; ;; target index:value ... (let ((len 0) y x) (with-open-file (in file) (when out (format out "~&;; ~S(~S): ~:D byte~:P..." 'load-problem file (file-length in)) (force-output out)) (loop :for line = (read-line in nil nil) :while line :unless (or (zerop (length line)) (char= #\# (aref line 0))) :do (incf len) (multiple-value-bind (target pos) (read-from-string line) (push (coerce target 'double-float) y) (push (loop :with index :and value :for colon = (position #\: line :start pos) :while colon :do (multiple-value-setq (index pos) (parse-integer line :start pos :end colon)) (multiple-value-setq (value pos) (read-from-string line t nil :start (1+ colon))) :collect (cons (coerce index 'integer) (coerce value 'double-float))) x))) (when out (format out "~:D record~:P~%" len))) (let ((ret (allocate-shallow 'svm_problem))) (setf (slot (foreign-value ret) 'l) len (slot (foreign-value ret) 'y) (list-to-vector (nreverse y)) ; FIXME (slot (foreign-value ret) 'x) (alist-to-nodes (nreverse x))) ; FIXME ret))) |
From: Sam S. <sd...@gn...> - 2006-09-19 18:59:52
|
> (slot (foreign-value ret) 'y) (list-to-vector (nreverse y)) > ; FIXME > (slot (foreign-value ret) 'x) (alist-to-nodes (nreverse > x))) ; FIXME when I write (setf (slot (foreign-value ret) 'y) (foreign-value (list-to-vector (nreverse y)))) instead, I get a segfault: Program received signal SIGSEGV, Segmentation fault. 0x0818584d in DF_to_c_double (obj={one_o = 562168454}, val_=0x0) at flo_konv.d:598 598 val_->eksplicit = val; (gdb) p val $1 = {mlo = 0, semhi = 1072693248} (gdb) p val_ $2 = (dfloatjanus *) 0x0 (gdb) up #1 0x081b8f77 in convert_to_foreign (fvd={one_o = 136721950}, obj= {one_o = 562168454}, data=0x0, converter_malloc=0x81bb1fc <nomalloc>) at foreign.d:1968 1968 DF_to_c_double(obj,pdata); (gdb) list 1963 FF_to_c_float(obj,pdata); 1964 return; 1965 } else if (eq(fvd,S(double_float))) { 1966 var dfloatjanus* pdata = (dfloatjanus*) data; 1967 if (!double_float_p(obj)) goto bad_obj; 1968 DF_to_c_double(obj,pdata); 1969 return; 1970 } else if (eq(fvd,S(boolean))) { 1971 var int* pdata = (int*)data; 1972 if (nullp(obj)) (gdb) p data $3 = (void *) 0x0 clearly, there should be a check for NULL data, at least this: --- foreign.d 08 Sep 2006 06:01:08 -0400 1.158 +++ foreign.d 19 Sep 2006 14:56:41 -0400 @@ -19,6 +19,12 @@ fehler(error,GETTEXT("~S: argument is not a foreign object: ~S")); } +/* complain about NULL address */ +nonreturning_function(local, fehler_null, (object fvd, object obj)) { + pushSTACK(fvd); pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); + fehler(error,GETTEXT("~S: trying to write object ~S of type ~S into NULL address")); +} + /* Allocate a foreign address. make_faddress(base,offset) > base: base address @@ -1850,6 +1856,7 @@ global maygc void convert_to_foreign (object fvd, object obj, void* data, converter_malloc_t converter_malloc) { + if (NULL == data) fehler_null(fvd,obj); check_SP(); check_STACK(); if (symbolp(fvd)) { Jorg? |
From: Hoehle, Joerg-C. <Joe...@t-...> - 2006-09-22 12:50:15
|
Hi, >Sam Steingold wrote: >> I am trying to write an FFI module interface to libsvm >> http://www.csie.ntu.edu.tw/~cjlin/libsvm/ Often enough, I like to view at the original API documentation than at snippets of bogus code. I found http://public.procoders.net/cgi-bin/trac.cgi/browser/pcsvm/ but can't find the functions & structures that you want to interface to. > (def-c-type node (c-struct list (index int) (value double-float))) > (def-c-type problem (c-struct list > (l int) ; number of records > (y (c-array-ptr double-float)) ; of length l (targets) > (x (c-array-ptr (c-array-ptr node))))); of length l (predictors) I think I'm beginning to grasp your problem. The FFI is designed to do *once* a conversion between a foreign structure and a Lisp structure. What you're trying to do is a piecemeal conversion, one for each shallow allocation. You want to mimic C :-( That's why you run into the problem with the NULL slot pointer from your allocate-shallow. What you can do is play nice with the FFI, and build a Lisp structure that can be converted at once, using deep allocation. Play with Lisp as long as possible! You can also work piecemealwise. For that you'll need CAST to C-POINTER. Then you can SETF the CAST'ed slot to the FOREIGN-VARIABLE pointer. (SETF (CAST (SLOT problem 'y|x) 'c-pointer) #.#<FOREIGN-VARIABLE>) You can't SETF a slot to a C-ARRAY-PTR or some such to some foreign entity. Only Lisp objects (arrays) are acceptable arguments. >(defun alist-to-nodes (alist) > (loop :for i :upfrom 0 :for (index . value) :in alist :do > (setf (slot (element v i) 'index) index > (slot (element v i) 'value) value)) This still looks cumbersome. Why don't you create a Lisp vector of nodes and let the FFI convert that in one go? (allocate-deep 'problem '(1 #(2.0d0) #( (1 2.0d0) (2 5.6d0)))) Now write beautiful Lisp code to create that set of arrays. In case you dislike the duplication of knowledge about ordering of the slots of the node struct that you need to reproduce with '(1 2.0d0), you can use (def-c-struct node #) instead, use the struct constructor that handles ordering for you: (make-node :index ... :value ...) and supply and array of those objects. Regards, Jorg Hohle. |
From: Sam S. <sd...@gn...> - 2006-09-25 14:10:06
|
Hoehle, Joerg-Cyril wrote: > Hi, > >> Sam Steingold wrote: >>> I am trying to write an FFI module interface to libsvm >>> http://www.csie.ntu.edu.tw/~cjlin/libsvm/ > Often enough, I like to view at the original API documentation than at > snippets of bogus code. I found > http://public.procoders.net/cgi-bin/trac.cgi/browser/pcsvm/ > but can't find the functions & structures that you want to interface to. please look at README svm.h svm.cpp in http://www.csie.ntu.edu.tw/~cjlin/libsvm.tar.gz |
From: Sam S. <sd...@gn...> - 2006-09-25 15:19:23
|
Hi, Hoehle, Joerg-Cyril wrote: > This still looks cumbersome. Why don't you create a Lisp vector of > nodes and let the FFI convert that in one go? > (allocate-deep 'problem '(1 #(2.0d0) #( (1 2.0d0) (2 5.6d0)))) this appears to work fine. thanks. DIUC that (libsvm:train (ffi:foreign-value problem) (ffi:foreign-value f-parameter)) works by 1. converting `problem' from C to Lisp (in foreign-value) 2. converting the Lisp `problem' back to C on C stack (alloca) 3. calling the C function (svm_train) if this is actually the case, this is totally unacceptable because this means that huge objects are converted between C and Lisp for absolutely no reason. note that `problem' is likely to be megabytes in size! |
From: Sam S. <sd...@gn...> - 2006-09-25 19:45:31
|
Hi, Hoehle, Joerg-Cyril wrote: > (allocate-deep 'problem '(1 #(2.0d0) #( (1 2.0d0) (2 5.6d0)))) ok, here you go: (defun task (num divisor base) (flet ((normalize (x d) (- (/ (* 2 x) (1- d)) 1d0))) (values (normalize (rem num divisor) divisor) (do ((n num) r (ret ()) (index 0 (1+ index))) ((zerop n) (coerce (nreverse (cons (list -1 0d0) ret)) 'vector)) (multiple-value-setq (n r) (floor n base)) (let ((value (normalize r base))) (unless (zerop value) (push (list index value) ret))))))) (defun problem (repeat divisor base) (let ((x (make-array repeat)) (y (make-array repeat))) (dotimes (i repeat) (multiple-value-bind (n v) (task i divisor base) (setf (aref y i) n (aref x i) v))) (libsvm:make-problem :l repeat :x x :y y))) (defparameter f-problem-3-7 (problem 1000 3 7)) (defparameter l-problem-3-7 (ffi:foreign-value f-problem-3-7)) (second l-problem-3-7) #(-1.0d0) it should be a vector of length 1000, but it appears to be a vector of length 1! |
From: Hoehle, Joerg-C. <Joe...@t-...> - 2006-09-20 09:51:02
|
Sam Steingold wrote: >I am trying to write an FFI module interface to libsvm >http://www.csie.ntu.edu.tw/~cjlin/libsvm/ This code expresses confusion: >(defun alist-to-nodes (alist) > ;; ((index . value) ...) --> > ;; C [index;value]...[-1;*] > (let* ((len (length alist)) > (ret (allocate-shallow 'svm_node :count (1+ len)))) Foreign memory is allocated, ... > (with-c-place (v ret) > (loop :for i :upfrom 0 :for (index . value) :in alist :do > (setf (svm_node-index (element v i)) index > (svm_node-value (element v i)) value)) > (setf (svm_node-index (element v len)) -1)) ...never freed... > (foreign-value ret))) ...and converted to a native Lisp data structure -- why did you use foreign data in the first place? Maybe you wanted to operate with a handle to a foreign structure? In this case, `ret' is your handle, never (foreign-value ret). >Joerg, is your patch adding :COUNT to WITH-FOREIGN-OBJECT ready? >I thing it would come handy in several functions in this module. It's not. I can't remember whether I did not write it because of o either fear of added complexity in the C code which so far is understandable, o either not putting enough thought into the semantics of the several keyword and optional arguments, their behaviour if/not present and the semantics of defaulting values. What I mean with the latter is that I don't like macros where there's no value that's equivalent to "not supplied", i.e. where (foomacro ... :key x) can never mean the same as (foomacro ...) without the key. How would :count, :initial-value :deep/shallow interact? Such macros are awkward to handle when some unknown in advance entity produces the values to use. The :library parameter to ffi:def-call-out comes to mind as related. My original idea was that the DEF-CALL-OUT form the programmer wrote would be independent of whether on the user's machine, the library would come as built-in module or shared library. I never sat down to and wrote this. I never tested the postgresql module as is. Every time I used it I had to add (:library "...") snippets to the function declaration because I used the postgres.so shared library for my tests. Regards, Jorg Hohle. |
From: Sam S. <sd...@gn...> - 2006-09-20 13:59:50
|
Hoehle, Joerg-Cyril wrote: > Sam Steingold wrote: > >> I am trying to write an FFI module interface to libsvm >> http://www.csie.ntu.edu.tw/~cjlin/libsvm/ > > This code expresses confusion: >> (defun alist-to-nodes (alist) >> ;; ((index . value) ...) --> >> ;; C [index;value]...[-1;*] >> (let* ((len (length alist)) >> (ret (allocate-shallow 'svm_node :count (1+ len)))) > Foreign memory is allocated, ... >> (with-c-place (v ret) >> (loop :for i :upfrom 0 :for (index . value) :in alist :do >> (setf (svm_node-index (element v i)) index >> (svm_node-value (element v i)) value)) >> (setf (svm_node-index (element v len)) -1)) > ...never freed... >> (foreign-value ret))) > ...and converted to a native Lisp data structure -- why did you use > foreign data in the first place? > Maybe you wanted to operate with a handle to a foreign structure? In > this case, `ret' is your handle, never (foreign-value ret). this is an older version. I am returning "ret" now but I cannot get it into a struct slot. see http://permalink.gmane.org/gmane.lisp.clisp.general/11437 >> Joerg, is your patch adding :COUNT to WITH-FOREIGN-OBJECT ready? >> I thing it would come handy in several functions in this module. > It's not. I can't remember whether I did not write it because of > o either fear of added complexity in the C code which so far is > understandable, > o either not putting enough thought into the semantics of the several > keyword and optional arguments, their behaviour if/not present and the > semantics of defaulting values. > > What I mean with the latter is that I don't like macros where there's no > value that's equivalent to "not supplied", i.e. where > (foomacro ... :key x) can never mean the same as > (foomacro ...) without the key. yet that's how you wrote with-foreign-object et al. this is easy to fix though: since a keyword does not correspond to a foreign value, we can treat :default as "not supplied" > How would :count, :initial-value :deep/shallow interact? you are confused. now: (defmacro with-foreign-object ((var c-type &optional (init nil init-p)) &body body) ...) I want: (defmacro with-foreign-object ((var c-type &key (init :default) (count -1)) &body body) ...) where one cannot supply BOTH :init AND :count. > The :library parameter to ffi:def-call-out comes to mind as related. My > original idea was that the DEF-CALL-OUT form the programmer wrote would > be independent of whether on the user's machine, the library would come > as built-in module or shared library. I never sat down to and wrote > this. > I never tested the postgresql module as is. Every time I used it I had > to add (:library "...") snippets to the function declaration because I > used the postgres.so shared library for my tests. TRT is to combine FOREIGN-LIBRARY-FUNCTION and LOOKUP-FOREIGN-FUNCTION into FIND-FOREIGN-FUNCTION that would accept the library argument that can be NIL to mean LOOKUP-FOREIGN-FUNCTION and non-NIL to mean FOREIGN-LIBRARY-FUNCTION. |
From: Sam S. <sd...@gn...> - 2006-09-20 14:45:40
|
Sam Steingold wrote: > Hoehle, Joerg-Cyril wrote: >> The :library parameter to ffi:def-call-out comes to mind as related. My >> original idea was that the DEF-CALL-OUT form the programmer wrote would >> be independent of whether on the user's machine, the library would come >> as built-in module or shared library. I never sat down to and wrote >> this. >> I never tested the postgresql module as is. Every time I used it I had >> to add (:library "...") snippets to the function declaration because I >> used the postgres.so shared library for my tests. > > TRT is to combine FOREIGN-LIBRARY-FUNCTION and LOOKUP-FOREIGN-FUNCTION > into FIND-FOREIGN-FUNCTION that would accept the library argument that > can be NIL to mean LOOKUP-FOREIGN-FUNCTION and non-NIL to mean > FOREIGN-LIBRARY-FUNCTION. BTW, this way we can also add a compilation unit variable *default-library* whose global value would be NIL but whose value you will set to "postgresql.so" in postgresql.lisp. |
From: Hoehle, Joerg-C. <Joe...@t-...> - 2006-09-20 17:22:17
|
Sam Steingold wrote: >> TRT is to combine FOREIGN-LIBRARY-FUNCTION and=20 >LOOKUP-FOREIGN-FUNCTION=20 >> into FIND-FOREIGN-FUNCTION that would accept the library=20 >argument that=20 >> can be NIL to mean LOOKUP-FOREIGN-FUNCTION and non-NIL to mean=20 >> FOREIGN-LIBRARY-FUNCTION. This sounds exactly like what I thought of many many moons ago but never implemented. >BTW, this way we can also add a compilation unit variable=20 >*default-library* whose global value would be NIL but whose value you=20 >will set to "postgresql.so" in postgresql.lisp. Er, how will a compilation unit help? My thoughts for the macroexpansion of DEF-CALL-OUT was a run-time call. I.e. it's not until the .fas file is loaded that a decision is made. It's not at compile time that I thought about it. I concede that many people would be happy with compile time decisions. That's fine with self-compiled stuff. Possibly not enough with distributed, portable and shared .fas files. Also, I didn't put much thought into whether "find out if module shared library at run-time" is really useful and more than an experience of intellectual satisfaction. BTW, I don't like explicit "postgresql.so" in source files. a) I think people should not edit source files just to install something. That's why I dislike (defpackage ) (in-package ) (defvar *path* "foo"). Like in Emacs, the path ought to be definable before the system is loaded. Of course, the USER package could be used by convention, but certainly some people will dislike that. b) .so is certainly wrong on Darwin and SM-Windows. And I don't people to start using #+ #+ #- every time a shared library is mentioned. Oh well, that's been discussed in clsql-devel, cffi, uffi, Lispworks and likely other places sometimes. Regards, Jorg Hohle. |
From: Sam S. <sd...@gn...> - 2006-09-20 17:51:22
|
Hoehle, Joerg-Cyril wrote: > Sam Steingold wrote: >> BTW, this way we can also add a compilation unit variable >> *default-library* whose global value would be NIL but whose value you >> will set to "postgresql.so" in postgresql.lisp. > > Er, how will a compilation unit help? My thoughts for the macroexpansion > of DEF-CALL-OUT was a run-time call. I.e. it's not until the .fas file > is loaded that a decision is made. It's not at compile time that I > thought about it. similar to *foreign-language*: some things have to be known at compile time because of the need to write the C file. > BTW, I don't like explicit "postgresql.so" in source files. > a) I think people should not edit source files just to install > something. > That's why I dislike (defpackage ) (in-package ) (defvar *path* > "foo"). > Like in Emacs, the path ought to be definable before the system is > loaded. Of course, the USER package could be used by convention, but > certainly some people will dislike that. > b) .so is certainly wrong on Darwin and what about Darwin? what does this comment mean: /* FIXME: On UNIX_DARWIN, need to search for the library in /usr/lib */ > and SM-Windows. And I don't people > to start using #+ #+ #- every time a shared library is mentioned. we can modify libopen like this: --- spvw.d 01 Aug 2006 17:29:33 -0400 1.391 +++ spvw.d 20 Sep 2006 13:50:23 -0400 @@ -3470,10 +3470,20 @@ global void * libopen (const char* libname) { #if defined(WIN32_NATIVE) - return (void*)LoadLibrary(libname); + var void *lib = (void*)LoadLibrary(libname); + if (NULL != lib || strlen(libname) > MAX_PATH-5) return lib; + var char buf[MAX_PATH]; + strcpy(buf,libname); /* we KNOW that libname fits into buf! */ + strcat(buf,".dll"); + return (void*)LoadLibrary(buf); #else + var void *lib = dlopen(libname,RTLD_NOW|RTLD_GLOBAL); + if (NULL != lib || strlen(libname) > MAXPATHLEN-4) return lib; + var char buf[MAXPATHLEN]; + strcpy(buf,libname); /* we KNOW that libname fits into buf! */ + strcat(buf,".so"); /* FIXME: On UNIX_DARWIN, need to search for the library in /usr/lib */ - return dlopen(libname,RTLD_NOW|RTLD_GLOBAL); + return dlopen(buf,RTLD_NOW|RTLD_GLOBAL); #endif } > Oh well, that's been discussed in clsql-devel, cffi, uffi, Lispworks and > likely other places sometimes. and what's the conclusion? |
From: Sam S. <sd...@gn...> - 2006-09-20 22:03:18
|
how does resource management work in clisp ffi? (def-call-out destroy-param (:library svm-so) (:name "svm_destroy_param") (:arguments (param (c-ptr parameter))) (:return-type nil)) (defun destroy-parameter (parameter) (destroy-param parameter) (foreign-free parameter)) (def-c-type parameter (c-struct list (svm_type int) (kernel_type int) (degree int) ; for poly (gamma double-float) ; for poly/rbf/sigmoid (coef0 double-float) ; for poly/sigmoid ;; these are for training only (cache_size double-float) ; in MB (eps double-float) ; stopping criteria (C double-float) ; for C_SVC, EPSILON_SVR and NU_SVR (nr_weight int) ; for C_SVC (weight_label (c-array-ptr int)) ; for C_SVC (weight (c-array-ptr double-float)) ; for C_SVC (nu double-float) ; for NU_SVC, ONE_CLASS, and NU_SVR (p double-float) ; for EPSILON_SVR (shrinking int) ; use the shrinking heuristics (probability int))) ; do probability estimates when I pass a foreign-variable pointing to a `parameter' to `destroy-parameter', I get an error saying that it is not a `parameter' that `destroy-param' expects. apparently, if I write (defun destroy-parameter (parameter) (destroy-param (foreign-value parameter)) (foreign-free parameter)) it will work, but this does not make any sense: "svm_destroy_param" releases the array fields which are copied over by foreign-value and then by FOREIGN-CALL-OUT. If I write instead (def-call-out destroy-param (:library svm-so) (:name "svm_destroy_param") (:arguments (param c-pointer #|(c-ptr parameter)|#)) (:return-type nil)) it works (apparently) but looks ugly. maybe ANY foreign argument should be compatible with a FOREIGN-POINTER (including foreign variables and addresses) and work by dereferencing? |
From: Sam S. <sd...@gn...> - 2006-09-20 22:13:20
|
why does FFI:FOREIGN-FREE invalidate functions but not variables? |
From: Hoehle, Joerg-C. <Joe...@t-...> - 2006-09-20 10:10:05
|
Sam Steingold wrote: >Joerg, is your patch adding :COUNT to WITH-FOREIGN-OBJECT ready? >I thing it would come handy in several functions in this module. Why don't you use (with-foreign-object (foo `(c-array x ,(length y)) #|preinitialize if possible|#) ;; or fill it=20 ;; use it ) The advantage of this approach is that you decide whether C-ARRAY or C-ARRAY-MAX is appropriate for your needs, whereas my :COUNT feature is just a DWIM hack: always C-ARRAY except for type CHARACTER where it produces C-ARRAY-MAX to play nice with C string conventions. Such behaviour may be handy for literal uses of types, but any non-regular behaviour is a pain when using unknown types (e.g. argument values). Bak then, I weighted the tradeoff between regularity and comfort. The result is documented. Regards, Jorg Hohle. |
From: Sam S. <sd...@gn...> - 2006-09-20 14:05:18
|
Hoehle, Joerg-Cyril wrote: > Sam Steingold wrote: >> Joerg, is your patch adding :COUNT to WITH-FOREIGN-OBJECT ready? >> I thing it would come handy in several functions in this module. > > Why don't you use > (with-foreign-object (foo `(c-array x ,(length y)) > #|preinitialize if possible|#) > ;; or fill it > ;; use it > ) that's what I use now: (ffi:def-call-out %svm_predict_probability (:name "svm_predict_probability") (:arguments (model svm_model) (x (c-array-ptr svm_node)) (prob_estimates c-pointer)) (:return-type double-float) (:library svm-so)) (defun svm_predict_probability (model x) (with-foreign-object (prob_estimates `(c-array int ,(svm_get_nr_class model))) (%svm_predict_probability model x (foreign-address prob_estimates)) (foreign-value prob_estimates))) but this requires a run-time call to PARSE-C-TYPE for no good reason. S. |
From: Hoehle, Joerg-C. <Joe...@t-...> - 2006-09-20 17:33:11
|
Hi, Sam Steingold wrote: >that's what I use now: >(ffi:def-call-out %svm_predict_probability (:name=20 >"svm_predict_probability") > (:arguments (model svm_model) (x (c-array-ptr svm_node)) > (prob_estimates c-pointer)) > (:return-type double-float) (:library svm-so)) >(defun svm_predict_probability (model x) > (with-foreign-object (prob_estimates `(c-array int ,(svm_get_nr_class model))) > (%svm_predict_probability model x (foreign-address prob_estimates)) > (foreign-value prob_estimates))) Looks good. Do you feel it's convoluted? You can throw away the explicit call to FOREIGN-ADDRESS. It's documented (c-pointer type accepts any pointer). >but this requires a run-time call to PARSE-C-TYPE for no good reason. Where? The `(c-array int ,...) pattern should get optimized away by the COMPILER-MACRO. What did I miss? Regards, Jorg Hohle. |
From: Sam S. <sd...@gn...> - 2006-09-20 18:40:09
|
Hi Hoehle, Joerg-Cyril wrote: > Sam Steingold wrote: >> but this requires a run-time call to PARSE-C-TYPE for no good reason. > > Where? The `(c-array int ,...) pattern should get optimized away by the > COMPILER-MACRO. What did I miss? hmm -- nothing. sorry. indeed there are no parse-c-type calls there, but there is one in (defun alist-to-nodes (alist) ;; Lisp ((index . value) ...) --> C [index;value]...[-1;*] (let* ((len (length alist)) (ret (allocate-shallow 'node :count (1+ len)))) (with-c-place (v ret) (loop :for i :upfrom 0 :for (index . value) :in alist :do (setf (slot (element v i) 'index) index (slot (element v i) 'value) value)) (setf (slot (element v len) 'index) -1)) ret)) why? |
From: Sam S. <sd...@gn...> - 2006-09-20 18:41:47
|
so, what is wrong with this code: (def-c-type node (c-struct list (index int) (value double-float))) (def-c-type problem (c-struct list (l int) ; number of records (y (c-array-ptr double-float)) ; of length l (targets) (x (c-array-ptr (c-array-ptr node))))); of length l (predictors) (defun alist-to-nodes (alist) ;; Lisp ((index . value) ...) --> C [index;value]...[-1;*] (let* ((len (length alist)) (ret (allocate-shallow 'node :count (1+ len)))) (with-c-place (v ret) (loop :for i :upfrom 0 :for (index . value) :in alist :do (setf (slot (element v i) 'index) index (slot (element v i) 'value) value)) (setf (slot (element v len) 'index) -1)) ret)) (defun list-to-vector (list) ;; Lisp list --> C array (let* ((len (length list)) (ret (allocate-shallow 'double-float :count len))) (with-c-place (v ret) (loop :for i :upfrom 0 :for value :in list :do (setf (element v i) value))) ret)) (defun make-problem (&key l y x) (let ((ret (allocate-shallow 'problem))) (setf (slot (foreign-value ret) 'l) l (slot (foreign-value ret) 'y) (offset (foreign-value (list-to-vector y)) 0 `(c-array double-float ,l)) ; FIXME!! (slot (foreign-value ret) 'x) (offset (foreign-value (alist-to-nodes x)) 0 `(c-array (c-ptr node) ,l))) ; FIXME!! ret)) |
From: Sam S. <sd...@gn...> - 2006-09-21 20:42:06
|
if I replace c-array-ptr with c-pointer and write (setf (slot (foreign-value ret) 'y) (list-to-vector y))) it appears to work - but this is somewhat ugly... Sam Steingold wrote: > so, what is wrong with this code: > > (def-c-type node (c-struct list (index int) (value double-float))) > (def-c-type problem (c-struct list > (l int) ; number of records > (y (c-array-ptr double-float)) ; of length l (targets) > (x (c-array-ptr (c-array-ptr node))))); of length l (predictors) > > (defun alist-to-nodes (alist) > ;; Lisp ((index . value) ...) --> C [index;value]...[-1;*] > (let* ((len (length alist)) > (ret (allocate-shallow 'node :count (1+ len)))) > (with-c-place (v ret) > (loop :for i :upfrom 0 :for (index . value) :in alist :do > (setf (slot (element v i) 'index) index > (slot (element v i) 'value) value)) > (setf (slot (element v len) 'index) -1)) > ret)) > > (defun list-to-vector (list) > ;; Lisp list --> C array > (let* ((len (length list)) (ret (allocate-shallow 'double-float > :count len))) > (with-c-place (v ret) > (loop :for i :upfrom 0 :for value :in list :do > (setf (element v i) value))) > ret)) > > (defun make-problem (&key l y x) > (let ((ret (allocate-shallow 'problem))) > (setf (slot (foreign-value ret) 'l) l > (slot (foreign-value ret) 'y) > (offset (foreign-value (list-to-vector y)) 0 > `(c-array double-float ,l)) ; FIXME!! > (slot (foreign-value ret) 'x) > (offset (foreign-value (alist-to-nodes x)) 0 > `(c-array (c-ptr node) ,l))) ; FIXME!! > ret)) > |
From: Sam S. <sd...@gn...> - 2006-10-04 13:13:43
|
Sam Steingold wrote: > I am trying to write an FFI module interface to libsvm > http://www.csie.ntu.edu.tw/~cjlin/libsvm/ the code is now in the CVS. it includes libsvm sources and README. I would appreciate testing and comments. thanks. Sam. |
From: Sam S. <sd...@gn...> - 2006-10-04 15:22:10
|
clisp libsvm module is now in the CVS. comments (or, better yet - PATCHES!) are welcome thanks Sam. |
From: Hoehle, Joerg-C. <Joe...@t-...> - 2006-10-05 18:25:30
|
Sam Steingold wrote: >clisp libsvm module is now in the CVS. >comments (or, better yet - PATCHES!) are welcome o Ad destroy-problem: allocate-deep should be matched with foreign-free :FULL T explicitly o Your use of (setf (validp problem)/(validp parameter) nil) is excellent. Users will get an error, not a crash from trying to use a problem after destroy-problem. Why don't you do the same for the model? That you receive the model pointer as result from a call to svm_train() instead of doing it yourself via allocate-deep is no reason. I created the SET-FOREIGN-POINTER API explicitly so that a resource pointer returned via FFI can be dissociated from the unique FFI session pointer. Afterwards, you'll be able to call (setf (validp model) nil) equally. Just wrap the call to the constructor. (defun train () (set-foreign-pointer (ffi_train) :copy)) Once you have that, you can use FINALIZE on the model. You could even use FINALIZE's guarded form to make some dependency explicit: (FINALIZE MODEL PROBLEM) With the guarded form, you may be able to add a finalizer for PROBLEM itself, but I've never used the guarded form... With all three finalizers in place, it would look very Lispy & cool. o svm_cross_validation :args (c-ptr problem) Everytime you use (c-ptr problem), there's full conversion taking place. Are you sure that's what you intended? Did you mean (c-pointer problem) instead? Same for (c-ptr parameter) o defun cross_validation (with-foreign-object (target #) ... (foreign-value target)) (with-c-var (target #) ... target) would be clearer I think. I prefer to use with-c-var whenever possible. Same for get-labels, predict-probability o test.tst: (SLOT (FOREIGN-VALUE #)) is abstraction violation Please use (WITH-C-PLACE (p-parameter f-parameter) (setf (slot p-parameter 'gamma) 0d0) instead. Note that all your defun WITH-FOREIGN-OBJECT wrappers fit the pattern that I suggested long ago (and never implemented) (def-call-out predict_probabilty :arguments (model model) (prob_estimates (c-ptr (c-array int (SIZE (get-nr-class model)))) :out)) The wrappers could be generated via a macro that would understand such extended type declarations. All in all, the code looks very clean. It makes me wonder, "what was the problem?" Regards, Jorg Hohle. |
From: Sam S. <sd...@gn...> - 2006-10-05 19:33:21
|
Hoehle, Joerg-Cyril wrote: > > o svm_cross_validation :args (c-ptr problem) > Everytime you use (c-ptr problem), there's full conversion taking place. > Are you sure that's what you intended? > Did you mean (c-pointer problem) instead? yes, probably -- but does (c-pointer problem) provide type-checking? > Same for (c-ptr parameter) parameter is small enough for this not to matter too much > (SLOT (FOREIGN-VALUE #)) is abstraction violation > Please use > (WITH-C-PLACE (p-parameter f-parameter) > (setf (slot p-parameter 'gamma) 0d0) > instead. I also have (defun cross-validation (problem param nr_fold) (with-foreign-object (target `(c-array double-float ,(slot (foreign-value problem) 'l))) (svm_cross_validation (foreign-value problem) param nr_fold target) (foreign-value target))) this is eminently wrong because (foreign-value problem) converts potentially HUGE datum from lisp to C. what is the right replacement? I think each problem variable should be opaque (c-pointer problem) and there should be functions problem-l problem-y problem-x problem-y-i -- non-consing, returns float problem-x-i problem-x-i-j -- non-consing, returns float how do I implement them? thanks for your feedback (and your kind words) |
From: Sam S. <sd...@gn...> - 2006-10-05 19:53:07
|
Hoehle, Joerg-Cyril wrote: > > Once you have that, you can use FINALIZE on the model. You could even > use FINALIZE's guarded form to make some dependency explicit: > (FINALIZE MODEL PROBLEM) > With the guarded form, you may be able to add a finalizer for PROBLEM > itself, but I've never used the guarded form... guarding works in the other direction, I think. I want PROBLEM not to be GCed until MODEL is. |