CMUCL commit: src/code (unix.lisp)

[Raymond Toy]

    Date: Thursday, October 15, 2009 @ 15:36:09
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/code

Modified: unix.lisp

UNIX-SYSINFO was broken for Unicode builds, which made MACHINE-TYPE
and MACHINE-VERSION return incorrect values on Solaris.  Rewrite it to
work for both unicode and non-unicode builds, thereby fixing
MACHINE-TYPE and MACHINE-VERSION.


-----------+
 unix.lisp |   28 ++++++++++++++++------------
 1 file changed, 16 insertions(+), 12 deletions(-)


Index: src/code/unix.lisp
diff -u src/code/unix.lisp:1.124 src/code/unix.lisp:1.125
--- src/code/unix.lisp:1.124	Thu Oct 15 10:07:35 2009
+++ src/code/unix.lisp	Thu Oct 15 15:36:08 2009
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/unix.lisp,v 1.124 2009-10-15 14:07:35 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/unix.lisp,v 1.125 2009-10-15 19:36:08 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -3408,11 +3408,6 @@
 
 #+(and solaris svr4)
 (progn
-(def-alien-routine sysinfo long
-  (command int)
-  (buf c-string)
-  (count long))
-
 ;; From sys/systeminfo.h.  We don't list the set values here.
 (def-enum + 1
   si-sysname si-hostname si-release si-version si-machine
@@ -3421,12 +3416,21 @@
 (def-enum + 513
   si-platform si-isalist si-dhcp-cache)
 
+
 (defun unix-sysinfo (command)
-  (let* ((count 2048)			; Hope this is long enough!
-	 (buf (make-string count))
-	 (result (sysinfo command buf count)))
-    (when (>= result 0)
-      (subseq buf 0 (1- result)))))
+  ;; Hope a buffer of length 2048 is long enough.
+  (with-alien ((buf (array c-call:unsigned-char 2048)))
+    (let ((result
+	   (alien-funcall
+	    (extern-alien "sysinfo"
+			  (function c-call:int
+				    c-call:int
+				    c-call:c-string
+				    c-call:int))
+	    command
+	    (cast buf (* c-call:char))
+	    2048)))
+      (when (>= result 0)
+	(cast buf c-call:c-string)))))
 )
-
 ;; EOF