[rdnzl-cvs] CVS RDNZL - rdnzl-cvs@common-lisp.net - mailman3.common-lisp.net

1 Feb 2006

Update of /project/rdnzl/cvsroot/RDNZL
In directory common-lisp:/tmp/cvs-serv28943
Modified Files:
    CHANGELOG.txt adapter.lisp arrays.lisp container.lisp 
    direct.lisp ffi.lisp import.lisp load.lisp packages.lisp 
    port-acl.lisp port-ccl.lisp port-clisp.lisp port-lw.lisp 
    port-sbcl.lisp rdnzl.asd reader.lisp specials.lisp util.lisp 
Log Message:
Added WIDE-CHAR support for SBCL (0.9.1)

--- /project/rdnzl/cvsroot/RDNZL/CHANGELOG.txt	2006/02/01 01:00:56	1.5
+++ /project/rdnzl/cvsroot/RDNZL/CHANGELOG.txt	2006/02/01 12:02:21	1.6
@@ -1,3 +1,7 @@
+Version 0.9.1
+2006-02-01
+Added missing WIDE-CHAR support for SBCL/Win32
+
 Version 0.9.0
 2006-02-01
 Experimental support for SBCL/Win32
--- /project/rdnzl/cvsroot/RDNZL/adapter.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/adapter.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/adapter.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/adapter.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/arrays.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/arrays.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/arrays.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/arrays.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/container.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/container.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/container.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/container.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/direct.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/direct.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/direct.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/direct.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/ffi.lisp	2006/02/01 01:00:56	1.4
+++ /project/rdnzl/cvsroot/RDNZL/ffi.lisp	2006/02/01 12:02:21	1.5
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/ffi.lisp,v 1.4 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/ffi.lisp,v 1.5 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/import.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/import.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/import.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/import.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/load.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/load.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/load.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/load.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/packages.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/packages.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/packages.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/packages.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/port-acl.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/port-acl.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/port-acl.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/port-acl.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Charles A. Cox, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/port-ccl.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/port-ccl.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/port-ccl.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/port-ccl.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/port-clisp.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/port-clisp.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/port-clisp.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/port-clisp.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Vasilis Margioulas, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/port-lw.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/port-lw.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/port-lw.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/port-lw.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/port-sbcl.lisp	2006/02/01 01:00:56	1.1
+++ /project/rdnzl/cvsroot/RDNZL/port-sbcl.lisp	2006/02/01 12:02:21	1.2
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/port-sbcl.lisp,v 1.1 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/port-sbcl.lisp,v 1.2 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
@@ -61,7 +61,8 @@
     (ffi-void-pointer 'sb-alien:system-area-pointer)
     (ffi-const-string 'sb-alien:system-area-pointer)
     (ffi-integer 'sb-alien:int)
-    (ffi-wide-char 'sb-alien:unsigned-short)
+    ;; only needed for WIDE-CHAR fake below
+    (ffi-unsigned-short 'sb-alien:unsigned-short)
     (ffi-float 'sb-alien:single-float)
     (ffi-double 'sb-alien:double-float)))
@@ -72,6 +73,8 @@
 to the C function C-NAME.  ARG-LIST is a list of (NAME TYPE)
 pairs.  All types are supposed to be symbols mappable by
 FFI-MAP-TYPE above."
+  ;; there's a more elegant way to do this - see the code in
+  ;; `port-clisp.lisp'
   (cond ((eq result-type 'ffi-boolean)
          (with-unique-names (inner-fn)
            `(progn
@@ -80,6 +83,14 @@
                                     ffi-integer)
               (defun ,lisp-name ,(mapcar #'first arg-list)
                 (not (zerop (,inner-fn ,@(mapcar #'first arg-list))))))))
+        ((eq result-type 'ffi-wide-char)
+         (with-unique-names (inner-fn)
+           `(progn
+              (ffi-define-function* (,inner-fn ,c-name)
+                                    ,arg-list
+                                    ffi-unsigned-short)
+              (defun ,lisp-name ,(mapcar #'first arg-list)
+                (code-char (,inner-fn ,@(mapcar #'first arg-list)))))))
         ((find 'ffi-boolean arg-list :key #'second)
          (with-unique-names (inner-fn)
            `(progn
@@ -98,6 +109,24 @@
                                            `(if ,name 1 0)
                                            name)))
                                      arg-list))))))
+        ((find 'ffi-wide-char arg-list :key #'second)
+         (with-unique-names (inner-fn)
+           `(progn
+              (ffi-define-function* (,inner-fn ,c-name)
+                                    ,(mapcar (lambda (name-and-type)
+                                               (destructuring-bind (name type) name-and-type
+                                                 (if (eq type 'ffi-wide-char)
+                                                   (list name 'ffi-unsigned-short)
+                                                   name-and-type)))
+                                             arg-list)
+                                    ,result-type)
+              (defun ,lisp-name ,(mapcar #'first arg-list)
+                (,inner-fn ,@(mapcar (lambda (name-and-type)
+                                       (destructuring-bind (name type) name-and-type
+                                         (if (eq type 'ffi-wide-char)
+                                           `(char-code ,name)
+                                           name)))
+                                     arg-list))))))
         (t `(sb-alien:define-alien-routine
                 (,c-name ,lisp-name) ,(ffi-map-type result-type)
               ,@(mapcar (lambda (name-and-type)
@@ -148,7 +177,7 @@
           do (write-char (code-char
                           (+ (sb-sys:sap-ref-8 pointer i)
                              (ash (sb-sys:sap-ref-8 pointer (1+ i)) 8)))
-                          out))))
+                         out))))
(defmacro ffi-get-call-by-ref-string (function object length-function)
   "Calls the foreign function FUNCTION.  FUNCTION is supposed to
--- /project/rdnzl/cvsroot/RDNZL/rdnzl.asd	2006/02/01 01:00:56	1.4
+++ /project/rdnzl/cvsroot/RDNZL/rdnzl.asd	2006/02/01 12:02:21	1.5
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/rdnzl.asd,v 1.4 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/rdnzl.asd,v 1.5 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004, Dr. Edmund Weitz.  All rights reserved.
@@ -39,7 +39,7 @@
(defsystem #:rdnzl
   :serial t
-  :version "0.9.0"
+  :version "0.9.1"
   :components ((:file "packages")
                (:file "specials")
                (:file "util")
--- /project/rdnzl/cvsroot/RDNZL/reader.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/reader.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/reader.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/reader.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/specials.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/specials.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/specials.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/specials.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.
--- /project/rdnzl/cvsroot/RDNZL/util.lisp	2006/02/01 01:00:56	1.3
+++ /project/rdnzl/cvsroot/RDNZL/util.lisp	2006/02/01 12:02:21	1.4
@@ -1,5 +1,5 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: RDNZL; Base: 10 -*-
-;;; $Header: /project/rdnzl/cvsroot/RDNZL/util.lisp,v 1.3 2006/02/01 01:00:56 eweitz Exp $
+;;; $Header: /project/rdnzl/cvsroot/RDNZL/util.lisp,v 1.4 2006/02/01 12:02:21 eweitz Exp $
;;; Copyright (c) 2004-2006, Dr. Edmund Weitz.  All rights reserved.

    