From jianshi.huang at gmail.com  Sun Feb  4 19:20:42 2007
From: jianshi.huang at gmail.com (Huang Jianshi)
Date: Mon, 5 Feb 2007 04:20:42 +0900
Subject: [cl-octave-devel] patch for SBCL
Message-ID: <28b25c50702041120v5df4f0abwb73ca4f63bbd8ef@mail.gmail.com>

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: