Hi,
I've patched cl-octave for SBCL. Tested on Mac OSX and Debian/Linux
in SBCL 1.0.2.
Somehow, the return string of my octave on Mac OSX is different to
that on Linux. I don't know whether it's the same on other's machine.
Please refer to function find-number-string-from-end and
get-as-number.
Here is the patch.
--- cl-octave.lisp 2005-11-23 18:31:01.000000000 +0900
+++ cl-octave-patched.lisp 2007-02-05 04:16:56.000000000 +0900
@@ -33,7 +33,7 @@
;;; Contact: Fred Nicolier
;;; Dept Ge2i, IUT
-;;; 9 rue de Québec
+;;; 9 rue de QuÃ(c)bec
;;; 10026 Troyes Cedex
;;; email: f.nicolier(At)iut-troyes.univ-reims.fr
;;;
@@ -63,8 +63,10 @@
(defpackage :cl-octave
(:use :common-lisp
- :extensions
- :system)
+ #+cmucl :extensions
+ #+sbcl :sb-ext
+ #+cmucl :system
+ #+sbcl :sb-sys)
(:export :start-octave
:stop-octave
:set/octave
@@ -93,7 +95,14 @@
:input :stream
:output :stream
:error :stream))
- (send "PS1=\"\";disp('ok');")
+ #+sbcl
+ (setf *octave-process* (sb-ext:run-program "octave" '("-qi")
+ :wait nil
+ :input :stream
+ :output :stream
+ :error :stream
+ :search t))
+ (send "PS1=\"\";disp('ok');")
(receive)))
(defun stop-octave ()
@@ -103,7 +112,9 @@
(process-close *octave-process*)
(setf *octave-process* nil)
#+cmu
- (ext:run-program "rm" '("-f" "cl2o.dat" "o2cl.dat"))))
+ (ext:run-program "rm" '("-f" "cl2o.dat" "o2cl.dat"))
+ #+sbcl
+ (sb-ext:run-program "rm" '("-f" "cl2o.dat" "o2cl.dat") :search t)))
;;;## Send and receive raw strings
@@ -115,7 +126,8 @@
(defun receive ()
"Read a line from octave. Can be blocking if no line is available."
- (read-line (process-output *octave-process*)))
+ (read-line (process-output *octave-process*)))
+
;;;# Send structures
@@ -146,8 +158,7 @@
(start-octave)
(let* ((elt-type (type-of (row-major-aref a 0)))
(flat-a (make-array (array-total-size a)
- :displaced-to a
- :element-type elt-type))
+ :displaced-to a))
(dims (array-dimensions a)))
(destructuring-bind (oct-fmt lisp-nb-bytes)
(if (eql elt-type 'double-float)
@@ -168,6 +179,11 @@
(system:vector-sap (coerce flat-a
`(simple-array ,elt-type (*))))
0
(* lisp-nb-bytes (length flat-a)))
+ #+sbcl
+ (sb-unix:unix-write (sb-sys:fd-stream-fd f)
+ (sb-sys:vector-sap (coerce flat-a `(simple-array ,elt-type (*))))
+ 0
+ (* lisp-nb-bytes (length flat-a)))
(eval/octave "f=fopen('cl2o.dat');"
name "=fread(f,[" (princ-to-string dimr)
" " (princ-to-string dimc)
@@ -189,9 +205,12 @@
(with-open-file (f "o2cl.dat" :direction :input :if-exists :supersede)
(let* ((length (round (get-as-number (string-cat "prod(size("
name "))"))))
(result (make-array length :element-type element-type)))
- (unix:unix-read (system:fd-stream-fd f)
+ #+cmucl (unix:unix-read (system:fd-stream-fd f)
(system:vector-sap result)
(* lisp-nb-bytes length))
+ #+sbcl (sb-unix:unix-read (sb-sys:fd-stream-fd f)
+ (sb-sys:vector-sap result)
+ (* lisp-nb-bytes length))
result))))
(defun get-reshaped-array (name &key (element-type 'single-float))
@@ -203,13 +222,25 @@
:element-type element-type
:displaced-to (get-as-array name :element-type element-type))))
+(defun find-number-string-from-end (string)
+ ;; FIXME: this is a quick hack based on the return string from
octave in Mac OSX. Its behavior is somehow different to octave on
linux
+ ;; I don't know whether '>' can be a legal output
+ ;; if so ,then this function needs modification.
+ ;; So far, it serves me well on SBCL + Mac OSX
+ (subseq string (1+ (position #\> string :from-end t))))
+
(defun get-as-number (name &key (element-type 'single-float))
(send (string-cat "printf(\"\%f\", " name ");"
"printf(\"\\n\");"
"disp(\"end\");"))
- (coerce (read-from-string (first (loop for line = (receive)
- while (string/= line "end")
- collect line)))
+ (coerce (read-from-string
+ #+darwin (first (loop for line = (receive)
+ while (string/= line "end")
+ collect line))
+ #-darwin (find-number-string-from-end
+ (first (loop for line = (receive)
+ while (string/= line "end")
+ collect line))))
element-type))
(defun get-as-complex (name &key (element-type 'single-float))
@@ -316,8 +347,9 @@
(defun string-cat (&rest args)
(apply #'concatenate 'string args))
+
;; Local Variables:
;; pbook-author: "Fred Nicolier"
;; pbbok-use-toc: t
;; pbook-style: article
-;; End:
\ No newline at end of file
+;; End:
