Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv10991

Modified Files:
	NEWS version.lisp-expr 
Log Message:
1.0.1.6:
        Better error checking for incompatible stream / sequence types in
        READ-SEQUENCE and WRITE-SEQUENCE. (Patch by Tony Martinez, sbcl-devel
        2006-12-05).


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.1122
retrieving revision 1.1123
diff -u -d -r1.1122 -r1.1123
--- NEWS	27 Dec 2006 00:37:30 -0000	1.1122
+++ NEWS	29 Dec 2006 01:41:11 -0000	1.1123
@@ -5,6 +5,11 @@
     to use.
   * improvement: support for GBK external format.
     (thanks to Chun Tian (binghe))
+  * bug fix: an error is signaled for attempts to use READ-SEQUENCE
+    for a (SIGNED-BYTE 8) stream and (UNSIGNED-BYTE 8) vector, or vice versa.
+    (thanks to Tony Martinez)
+  * bug fix: the initforms for DEFMETHOD &AUX parameters are only
+    evaluated once (reported by Kevin Reid)
 
 changes in sbcl-1.0.1 relative to sbcl-1.0:
   * new platform: FreeBSD/x86-64, including support for threading.

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3148
retrieving revision 1.3149
diff -u -d -r1.3148 -r1.3149
--- version.lisp-expr	29 Dec 2006 01:01:51 -0000	1.3148
+++ version.lisp-expr	29 Dec 2006 01:41:11 -0000	1.3149
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.1.5"
+"1.0.1.6"

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv10991/tests

Modified Files:
	stream.impure.lisp 
Log Message:
1.0.1.6:
        Better error checking for incompatible stream / sequence types in
        READ-SEQUENCE and WRITE-SEQUENCE. (Patch by Tony Martinez, sbcl-devel
        2006-12-05).


Index: stream.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/stream.impure.lisp,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- stream.impure.lisp	26 Aug 2005 21:09:04 -0000	1.15
+++ stream.impure.lisp	29 Dec 2006 01:41:12 -0000	1.16
@@ -178,5 +178,141 @@
                               (by-out size byte) (by-out size nb))))))
     (delete-file file-name)))
 (loop for size from 2 to 40 do (bin-stream-test :size size :type 'signed-byte))
+
+;;; Check READ-SEQUENCE signals a TYPE-ERROR when the sequence can't
+;;; contain a stream element.
+;;;
+;;; These tests check READ-SEQUENCE correctness, not whether the fast
+;;; or slow paths are being taken for each element type.  To check the
+;;; fast or slow paths, trace ANSI-STREAM-READ-BYTE (slow path) and/or
+;;; READ-N-BYTES:
+;;;
+;;; (trace sb-impl::ansi-stream-read-byte sb-impl::read-n-bytes)
+;;;
+;;; The order should be ANSI-STREAM-READ-BYTE, READ-N-BYTES,
+;;; READ-N-BYTES, ANSI-STREAM-READ-BYTE, ANSI-STREAM-READ-BYTE.
+
+(let ((pathname "read-sequence.data"))
+
+  ;; Create the binary data.
+  (with-open-file (stream pathname
+                          :direction :output
+                          :if-exists :supersede
+                          :element-type '(unsigned-byte 8))
+    (write-byte 255 stream))
+
+  ;; Check the slow path for generic vectors.
+  (let ((sequence (make-array 1)))
+    (with-open-file (stream pathname
+                            :direction :input
+                            :element-type '(unsigned-byte 8))
+    (read-sequence sequence stream)
+    (assert (equalp sequence #(255)))))
+
+  ;; Check the fast path works for (UNSIGNED-BYTE 8) and (SIGNED-BYTE
+  ;; 8) vectors.
+  (let ((sequence (make-array 1 :element-type '(unsigned-byte 8))))
+    (with-open-file (stream pathname
+                            :direction :input
+                            :element-type '(unsigned-byte 8))
+      (read-sequence sequence stream)
+      (assert (equalp sequence #(255)))))
+
+  (let ((sequence (make-array 1 :element-type '(signed-byte 8))))
+    (with-open-file (stream pathname
+                            :direction :input
+                            :element-type '(signed-byte 8))
+    (read-sequence sequence stream)
+    (assert (equalp sequence #(-1)))))
+
+  ;; Check that a TYPE-ERROR is signalled for incompatible (sequence,
+  ;; stream) pairs.
+
+  (let ((sequence (make-array 1 :element-type '(signed-byte 8))))
+    (with-open-file (stream pathname
+                            :direction :input
+                            :element-type '(unsigned-byte 8))
+      (handler-case (progn
+                      (read-sequence sequence stream)
+                      (error "READ-SEQUENCE didn't signal an error"))
+        (type-error (condition)
+          (assert (= (type-error-datum condition) 255))
+          (assert (subtypep (type-error-expected-type condition)
+                            '(signed-byte 8)))))))
+
+  (let ((sequence (make-array 1 :element-type '(unsigned-byte 8))))
+    (with-open-file (stream pathname
+                            :direction :input
+                            :element-type '(signed-byte 8))
+      (handler-case (progn
+                      (read-sequence sequence stream)
+                      (error "READ-SEQUENCE didn't signal an error"))
+        (type-error (condition)
+          (assert (= (type-error-datum condition) -1))
+          (assert (subtypep (type-error-expected-type condition)
+                            '(unsigned-byte 8))))))))
+
+;;; Check WRITE-SEQUENCE signals a TYPE-ERROR when the stream can't
+;;; write a sequence element.
+;;;
+;;; These tests check WRITE-SEQUENCE correctness, not whether the fast
+;;; or slow paths are being taken for each element type.  See the
+;;; READ-SEQUENCE tests above for more information.
+;;;
+;;; (trace sb-impl::output-unsigned-byte-full-buffered sb-impl::output-signed-byte-full-buffered sb-impl::output-raw-bytes)
+
+(let ((pathname "write-sequence.data")
+      (generic-sequence (make-array 1 :initial-contents '(255)))
+      (unsigned-sequence (make-array 1
+                                     :element-type '(unsigned-byte 8)
+                                     :initial-contents '(255)))
+      (signed-sequence (make-array 1
+                                   :element-type '(signed-byte 8)
+                                   :initial-contents '(-1))))
+  ;; Check the slow path for generic vectors.
+  (with-open-file (stream pathname
+                           :direction :output
+                           :if-exists :supersede
+                           :element-type '(unsigned-byte 8))
+    (write-sequence generic-sequence stream))
+
+  ;; Check the fast path for unsigned and signed vectors.
+  (with-open-file (stream pathname
+                          :direction :output
+                          :if-exists :supersede
+                          :element-type '(unsigned-byte 8))
+    (write-sequence unsigned-sequence stream))
+
+  (with-open-file (stream pathname
+                          :direction :output
+                          :if-exists :supersede
+                          :element-type '(signed-byte 8))
+    (write-sequence signed-sequence stream))
+
+  ;; Check a TYPE-ERROR is signalled for unsigned and signed vectors
+  ;; which are incompatible with the stream element type.
+  (with-open-file (stream pathname
+                          :direction :output
+                          :if-exists :supersede
+                          :element-type '(signed-byte 8))
+    (handler-case (progn
+                    (write-sequence unsigned-sequence stream)
+                    (error "WRITE-SEQUENCE didn't signal an error"))
+      (type-error (condition)
+        (assert (= (type-error-datum condition) 255))
+        (assert (subtypep (type-error-expected-type condition)
+                          '(signed-byte 8))))))
+
+  (with-open-file (stream pathname
+                          :direction :output
+                          :if-exists :supersede
+                          :element-type '(unsigned-byte 8))
+    (handler-case (progn
+                    (write-sequence signed-sequence stream)
+                    (error "WRITE-SEQUENCE didn't signal an error"))
+      (type-error (condition)
+        (assert (= (type-error-datum condition) -1))
+        (assert (subtypep (type-error-expected-type condition)
+                          '(unsigned-byte 8)))))))
 
 ;;; success

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv10991/src/code

Modified Files:
	stream.lisp 
Log Message:
1.0.1.6:
        Better error checking for incompatible stream / sequence types in
        READ-SEQUENCE and WRITE-SEQUENCE. (Patch by Tony Martinez, sbcl-devel
        2006-12-05).


Index: stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/stream.lisp,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -d -r1.84 -r1.85
--- stream.lisp	28 Jun 2006 11:35:51 -0000	1.84
+++ stream.lisp	29 Dec 2006 01:41:12 -0000	1.85
@@ -1778,6 +1778,15 @@
       ;; must be Gray streams FUNDAMENTAL-STREAM
       (stream-read-sequence stream seq start end)))
 
+(declaim (inline compatible-vector-and-stream-element-types-p))
+(defun compatible-vector-and-stream-element-types-p (vector stream)
+  (declare (type vector vector)
+           (type ansi-stream stream))
+  (or (and (typep vector '(simple-array (unsigned-byte 8) (*)))
+           (subtypep (stream-element-type stream) '(unsigned-byte 8)))
+      (and (typep vector '(simple-array (signed-byte 8) (*)))
+           (subtypep (stream-element-type stream) '(signed-byte 8)))))
+
 (defun ansi-stream-read-sequence (seq stream start %end)
   (declare (type sequence seq)
            (type ansi-stream stream)
@@ -1803,27 +1812,24 @@
              (setf (first rem) el)))))
       (vector
        (with-array-data ((data seq) (offset-start start) (offset-end end))
-         (typecase data
-           ((or (simple-array (unsigned-byte 8) (*))
-                (simple-array (signed-byte 8) (*)))
-            (let* ((numbytes (- end start))
-                   (bytes-read (read-n-bytes stream data offset-start
-                                             numbytes nil)))
-              (if (< bytes-read numbytes)
-                  (+ start bytes-read)
-                  end)))
-           (t
-            (let ((read-function
-                   (if (subtypep (stream-element-type stream) 'character)
-                       #'ansi-stream-read-char
-                       #'ansi-stream-read-byte)))
-              (do ((i offset-start (1+ i)))
-                  ((>= i offset-end) end)
-                (declare (type index i))
-                (let ((el (funcall read-function stream nil :eof nil)))
-                  (when (eq el :eof)
-                    (return (+ start (- i offset-start))))
-                  (setf (aref data i) el)))))))))))
+         (if (compatible-vector-and-stream-element-types-p data stream)
+             (let* ((numbytes (- end start))
+                    (bytes-read (read-n-bytes stream data offset-start
+                                              numbytes nil)))
+               (if (< bytes-read numbytes)
+                   (+ start bytes-read)
+                   end))
+             (let ((read-function
+                    (if (subtypep (stream-element-type stream) 'character)
+                        #'ansi-stream-read-char
+                        #'ansi-stream-read-byte)))
+               (do ((i offset-start (1+ i)))
+                   ((>= i offset-end) end)
+                 (declare (type index i))
+                 (let ((el (funcall read-function stream nil :eof nil)))
+                   (when (eq el :eof)
+                     (return (+ start (- i offset-start))))
+                   (setf (aref data i) el))))))))))
 
 ;;;; WRITE-SEQUENCE
 
@@ -1874,14 +1880,10 @@
                       ((>= i offset-end))
                     (declare (type index i))
                     (funcall write-function stream (aref data i))))))
-           (typecase data
-             ((or (simple-array (unsigned-byte 8) (*))
-                  (simple-array (signed-byte 8) (*)))
-              (if (fd-stream-p stream)
-                  (output-raw-bytes stream data offset-start offset-end)
-                  (output-seq-in-loop)))
-             (t
-              (output-seq-in-loop))))))))
+           (if (and (fd-stream-p stream)
+                    (compatible-vector-and-stream-element-types-p data stream))
+               (output-raw-bytes stream data offset-start offset-end)
+               (output-seq-in-loop)))))))
   seq)
 
 ;;;; etc.

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv27439

Modified Files:
	version.lisp-expr 
Log Message:
1.0.1.5:
        Suppress a bogus style-warning for MAKE-INSTANCE on a class with
        no slots and a non-standard metaclass. (Patch by Matthew Swank).


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3147
retrieving revision 1.3148
diff -u -d -r1.3147 -r1.3148
--- version.lisp-expr	29 Dec 2006 00:32:14 -0000	1.3147
+++ version.lisp-expr	29 Dec 2006 01:01:51 -0000	1.3148
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.1.4"
+"1.0.1.5"

Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv27439/src/pcl

Modified Files:
	ctor.lisp 
Log Message:
1.0.1.5:
        Suppress a bogus style-warning for MAKE-INSTANCE on a class with
        no slots and a non-standard metaclass. (Patch by Matthew Swank).


Index: ctor.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/ctor.lisp,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- ctor.lisp	7 Nov 2006 10:22:16 -0000	1.27
+++ ctor.lisp	29 Dec 2006 01:01:51 -0000	1.28
@@ -390,6 +390,7 @@
            .instance.)
         `(let* ((.instance. (,allocation-function ,wrapper))
                 (.slots. (,slots-fetcher .instance.)))
+           (declare (ignorable .slots.))
            ,body
            .instance.))))

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv15682

Modified Files:
	version.lisp-expr 
Log Message:
1.0.1.4:
        Fix Sparc build with gcc 4.1. (Patch from Rex Dieter).


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3146
retrieving revision 1.3147
diff -u -d -r1.3146 -r1.3147
--- version.lisp-expr	28 Dec 2006 23:48:04 -0000	1.3146
+++ version.lisp-expr	29 Dec 2006 00:32:14 -0000	1.3147
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.1.3"
+"1.0.1.4"

Update of /cvsroot/sbcl/sbcl/src/runtime
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv15682/src/runtime

Modified Files:
	sparc-arch.c 
Log Message:
1.0.1.4:
        Fix Sparc build with gcc 4.1. (Patch from Rex Dieter).


Index: sparc-arch.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/sparc-arch.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- sparc-arch.c	2 Nov 2006 17:18:37 -0000	1.18
+++ sparc-arch.c	29 Dec 2006 00:32:16 -0000	1.19
@@ -86,8 +86,12 @@
 
 void arch_skip_instruction(os_context_t *context)
 {
-    ((char *) *os_context_pc_addr(context)) = ((char *) *os_context_npc_addr(context));
-    ((char *) *os_context_npc_addr(context)) += 4;
+    *os_context_pc_addr(context) = *os_context_npc_addr(context);
+    /* Note that we're doing integer arithmetic here, not pointer. So
+     * the value that the return value of os_context_npc_addr() points
+     * to will be incremented by 4, not 16.
+     */
+    *os_context_npc_addr(context) += 4;
 }
 
 unsigned char *arch_internal_error_arguments(os_context_t *context)

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv30316

Modified Files:
	version.lisp-expr 
Log Message:
1.0.1.3:
        Oops, initforms for &AUX parameters were evaluated multiple times 
        for fast-method-functions. (Reported by Kevin Reid on sbcl-devel).



Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3145
retrieving revision 1.3146
diff -u -d -r1.3145 -r1.3146
--- version.lisp-expr	27 Dec 2006 00:37:30 -0000	1.3145
+++ version.lisp-expr	28 Dec 2006 23:48:04 -0000	1.3146
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.1.2"
+"1.0.1.3"

Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv30316/src/pcl

Modified Files:
	vector.lisp 
Log Message:
1.0.1.3:
        Oops, initforms for &AUX parameters were evaluated multiple times 
        for fast-method-functions. (Reported by Kevin Reid on sbcl-devel).



Index: vector.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/vector.lisp,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -d -r1.47 -r1.48
--- vector.lisp	1 Dec 2006 16:26:22 -0000	1.47
+++ vector.lisp	28 Dec 2006 23:48:04 -0000	1.48
@@ -985,12 +985,13 @@
          ;; The lambda-list used by BIND-ARGS
          (bind-list lambda-list)
          (setq-p (getf (cdr lmf-params) :setq-p))
+         (auxp (member '&aux bind-list))
          (call-next-method-p (getf (cdr lmf-params) :call-next-method-p)))
     ;; Try to use the normal function call machinery instead of BIND-ARGS
-    ;; bindings the arguments, unless:
+    ;; binding the arguments, unless:
     (unless (or ;; If all arguments are required, BIND-ARGS will be a no-op
                 ;; in any case.
-                (not restp)
+                (and (not restp) (not auxp))
                 ;; CALL-NEXT-METHOD wants to use BIND-ARGS, and needs a
                 ;; list of all non-required arguments.
                 call-next-method-p)
@@ -1013,7 +1014,9 @@
                          '.rest-arg.))
              (fmf-lambda-list (if rest-arg
                                   (append req-args (list '&rest rest-arg))
-                                  lambda-list)))
+                                  (if call-next-method-p
+                                      req-args
+                                      lambda-list))))
         `(list*
           :function
           (let* ((fmf (,(if (body-method-name body) 'named-lambda 'lambda)

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv30316/tests

Modified Files:
	clos.impure.lisp 
Log Message:
1.0.1.3:
        Oops, initforms for &AUX parameters were evaluated multiple times 
        for fast-method-functions. (Reported by Kevin Reid on sbcl-devel).



Index: clos.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/clos.impure.lisp,v
retrieving revision 1.89
retrieving revision 1.90
diff -u -d -r1.89 -r1.90
--- clos.impure.lisp	13 Nov 2006 07:20:22 -0000	1.89
+++ clos.impure.lisp	28 Dec 2006 23:48:04 -0000	1.90
@@ -1521,5 +1521,11 @@
 
 (clim-style-lambda-list-test 1 2)
 
+(setf *count* 0)
+
+(test (&aux (a (incf *count*)) (b (incf *count*)))
+      (a b *count* (setf *count* 0))
+      ())
+
 
 ;;;; success

Update of /cvsroot/sbcl/sbcl/src/code/external-formats
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv21977/src/code/external-formats

Added Files:
	enc-cn-tbl.lisp enc-cn.lisp 
Log Message:
1.0.1.2: support for GBK external format
(thanks to Chun Tian (binghe))


--- NEW FILE: enc-cn-tbl.lisp ---
;;; enc-cn-tbl.lisp: CP936(GBK) <=> UCS-2 table
;;; Chun Tian (binghe) <binghe.lisp@...>
;;; Sat Dec 23 23:42:11 CST 2006
;;; This table comes from:
;;;   http://www.unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP936.TXT
;;;
;;; Cut first 274 lines of CP936.TXT, got a CP936-only.TXT and do shell commands:
;;; $ cat CP936-only.TXT | awk -F "\t" '{printf("      (%s %s)\n",$1,$2);}' | sort | sed -e 's/0x/#x/g' > GBK2UCS.txt
;;; $ cat CP936-only.TXT | awk -F "\t" '{printf("      (%s %s)\n",$2,$1);}' | sort | sed -e 's/0x/#x/g' > UCS2GBK.txt
;;; and insert GBK2UCS.txt and UCS2GBK.txt to this file.

(in-package "SB!IMPL")

(define-multibyte-mapper *gbk-to-ucs-table*
    '( ;; begin, insert GBK2UCS.TXT here (emacs: C-x i GBK2UCS.TXT)
      (#x8140 #x4E02)
      (#x8141 #x4E04)
      (#x8142 #x4E05)
      (#x8143 #x4E06)
[...43563 lines suppressed...]
      (#xFF52 #xA3F2)
      (#xFF53 #xA3F3)
      (#xFF54 #xA3F4)
      (#xFF55 #xA3F5)
      (#xFF56 #xA3F6)
      (#xFF57 #xA3F7)
      (#xFF58 #xA3F8)
      (#xFF59 #xA3F9)
      (#xFF5A #xA3FA)
      (#xFF5B #xA3FB)
      (#xFF5C #xA3FC)
      (#xFF5D #xA3FD)
      (#xFF5E #xA1AB)
      (#xFFE0 #xA1E9)
      (#xFFE1 #xA1EA)
      (#xFFE2 #xA956)
      (#xFFE3 #xA3FE)
      (#xFFE4 #xA957)
      (#xFFE5 #xA3A4)
      )) ;; end of *ucs-to-gbk-table*

--- NEW FILE: enc-cn.lisp ---
;;; enc-cn.lisp: CP936 encoding support in SBCL
;;; Chun Tian (binghe) <binghe.lisp@...>
;;; Sat Dec 23 02:45:12 CST 2006

(in-package "SB!IMPL")

;;; GBK
(declaim (inline ucs-to-gbk gbk-to-ucs
                 mb-len-as-gbk gbk-continuation-byte-p))

(defun ucs-to-gbk (code)
  (declare (optimize speed (safety 0))
           (type fixnum code))
  (if (<= code #x7f) code
      (get-multibyte-mapper *ucs-to-gbk-table* code)))

(defun gbk-to-ucs (code)
  (declare (optimize speed (safety 0))
           (type fixnum code))
  (if (<= code #x7f) code
      (get-multibyte-mapper *gbk-to-ucs-table* code)))

(defun mb-len-as-gbk (code)
  (declare (optimize speed (safety 0))
           (type (unsigned-byte 8) code))
  (if (< code #x80) 1 2))

(defun gbk-continuation-byte-p (code)
  (declare (optimize speed (safety 0))
           (type (unsigned-byte 8) code)
           (ignore code))
  t)

(define-multibyte-encoding :gbk (:gbk :cp936)
  ucs-to-gbk gbk-to-ucs mb-len-as-gbk gbk-continuation-byte-p)

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv21977

Modified Files:
	NEWS build-order.lisp-expr version.lisp-expr 
Log Message:
1.0.1.2: support for GBK external format
(thanks to Chun Tian (binghe))


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.1121
retrieving revision 1.1122
diff -u -d -r1.1121 -r1.1122
--- NEWS	26 Dec 2006 23:10:22 -0000	1.1121
+++ NEWS	27 Dec 2006 00:37:30 -0000	1.1122
@@ -3,6 +3,8 @@
   * improvement: experimental support for mach exception handling on
     x86/macos. requires building with :MACH-EXCEPTION-HANDLER feature
     to use.
+  * improvement: support for GBK external format.
+    (thanks to Chun Tian (binghe))
 
 changes in sbcl-1.0.1 relative to sbcl-1.0:
   * new platform: FreeBSD/x86-64, including support for threading.

Index: build-order.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/build-order.lisp-expr,v
retrieving revision 1.76
retrieving revision 1.77
diff -u -d -r1.76 -r1.77
--- build-order.lisp-expr	5 Dec 2006 04:35:55 -0000	1.76
+++ build-order.lisp-expr	27 Dec 2006 00:37:30 -0000	1.77
@@ -695,6 +695,10 @@
  #!+sb-unicode
  ("src/code/external-formats/mb-util" :not-host)
  #!+sb-unicode
+ ("src/code/external-formats/enc-cn-tbl" :not-host)
+ #!+sb-unicode
+ ("src/code/external-formats/enc-cn" :not-host)
+ #!+sb-unicode
  ("src/code/external-formats/enc-jpn-tbl" :not-host)
  #!+sb-unicode
  ("src/code/external-formats/enc-jpn" :not-host)

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3144
retrieving revision 1.3145
diff -u -d -r1.3144 -r1.3145
--- version.lisp-expr	26 Dec 2006 23:10:22 -0000	1.3144
+++ version.lisp-expr	27 Dec 2006 00:37:30 -0000	1.3145
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.1.1"
+"1.0.1.2"

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv21977/tests

Added Files:
	enc-cn.impure.lisp 
Log Message:
1.0.1.2: support for GBK external format
(thanks to Chun Tian (binghe))


--- NEW FILE: enc-cn.impure.lisp ---
;;; -*- coding: utf-8 -*-
;;; enc-cn.impure.lisp: test case for enc-cn.lisp and enc-cn-tbl.lisp
#-sb-unicode
(sb-ext:quit :unix-status 104)

;; use "1AＡあ胡玥姮" for tests
(let ((str (coerce '(#\u0031 #\u0041 #\uff21 #\u3042 #\u80e1 #\u73a5 #\u59ee)
                   'string))
      (gbk '(#x31 #x41 #xa3 #xc1 #xa4 #xa2 #xba #xfa #xab #x68 #x8a #xac))
      (file "enc-cn-test.txt"))
  (dolist (pair (list (list gbk :gbk)))
    (destructuring-bind (bytes enc) pair
      ;; check if output works
      (with-open-file (s file :direction :output
                         :if-exists :supersede :external-format enc)
        (write-string str s))
      (with-open-file (s file :direction :input
                         :element-type '(unsigned-byte 8))
        (loop for c in bytes
           do (assert (eql (read-byte s) c))))

      ;; check if input works
      (with-open-file (s file :direction :input :external-format enc)
        (loop for c across str
           do (assert (eql (read-char s) c))))

      ;; check if string conversion works
      (assert (equal (coerce (string-to-octets str :external-format enc)
                             'list)
                     bytes))
      (assert (equal (octets-to-string (coerce bytes
                                               '(vector (unsigned-byte 8)))
                                       :external-format enc)
                     str))))
  (delete-file file))
;;; success

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv21157

Modified Files:
	NEWS version.lisp-expr 
Log Message:
1.0.1.1:
    mach exception handlers for x86/macos

    Added experimental support for mach exception handling under
    x86/macos. To enable this, turn on the feature
    :mach-exception-handler at build time.

  * restructure args to sb-posix:define-call so that :largefile
    becomes :options :largefile and add a new :c-name keyword arg.
  * for #+mach-exception-handler builds, make sb-posix:fork
    reestablish the mach exception handling thread after forking.
  * add doc/internals-notes/mach-exception-handler-notes.
  * memory_fault_handler no longer static for BSD.
  * added mach_error_memory_fault_handler for unexpected memory
    faults.
  * #+mach-exception-handler thread changes to allocate and deallocate
    mach ports.
  * added protect_control_stack_{return_}guard_page_thread calls that
    take a thread argument
  * sigill_handler no longer static on x86.
  * mach exception handling code in x86-darwin-os.c. See
    doc/internals-notes/mach-exception-handler-notes for details.


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.1120
retrieving revision 1.1121
diff -u -d -r1.1120 -r1.1121
--- NEWS	26 Dec 2006 14:57:44 -0000	1.1120
+++ NEWS	26 Dec 2006 23:10:22 -0000	1.1121
@@ -1,4 +1,9 @@
 ;;;; -*- coding: utf-8; -*-
+changes in sbcl-1.0.2 relative to sbcl-1.0.1:
+  * improvement: experimental support for mach exception handling on
+    x86/macos. requires building with :MACH-EXCEPTION-HANDLER feature
+    to use.
+
 changes in sbcl-1.0.1 relative to sbcl-1.0:
   * new platform: FreeBSD/x86-64, including support for threading.
   * new feature: the compiler stores cross-referencing information

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3143
retrieving revision 1.3144
diff -u -d -r1.3143 -r1.3144
--- version.lisp-expr	26 Dec 2006 14:57:44 -0000	1.3143
+++ version.lisp-expr	26 Dec 2006 23:10:22 -0000	1.3144
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.1"
+"1.0.1.1"

Update of /cvsroot/sbcl/sbcl/src/runtime
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv21157/src/runtime

Modified Files:
	bsd-os.c interrupt.c thread.c thread.h validate.c validate.h 
	x86-arch.c x86-darwin-os.c 
Log Message:
1.0.1.1:
    mach exception handlers for x86/macos

    Added experimental support for mach exception handling under
    x86/macos. To enable this, turn on the feature
    :mach-exception-handler at build time.

  * restructure args to sb-posix:define-call so that :largefile
    becomes :options :largefile and add a new :c-name keyword arg.
  * for #+mach-exception-handler builds, make sb-posix:fork
    reestablish the mach exception handling thread after forking.
  * add doc/internals-notes/mach-exception-handler-notes.
  * memory_fault_handler no longer static for BSD.
  * added mach_error_memory_fault_handler for unexpected memory
    faults.
  * #+mach-exception-handler thread changes to allocate and deallocate
    mach ports.
  * added protect_control_stack_{return_}guard_page_thread calls that
    take a thread argument
  * sigill_handler no longer static on x86.
  * mach exception handling code in x86-darwin-os.c. See
    doc/internals-notes/mach-exception-handler-notes for details.


Index: bsd-os.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/bsd-os.c,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -d -r1.43 -r1.44
--- bsd-os.c	15 Dec 2006 02:57:52 -0000	1.43
+++ bsd-os.c	26 Dec 2006 23:10:24 -0000	1.44
@@ -69,10 +69,9 @@
 
 #ifdef __NetBSD__
     netbsd_init();
-#endif /* __NetBSD__ */
-#ifdef __FreeBSD__
+#elif defined(__FreeBSD__)
     freebsd_init();
-#endif /* __FreeBSD__ */
+#endif
 }
 
 sigset_t *
@@ -177,7 +176,8 @@
  * The GENCGC needs to be hooked into whatever signal is raised for
  * page fault on this OS.
  */
-static void
+
+void
 memory_fault_handler(int signal, siginfo_t *siginfo, void *void_context
 #if defined(LISP_FEATURE_FREEBSD) && defined(LISP_FEATURE_X86_64)
 /* FreeBSD/amd64 stores fault address only in undocumented 4th arg. */
@@ -217,10 +217,21 @@
         }
 }
 
+#if defined(LISP_FEATURE_MACH_EXCEPTION_HANDLER)
+void
+mach_error_memory_fault_handler(int signal, siginfo_t *siginfo, void *void_context) {
+    lose("Unhandled memory fault. Exiting.");
+}
+#endif
+
 void
 os_install_interrupt_handlers(void)
 {
     SHOW("os_install_interrupt_handlers()/bsd-os/defined(GENCGC)");
+#if defined(LISP_FEATURE_MACH_EXCEPTION_HANDLER)
+    undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT,
+                                                 mach_error_memory_fault_handler);
+#else
     undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT,
 #ifdef LISP_FEATURE_FREEBSD
                                                  (__siginfohandler_t *)
@@ -233,6 +244,7 @@
 #endif
                                                  memory_fault_handler);
 #endif
+#endif
 
 #ifdef LISP_FEATURE_SB_THREAD
     undoably_install_low_level_interrupt_handler(SIG_INTERRUPT_THREAD,
@@ -244,7 +256,6 @@
                                                  sig_stop_for_gc_handler);
 #endif
 #endif
-
     SHOW("leaving os_install_interrupt_handlers()");
 }
 

Index: interrupt.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/interrupt.c,v
retrieving revision 1.119
retrieving revision 1.120
diff -u -d -r1.119 -r1.120
--- interrupt.c	15 Dec 2006 02:57:53 -0000	1.119
+++ interrupt.c	26 Dec 2006 23:10:24 -0000	1.120
@@ -125,7 +125,7 @@
 void
 check_blockables_blocked_or_lose()
 {
-#ifndef LISP_FEATURE_WIN32
+#if !defined(LISP_FEATURE_WIN32)
     /* Get the current sigmask, by blocking the empty set. */
     sigset_t empty,current;
     int i;

Index: thread.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.c,v
retrieving revision 1.71
retrieving revision 1.72
diff -u -d -r1.71 -r1.72
--- thread.c	15 Dec 2006 01:16:36 -0000	1.71
+++ thread.c	26 Dec 2006 23:10:24 -0000	1.72
@@ -25,6 +25,12 @@
 #include <sys/wait.h>
 #endif
 
+#ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
+#include <mach/mach.h>
+#include <mach/mach_error.h>
+#include <mach/mach_types.h>
+#endif
+
 #include "runtime.h"
 #include "validate.h"           /* for CONTROL_STACK_SIZE etc */
 #include "alloc.h"
@@ -143,6 +149,7 @@
 
 #ifdef QUEUE_FREEABLE_THREAD_STACKS
 
+static void
 queue_freeable_thread_stack(struct thread *thread_to_be_cleaned_up)
 {
      if (thread_to_be_cleaned_up) {
@@ -312,6 +319,17 @@
     os_invalidate((os_vm_address_t)th->interrupt_data,
                   (sizeof (struct interrupt_data)));
 
+#ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
+    FSHOW((stderr, "Deallocating mach port %x\n", THREAD_STRUCT_TO_EXCEPTION_PORT(th)));
+    mach_port_move_member(mach_task_self(),
+                          THREAD_STRUCT_TO_EXCEPTION_PORT(th),
+                          MACH_PORT_NULL);
+    mach_port_deallocate(mach_task_self(),
+                         THREAD_STRUCT_TO_EXCEPTION_PORT(th));
+    mach_port_destroy(mach_task_self(),
+                      THREAD_STRUCT_TO_EXCEPTION_PORT(th));
+#endif
+
 #ifdef QUEUE_FREEABLE_THREAD_STACKS
     queue_freeable_thread_stack(th);
 #elif defined(CREATE_CLEANUP_THREAD)
@@ -461,9 +479,20 @@
     return th;
 }
 
+#ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
+mach_port_t setup_mach_exception_handling_thread();
+kern_return_t mach_thread_init(mach_port_t thread_exception_port);
+
+#endif
+
 void create_initial_thread(lispobj initial_function) {
     struct thread *th=create_thread_struct(initial_function);
     if(th) {
+#ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
+        kern_return_t ret;
+
+        setup_mach_exception_handling_thread();
+#endif
         initial_thread_trampoline(th); /* no return */
     } else lose("can't create initial thread\n");
 }
@@ -520,6 +549,7 @@
         }
         r=0;
     }
+
 #ifdef QUEUE_FREEABLE_THREAD_STACKS
     free_freeable_stacks();
 #endif

Index: thread.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.h,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- thread.h	20 Nov 2006 04:51:38 -0000	1.27
+++ thread.h	26 Dec 2006 23:10:24 -0000	1.28
@@ -144,6 +144,11 @@
 #endif
 }
 
+#if defined(LISP_FEATURE_MACH_EXCEPTION_HANDLER)
+#define THREAD_STRUCT_TO_EXCEPTION_PORT(th) ((mach_port_t) th)
+#define EXCEPTION_PORT_TO_THREAD_STRUCT(th) ((struct thread *) th)
+#endif
+
 #if defined(LISP_FEATURE_SB_THREAD)
 #define thread_self pthread_self
 #define thread_kill pthread_kill

Index: validate.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/validate.c,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -d -r1.30 -r1.31
--- validate.c	2 Nov 2006 17:18:37 -0000	1.30
+++ validate.c	26 Dec 2006 23:10:25 -0000	1.31
@@ -95,3 +95,21 @@
                os_vm_page_size,protect_p ?
                (OS_VM_PROT_READ|OS_VM_PROT_EXECUTE) : OS_VM_PROT_ALL);
 }
+
+/* these OOAO violations are here because with mach exception handlers
+ * we need to protect the stack guard pages from the mach exception
+ * handlers which run on a different thread, so we take a thread
+ * argument here. Too bad we don't have keywords args in C. */
+void
+protect_control_stack_guard_page_thread(int protect_p, struct thread *th) {
+    os_protect(CONTROL_STACK_GUARD_PAGE(th),
+               os_vm_page_size,protect_p ?
+               (OS_VM_PROT_READ|OS_VM_PROT_EXECUTE) : OS_VM_PROT_ALL);
+}
+
+void
+protect_control_stack_return_guard_page_thread(int protect_p, struct thread* th) {
+    os_protect(CONTROL_STACK_RETURN_GUARD_PAGE(th),
+               os_vm_page_size,protect_p ?
+               (OS_VM_PROT_READ|OS_VM_PROT_EXECUTE) : OS_VM_PROT_ALL);
+}

Index: validate.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/validate.h,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- validate.h	2 Nov 2006 17:18:37 -0000	1.20
+++ validate.h	26 Dec 2006 23:10:25 -0000	1.21
@@ -51,6 +51,8 @@
 extern void validate(void);
 extern void protect_control_stack_guard_page(int protect_p);
 extern void protect_control_stack_return_guard_page(int protect_p);
+extern void protect_control_stack_guard_page_thread(int protect_p, struct thread *th);
+extern void protect_control_stack_return_guard_page_thread(int protect_p, struct thread* th);
 extern os_vm_address_t undefined_alien_address;
 #endif
 

Index: x86-arch.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-arch.c,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -d -r1.46 -r1.47
--- x86-arch.c	1 Dec 2006 20:47:05 -0000	1.46
+++ x86-arch.c	26 Dec 2006 23:10:25 -0000	1.47
@@ -328,14 +328,14 @@
     }
 }
 
-static void
+void
 sigill_handler(int signal, siginfo_t *siginfo, void *void_context) {
     os_context_t *context = (os_context_t*)void_context;
 
     /* Triggering SIGTRAP using int3 is unreliable on OS X/x86, so
      * we need to use illegal instructions for traps.
      */
-#if defined(LISP_FEATURE_DARWIN)
+#if defined(LISP_FEATURE_DARWIN) && !defined(LISP_FEATURE_MACH_EXCEPTION_HANDLER)
     if (*((unsigned short *)*os_context_pc_addr(context)) == 0x0b0f) {
         *os_context_pc_addr(context) += 2;
         return sigtrap_handler(signal, siginfo, void_context);
@@ -361,7 +361,7 @@
      * OS I haven't tested on?) and we have to go back to the old CMU
      * CL way, I hope there will at least be a comment to explain
      * why.. -- WHN 2001-06-07 */
-#ifndef LISP_FEATURE_WIN32
+#if !defined(LISP_FEATURE_WIN32) && !defined(LISP_FEATURE_MACH_EXCEPTION_HANDLER)
     undoably_install_low_level_interrupt_handler(SIGILL , sigill_handler);
     undoably_install_low_level_interrupt_handler(SIGTRAP, sigtrap_handler);
 #endif

Index: x86-darwin-os.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-darwin-os.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- x86-darwin-os.c	3 Jun 2006 20:26:53 -0000	1.2
+++ x86-darwin-os.c	26 Dec 2006 23:10:25 -0000	1.3
@@ -7,7 +7,23 @@
 #endif
 
 #include "thread.h"
+#include "validate.h"
+#include "runtime.h"
+#include "interrupt.h"
 #include "x86-darwin-os.h"
+#include "genesis/fdefn.h"
+
+#include <mach/mach.h>
+#include <mach/mach_error.h>
+#include <mach/mach_types.h>
+#include <mach/sync_policy.h>
+#include <mach/machine/thread_state.h>
+#include <mach/machine/thread_status.h>
+#include <sys/_types.h>
+#include <sys/ucontext.h>
+#include <pthread.h>
+#include <assert.h>
+#include <stdlib.h>
 
 #ifdef LISP_FEATURE_SB_THREAD
 
@@ -28,6 +44,10 @@
 
 #endif
 
+#ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
+kern_return_t mach_thread_init(mach_port_t thread_exception_port);
+#endif
+
 int arch_os_thread_init(struct thread *thread) {
 #ifdef LISP_FEATURE_SB_THREAD
     int n;
@@ -36,7 +56,7 @@
     data_desc_t ldt_entry = { 0, 0, 0, DESC_DATA_WRITE,
                               3, 1, 0, DESC_DATA_32B, DESC_GRAN_BYTE, 0 };
 
-    set_data_desc_addr(&ldt_entry, (unsigned long) thread);
+    set_data_desc_addr(&ldt_entry, thread);
     set_data_desc_size(&ldt_entry, dynamic_values_bytes);
 
     thread_mutex_lock(&modify_ldt_lock);
@@ -58,6 +78,9 @@
     thread->tls_cookie=n;
     pthread_setspecific(specials,thread);
 #endif
+#ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
+    mach_thread_init(THREAD_STRUCT_TO_EXCEPTION_PORT(thread));
+#endif
 
 #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
     stack_t sigstack;
@@ -90,3 +113,589 @@
     return 1;                  /* success */
 }
 
+#ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
+
+void sigill_handler(int signal, siginfo_t *siginfo, void *void_context);
+void sigtrap_handler(int signal, siginfo_t *siginfo, void *void_context);
+void memory_fault_handler(int signal, siginfo_t *siginfo, void *void_context);
+
+/* exc_server handles mach exception messages from the kernel and
+ * calls catch exception raise. We use the system-provided
+ * mach_msg_server, which, I assume, calls exc_server in a loop.
+ *
+ */
+extern boolean_t exc_server();
+
+/* This executes in the faulting thread as part of the signal
+ * emulation.  It is passed a context with the uc_mcontext field
+ * pointing to a valid block of memory. */
+void build_fake_signal_context(struct ucontext *context,
+                               x86_thread_state32_t *thread_state,
+                               x86_float_state32_t *float_state) {
+    pthread_sigmask(0, NULL, &context->uc_sigmask);
+    context->uc_mcontext->ss = *thread_state;
+    context->uc_mcontext->fs = *float_state;
+}
+
+/* This executes in the faulting thread as part of the signal
+ * emulation.  It is effectively the inverse operation from above. */
+void update_thread_state_from_context(x86_thread_state32_t *thread_state,
+                                      x86_float_state32_t *float_state,
+                                      struct ucontext *context) {
+    *thread_state = context->uc_mcontext->ss;
+    *float_state = context->uc_mcontext->fs;
+    pthread_sigmask(SIG_SETMASK, &context->uc_sigmask, NULL);
+}
+
+/* Modify a context to push new data on its stack. */
+void push_context(u32 data, x86_thread_state32_t *context)
+{
+    u32 *stack_pointer;
+
+    stack_pointer = (u32*) context->esp;
+    *(--stack_pointer) = data;
+    context->esp = (unsigned int) stack_pointer;
+}
+
+void align_context_stack(x86_thread_state32_t *context)
+{
+    /* 16byte align the stack (provided that the stack is, as it
+     * should be, 4byte aligned. */
+    while (context->esp & 15) push_context(0, context);
+}
+
+/* Stack allocation starts with a context that has a mod-4 ESP value
+ * and needs to leave a context with a mod-16 ESP that will restore
+ * the old ESP value and other register state when activated.  The
+ * first part of this is the recovery trampoline, which loads ESP from
+ * EBP, pops EBP, and returns. */
+asm("_stack_allocation_recover: movl %ebp, %esp; popl %ebp; ret;");
+
+void open_stack_allocation(x86_thread_state32_t *context)
+{
+    void stack_allocation_recover(void);
+
+    push_context(context->eip, context);
+    push_context(context->ebp, context);
+    context->ebp = context->esp;
+    context->eip = (unsigned int) stack_allocation_recover;
+
+    align_context_stack(context);
+}
+
+/* Stack allocation of data starts with a context with a mod-16 ESP
+ * value and reserves some space on it by manipulating the ESP
+ * register. */
+void *stack_allocate(x86_thread_state32_t *context, size_t size)
+{
+    /* round up size to 16byte multiple */
+    size = (size + 15) & -16;
+
+    context->esp = ((u32)context->esp) - size;
+
+    return (void *)context->esp;
+}
+
+/* Arranging to invoke a C function is tricky, as we have to assume
+ * cdecl calling conventions (caller removes args) and x86/darwin
+ * alignment requirements.  The simplest way to arrange this,
+ * actually, is to open a new stack allocation.
+ * WARNING!!! THIS DOES NOT PRESERVE REGISTERS! */
+void call_c_function_in_context(x86_thread_state32_t *context,
+                                void *function,
+                                int nargs,
+                                ...)
+{
+    va_list ap;
+    int i;
+    u32 *stack_pointer;
+
+    /* Set up to restore stack on exit. */
+    open_stack_allocation(context);
+
+    /* Have to keep stack 16byte aligned on x86/darwin. */
+    for (i = (3 & -nargs); i; i--) {
+        push_context(0, context);
+    }
+
+    context->esp = ((u32)context->esp) - nargs * 4;
+    stack_pointer = (u32 *)context->esp;
+
+    va_start(ap, nargs);
+    for (i = 0; i < nargs; i++) {
+        //push_context(va_arg(ap, u32), context);
+        stack_pointer[i] = va_arg(ap, u32);
+    }
+    va_end(ap);
+
+    push_context(context->eip, context);
+    context->eip = (unsigned int) function;
+}
+
+void signal_emulation_wrapper(x86_thread_state32_t *thread_state,
+                              x86_float_state32_t *float_state,
+                              int signal,
+                              siginfo_t *siginfo,
+                              void (*handler)(int, siginfo_t *, void *))
+{
+
+    /* CLH: FIXME **NOTE: HACK ALERT!** Ideally, we would allocate
+     * context and regs on the stack as local variables, but this
+     * causes problems for the lisp debugger. When it walks the stack
+     * for a back trace, it sees the 1) address of the local variable
+     * on the stack and thinks that is a frame pointer to a lisp
+     * frame, and, 2) the address of the sap that we alloc'ed in
+     * dynamic space and thinks that is a return address, so it,
+     * heuristicly (and wrongly), chooses that this should be
+     * interpreted as a lisp frame instead of as a C frame.
+     * We can work around this in this case by os_validating the
+     * context (and regs just for symmetry).
+     */
+
+    struct ucontext *context;
+    struct mcontext *regs;
+    sigset_t sigmask;
+
+    context = (struct ucontext*) os_validate(0, sizeof(struct ucontext));
+    regs = (struct mcontext*) os_validate(0, sizeof(struct mcontext));
+    context->uc_mcontext = regs;
+
+    /* when BSD signals are fired, they mask they signals in sa_mask
+       which always seem to be the blockable_sigset, for us, so we
+       need to:
+       1) save the current sigmask
+       2) block blockable signals
+       3) call the signal handler
+       4) restore the sigmask */
+
+    pthread_sigmask(0, NULL, &sigmask);
+    block_blockable_signals();
+
+    build_fake_signal_context(context, thread_state, float_state);
+
+    handler(signal, siginfo, context);
+
+    update_thread_state_from_context(thread_state, float_state, context);
+
+    pthread_sigmask(SIG_SETMASK, &sigmask, NULL);
+
+    os_invalidate((os_vm_address_t)context, sizeof(struct ucontext));
+    os_invalidate((os_vm_address_t)regs, sizeof(struct mcontext));
+
+    /* Trap to restore the signal context. */
+    asm volatile ("movl %0, %%eax; .long 0xffff0b0f": : "r" (thread_state));
+}
+
+#if defined DUMP_CONTEXT
+void dump_context(x86_thread_state32_t *context)
+{
+    int i;
+    u32 *stack_pointer;
+
+    printf("eax: %08lx  ecx: %08lx  edx: %08lx  ebx: %08lx\n",
+           context->eax, context->ecx, context->edx, context->ebx);
+    printf("esp: %08lx  ebp: %08lx  esi: %08lx  edi: %08lx\n",
+           context->esp, context->ebp, context->esi, context->edi);
+    printf("eip: %08lx  eflags: %08lx\n",
+           context->eip, context->eflags);
+    printf("cs: %04hx  ds: %04hx  es: %04hx  "
+           "ss: %04hx  fs: %04hx  gs: %04hx\n",
+           context->cs, context->ds, context->es,
+           context->ss, context->fs, context->gs);
+
+    stack_pointer = (u32 *)context->esp;
+    for (i = 0; i < 48; i+=4) {
+        printf("%08x:  %08x %08x %08x %08x\n",
+               context->esp + (i * 4),
+               stack_pointer[i],
+               stack_pointer[i+1],
+               stack_pointer[i+2],
+               stack_pointer[i+3]);
+    }
+}
+#endif
+
+void
+control_stack_exhausted_handler(int signal, siginfo_t *siginfo, void *void_context) {
+    os_context_t *context = arch_os_get_context(&void_context);
+
+    arrange_return_to_lisp_function
+        (context, SymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR));
+}
+
+void
+undefined_alien_handler(int signal, siginfo_t *siginfo, void *void_context) {
+    os_context_t *context = arch_os_get_context(&void_context);
+
+    arrange_return_to_lisp_function
+        (context, SymbolFunction(UNDEFINED_ALIEN_VARIABLE_ERROR));
+}
+
+kern_return_t
+catch_exception_raise(mach_port_t exception_port,
+                     mach_port_t thread,
+                     mach_port_t task,
+                     exception_type_t exception,
+                     exception_data_t code_vector,
+                     mach_msg_type_number_t code_count)
+{
+    kern_return_t ret;
+    int signal;
+    siginfo_t* siginfo;
+
+    x86_thread_state32_t thread_state;
+    mach_msg_type_number_t thread_state_count = x86_THREAD_STATE32_COUNT;
+
+    x86_float_state32_t float_state;
+    mach_msg_type_number_t float_state_count = x86_FLOAT_STATE32_COUNT;
+
+    x86_exception_state32_t exception_state;
+    mach_msg_type_number_t exception_state_count = x86_EXCEPTION_STATE32_COUNT;
+
+    x86_thread_state32_t backup_thread_state;
+    x86_thread_state32_t *target_thread_state;
+    x86_float_state32_t *target_float_state;
+
+    os_vm_address_t addr;
+
+    struct thread *th = (struct thread*) exception_port;
+
+    FSHOW((stderr,"/entering catch_exception_raise with exception: %d\n", exception));
+
+    switch (exception) {
+
+    case EXC_BAD_ACCESS:
+        signal = SIGBUS;
+        ret = thread_get_state(thread,
+                               x86_THREAD_STATE32,
+                               (thread_state_t)&thread_state,
+                               &thread_state_count);
+        ret = thread_get_state(thread,
+                               x86_FLOAT_STATE32,
+                               (thread_state_t)&float_state,
+                               &float_state_count);
+        ret = thread_get_state(thread,
+                               x86_EXCEPTION_STATE32,
+                               (thread_state_t)&exception_state,
+                               &exception_state_count);
+        addr = (void*)exception_state.faultvaddr;
+
+
+        /* note the os_context hackery here.  When the signal handler returns,
+         * it won't go back to what it was doing ... */
+        if(addr >= CONTROL_STACK_GUARD_PAGE(th) &&
+           addr < CONTROL_STACK_GUARD_PAGE(th) + os_vm_page_size) {
+            /* We hit the end of the control stack: disable guard page
+             * protection so the error handler has some headroom, protect the
+             * previous page so that we can catch returns from the guard page
+             * and restore it. */
+            protect_control_stack_guard_page_thread(0, th);
+            protect_control_stack_return_guard_page_thread(1, th);
+
+            backup_thread_state = thread_state;
+            open_stack_allocation(&thread_state);
+
+            /* Save thread state */
+            target_thread_state =
+                stack_allocate(&thread_state, sizeof(*target_thread_state));
+            (*target_thread_state) = backup_thread_state;
+
+            /* Save float state */
+            target_float_state =
+                stack_allocate(&thread_state, sizeof(*target_float_state));
+            (*target_float_state) = float_state;
+
+            /* Set up siginfo */
+            siginfo = stack_allocate(&thread_state, sizeof(*siginfo));
+            /* what do we need to put in our fake siginfo?  It looks like
+             * the x86 code only uses si_signo and si_adrr. */
+            siginfo->si_signo = signal;
+            siginfo->si_addr = (void*)exception_state.faultvaddr;
+
+            call_c_function_in_context(&thread_state,
+                                       signal_emulation_wrapper,
+                                       5,
+                                       target_thread_state,
+                                       target_float_state,
+                                       signal,
+                                       siginfo,
+                                       control_stack_exhausted_handler);
+        }
+        else if(addr >= CONTROL_STACK_RETURN_GUARD_PAGE(th) &&
+                addr < CONTROL_STACK_RETURN_GUARD_PAGE(th) + os_vm_page_size) {
+            /* We're returning from the guard page: reprotect it, and
+             * unprotect this one. This works even if we somehow missed
+             * the return-guard-page, and hit it on our way to new
+             * exhaustion instead. */
+            protect_control_stack_guard_page_thread(1, th);
+            protect_control_stack_return_guard_page_thread(0, th);
+
+        }
+        else if (addr >= undefined_alien_address &&
+                 addr < undefined_alien_address + os_vm_page_size) {
+            backup_thread_state = thread_state;
+            open_stack_allocation(&thread_state);
+
+            /* Save thread state */
+            target_thread_state =
+                stack_allocate(&thread_state, sizeof(*target_thread_state));
+            (*target_thread_state) = backup_thread_state;
+
+            target_float_state =
+                stack_allocate(&thread_state, sizeof(*target_float_state));
+            (*target_float_state) = float_state;
+
+            /* Set up siginfo */
+            siginfo = stack_allocate(&thread_state, sizeof(*siginfo));
+            /* what do we need to put in our fake siginfo?  It looks like
+             * the x86 code only uses si_signo and si_adrr. */
+            siginfo->si_signo = signal;
+            siginfo->si_addr = (void*)exception_state.faultvaddr;
+
+            call_c_function_in_context(&thread_state,
+                                       signal_emulation_wrapper,
+                                       5,
+                                       target_thread_state,
+                                       target_float_state,
+                                       signal,
+                                       siginfo,
+                                       undefined_alien_handler);
+        } else {
+
+            backup_thread_state = thread_state;
+            open_stack_allocation(&thread_state);
+
+            /* Save thread state */
+            target_thread_state =
+                stack_allocate(&thread_state, sizeof(*target_thread_state));
+            (*target_thread_state) = backup_thread_state;
+
+            target_float_state =
+                stack_allocate(&thread_state, sizeof(*target_float_state));
+            (*target_float_state) = float_state;
+
+            /* Set up siginfo */
+            siginfo = stack_allocate(&thread_state, sizeof(*siginfo));
+            /* what do we need to put in our fake siginfo?  It looks like
+             * the x86 code only uses si_signo and si_adrr. */
+            siginfo->si_signo = signal;
+            siginfo->si_addr = (void*)exception_state.faultvaddr;
+
+            call_c_function_in_context(&thread_state,
+                                       signal_emulation_wrapper,
+                                       5,
+                                       target_thread_state,
+                                       target_float_state,
+                                       signal,
+                                       siginfo,
+                                       memory_fault_handler);
+        }
+        ret = thread_set_state(thread,
+                               x86_THREAD_STATE32,
+                               (thread_state_t)&thread_state,
+                               thread_state_count);
+
+        ret = thread_set_state(thread,
+                               x86_FLOAT_STATE32,
+                               (thread_state_t)&float_state,
+                               float_state_count);
+        return KERN_SUCCESS;
+
+    case EXC_BAD_INSTRUCTION:
+
+        ret = thread_get_state(thread,
+                               x86_THREAD_STATE32,
+                               (thread_state_t)&thread_state,
+                               &thread_state_count);
+        ret = thread_get_state(thread,
+                               x86_FLOAT_STATE32,
+                               (thread_state_t)&float_state,
+                               &float_state_count);
+        ret = thread_get_state(thread,
+                               x86_EXCEPTION_STATE32,
+                               (thread_state_t)&exception_state,
+                               &exception_state_count);
+        if (0xffff0b0f == *((u32 *)thread_state.eip)) {
+            /* fake sigreturn. */
+
+            /* When we get here, thread_state.eax is a pointer to a
+             * thread_state to restore. */
+            /* thread_state = *((thread_state_t *)thread_state.eax); */
+
+            ret = thread_set_state(thread,
+                                   x86_THREAD_STATE32,
+                                   (thread_state_t) thread_state.eax,
+                                   /* &thread_state, */
+                                   thread_state_count);
+        } else {
+
+            backup_thread_state = thread_state;
+            open_stack_allocation(&thread_state);
+
+            /* Save thread state */
+            target_thread_state =
+                stack_allocate(&thread_state, sizeof(*target_thread_state));
+            (*target_thread_state) = backup_thread_state;
+
+            target_float_state =
+                stack_allocate(&thread_state, sizeof(*target_float_state));
+            (*target_float_state) = float_state;
+
+            /* Set up siginfo */
+            siginfo = stack_allocate(&thread_state, sizeof(*siginfo));
+            /* what do we need to put in our fake siginfo?  It looks like
+             * the x86 code only uses si_signo and si_adrr. */
+            if (*((unsigned short *)target_thread_state->eip) == 0x0b0f) {
+                signal = SIGTRAP;
+                siginfo->si_signo = signal;
+                siginfo->si_addr = (void*)exception_state.faultvaddr;
+                target_thread_state->eip += 2;
+                call_c_function_in_context(&thread_state,
+                                           signal_emulation_wrapper,
+                                           5,
+                                           target_thread_state,
+                                           target_float_state,
+                                           signal,
+                                           siginfo,
+                                           sigtrap_handler);
+            } else {
+                signal = SIGILL;
+                siginfo->si_signo = signal;
+                siginfo->si_addr = (void*)exception_state.faultvaddr;
+
+                call_c_function_in_context(&thread_state,
+                                           signal_emulation_wrapper,
+                                           5,
+                                           target_thread_state,
+                                           target_float_state,
+                                           signal,
+                                           siginfo,
+                                           sigill_handler);
+            }
+            ret = thread_set_state(thread,
+                                   x86_THREAD_STATE32,
+                                   (thread_state_t)&thread_state,
+                                   thread_state_count);
+            ret = thread_set_state(thread,
+                                   x86_FLOAT_STATE32,
+                                   (thread_state_t)&float_state,
+                                   float_state_count);
+        }
+        return KERN_SUCCESS;
+
+    default:
+        return KERN_INVALID_RIGHT;
+    }
+}
+
+void *
+mach_exception_handler(void *port)
+{
+  mach_msg_server(exc_server, 2048, (mach_port_t) port, 0);
+  /* mach_msg_server should never return, but it should dispatch mach
+   * exceptions to our catch_exception_raise function
+   */
+  abort();
+}
+
+#endif
+
+#ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
+
+/* Sets up the thread that will listen for mach exceptions. note that
+   the exception handlers will be run on this thread. This is
+   different from the BSD-style signal handling situation in which the
+   signal handlers run in the relevant thread directly. */
+
+mach_port_t mach_exception_handler_port_set = MACH_PORT_NULL;
+
+pthread_t
+setup_mach_exception_handling_thread()
+{
+    kern_return_t ret;
+    pthread_t mach_exception_handling_thread = NULL;
+    pthread_attr_t attr;
+
+    /* allocate a mach_port for this process */
+    ret = mach_port_allocate(mach_task_self(),
+                             MACH_PORT_RIGHT_PORT_SET,
+                             &mach_exception_handler_port_set);
+
+    /* create the thread that will receive the mach exceptions */
+
+    FSHOW((stderr, "Creating mach_exception_handler thread!\n"));
+
+    pthread_attr_init(&attr);
+    pthread_create(&mach_exception_handling_thread,
+                   &attr,
+                   mach_exception_handler,
+                   (void*) mach_exception_handler_port_set);
+    pthread_attr_destroy(&attr);
+
+    return mach_exception_handling_thread;
+}
+
+/* tell the kernel that we want EXC_BAD_ACCESS exceptions sent to the
+   exception port (which is being listened to do by the mach
+   exception handling thread). */
+kern_return_t
+mach_thread_init(mach_port_t thread_exception_port)
+{
+    kern_return_t ret;
+    /* allocate a named port for the thread */
+
+    FSHOW((stderr, "Allocating mach port %x\n", thread_exception_port));
+
+    ret = mach_port_allocate_name(mach_task_self(),
+                                  MACH_PORT_RIGHT_RECEIVE,
+                                  thread_exception_port);
+    if (ret) {
+        lose("mach_port_allocate_name failed with return_code %d\n", ret);
+    }
+
+    /* establish the right for the thread_exception_port to send messages */
+    ret = mach_port_insert_right(mach_task_self(),
+                                 thread_exception_port,
+                                 thread_exception_port,
+                                 MACH_MSG_TYPE_MAKE_SEND);
+    if (ret) {
+        lose("mach_port_insert_right failed with return_code %d\n", ret);
+    }
+
+    ret = thread_set_exception_ports(mach_thread_self(),
+                                     EXC_MASK_BAD_ACCESS | EXC_MASK_BAD_INSTRUCTION,
+                                     thread_exception_port,
+                                     EXCEPTION_DEFAULT,
+                                     THREAD_STATE_NONE);
+    if (ret) {
+        lose("thread_set_exception_port failed with return_code %d\n", ret);
+    }
+
+    ret = mach_port_move_member(mach_task_self(),
+                                thread_exception_port,
+                                mach_exception_handler_port_set);
+    if (ret) {
+        lose("mach_port_ failed with return_code %d\n", ret);
+    }
+
+    return ret;
+}
+
+void
+setup_mach_exceptions() {
+    setup_mach_exception_handling_thread();
+    mach_thread_init(THREAD_STRUCT_TO_EXCEPTION_PORT(all_threads));
+}
+
+pid_t
+mach_fork() {
+    pid_t pid = fork();
+    if (pid == 0) {
+        setup_mach_exceptions();
+        return pid;
+    } else {
+        return pid;
+    }
+}
+
+#endif

Update of /cvsroot/sbcl/sbcl/doc/internals-notes
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv21157/doc/internals-notes

Added Files:
	mach-exception-handler-notes 
Log Message:
1.0.1.1:
    mach exception handlers for x86/macos

    Added experimental support for mach exception handling under
    x86/macos. To enable this, turn on the feature
    :mach-exception-handler at build time.

  * restructure args to sb-posix:define-call so that :largefile
    becomes :options :largefile and add a new :c-name keyword arg.
  * for #+mach-exception-handler builds, make sb-posix:fork
    reestablish the mach exception handling thread after forking.
  * add doc/internals-notes/mach-exception-handler-notes.
  * memory_fault_handler no longer static for BSD.
  * added mach_error_memory_fault_handler for unexpected memory
    faults.
  * #+mach-exception-handler thread changes to allocate and deallocate
    mach ports.
  * added protect_control_stack_{return_}guard_page_thread calls that
    take a thread argument
  * sigill_handler no longer static on x86.
  * mach exception handling code in x86-darwin-os.c. See
    doc/internals-notes/mach-exception-handler-notes for details.


--- NEW FILE: mach-exception-handler-notes ---

MACH EXCEPTION HANDLER NOTES
Cyrus Harmon, December 2007

The goal of this work is to use make SBCL use mach exception handlers
instead of so-called BSD-style signal handlers on Mac OS X. Cyrus
Harmon and Alastair Bridgewater have been working on this.

Mac OS X has a mach-based kernel that has its own API for things like
threads and exception handling. Both mach exception handlers and
BSD-style signal handlers are available for use by application
programmers, but the signal handlers, which are implemented as a
compatibility layer on top of mach exceptions, have some problems. The
main problem for SBCL is that when using BSD-style signal handlers to
respond to SIGSEGV for access to protected memory areas, we cannot use
gdb to debug the process. This is problematic for SBCL which sets up,
and reads and writes to, protected memory areas early and
often. Additionally, threaded builds are seeing a number of problems
with SIGILLs being thrown at odd times. It appears that these are
coming from with the OS signal handling libraries directly, so
debugging these is rather tricky, especially in the absence of a
debugger. Thirdly, the protected memory accesses can, under certain
settings, trigger the Mac OS X CrashReporter, either logging
voluminous messages to a log file or, worse yet, triggering a
user-intervention dialog.

To address these three problems, we propose replacing the BSD-style
signal handling facility with a mach exception handling
facility. Preliminary tests with mach exceptions show that GDB is much
happier when using mach exceptions to respond to access to protected
memory. While mach exceptions probably won't directly fix the
threading problems, they remove a potentially problematic section of
code, the portion of the Mac OS X system library that deals with
BSD-style signal handling emulation and delivery of those signals to
multiple threads. Even if using mach exceptions in and of itself
doesn't immediately fix the problem, it should me much easier to
diagnose using a debugger. Finally, the CrashReporter problem appears
to go away as well, as this arises from an unfortunate placement of
the CrashReporting facility in the OS between the mach exception
handling and the BSD-style signal emulation. By catching the mach
exceptions ourselves, we avoid this problem.

* Mach exception handling details and example

Mach exceptions work by creating a thread that listens for mach
exceptions. The (slightly under-documented) OS function mach_msg_server
is passed the exc_server function and exc_server in turn calls our
catch_exception_raise function when an appropriate exception is
triggered. (Note that catch_exception_raise is called by exc_server
directly by that name. I have no idea how to provide multiple such
functions or to call this function by another name, but we should be
OK with a a single exception handling function.)

To set this up we perform the following steps:

1. allocate a mach port for our exceptions.

2. give the process the right to send and receive exceptions on this
   port.

3. create a new thread which calls mach_msg_server, providing
   exc_server as an argument. exc_server in turn calls our
   catch_exception_raise when an exception is raised.

4. finally, each thread for which we would like exceptions to be
   handled must register itself with the exception port by calling
   thread_set_exception_ports with the appropriate port and exception
   mask. Actually, it's a bit more involved than this in order to
   support multiple threads. Please document this fully.

* USE_MACH_EXCEPTION_HANDLER

The conditional compilation directive USE_MACH_EXCEPTION_HANDLER is a
flag to use mach exception handling. We should continue to support the
BSD-style signal handling until long after we are convinced that the
mach exception handling version works better.

* Establishing the mach exception handler

** x86-darwin-os.c

A new function, darwin_init, is added which creates the mach exception
handling thread and establishes the exception port. Currently the
"main" thread sets its exception port here, but when we go to a
multithreaded SBCL, we will need to do similarly for new threads in
arch_os_thread_init. Note that even "non-threaded" SBCL builds will
have two threads, one lisp thread and a mach exception handling
thread.

catch_exception_raise listens for EXC_BAD_ACCESS and
EXC_BAD_INSTRUCTION (and EXC_BREAKPOINT if we were to use INT3 traps
again instead of the SIGILL traps we've set up as a workaround to the
broken INT3 traps). Analogous to the signal handling context, mach
exceptions allow use to get the thread and exception state of the
triggering thread. We build a "fake" signal context, similar to what
would be seen if a SIGSEGV/SIGILL were triggered and pass this on to
SBCL's memory_fault_handler (for SIGSEGV) or sigill_handler (for
SIGILL). when the handlers return, we set the values of the
thread_state using the values from the fake context, allowing the
"signal handler" to modify the state of the calling thread.

** x86-arch.c

sigill_handler and sigtrap_handler are no longer installed as signal
handlers using undoably_install_low_level_interrupt_handler. Instead
sigill_handler is called directly by the mach exception handling
catch_exception_raise. This means that sigill_handler can no longer be
static void and it is changed to just void.

** bsd-os.c

memory_fault_error no longer installed using
undoably_install_low_level_interrupt_handler and changed to not be
static. darwin_init called.

* Handling exceptions

** interrupt.c

The code for general purpose error handling, which is generally done
by a trap instruction followed by an error opcode (although on Mac OS,
we use UD2A instead of INT3 as INT3 trapping is unreliable and the
sigill_handler in turn calls the sigtrap_handler). sigtrap_handler in
turn calls functions like interrupt_internal_error that are found in
interrupt.c.

Using BSD-style signal handling, interrupt_internal_error calls into
lisp via the lisp function INTERNAL-ERROR via funcall2 (the two
argument form of funcall). Since we are executing the exception
handler on the exception handling thread and we don't really want to
be executing lisp code on the exception handlers thread, we want to
return to the lisp thread as quickly as possible. With BSD-style
signal handling, the signal handlers themselves call into lisp using
funcallN. We can't do this as then we would be attempting to execute
lisp code on the exception handling thread. This would be a bad thing
in a multi-threaded lisp. Therefore, we borrow a trick from the
interrupt handling code and hack the stack of the offending thread
such that when the mach exception handling code returns, and returns
control back to the offending thread, it first calls a lisp function,
then (unless otherwise directed) returns control to the lisp
thread. This allows us to run our lisp (or other) code on the
offending thread's stack, but before the offending thread resumes
where it left off. See the arrange_return_to_lisp_function for details
on how this is done.

arrange_return_to_lisp_function was modified to take an additional
parameter specifying the number of additional arguments, and
additional varargs, which are then placed on the stack in the
call_into_lisp_tramp in x86-assem.S.

The problem with this is that both the signal handling/mach exception
handling code, on the one hand, and the lisp code expect access to the
"context" for accessing the state of the thread at the time that the
signal/exception was raised. This means that the old strategy was:

offending thread
  (operating system establishes signal context)
  signal handler
    lisp code
  signal handler
  (operating system restores state from signal context)
offending thread

and both the signal handler and the lisp code have the chance to
examine and modify the signal context. Now the situation looks like
this:

offending thread
 (operating system establishes thread_state)
 mach_exception_handler
   signal handler (which may arrange return to a lisp function)
 mach_exception_handler
 (operating system restores from thread_state)
 (optionally, a lisp function is called here)
offending thread

So we need to figure out how to provide the lisp function with
information about the context of the offending thread and allow the
lisp code to alter this state and to restore that state prior to
resuming control to the offending thread.

There are, presumably, additional problems with exception masking and
when threads are allowed to interrupt other threads or otherwise catch
signals/exceptions, but we can defer those for the moment.

* Providing a "context" for lisp functions called on returning from a
mach exception handler

Given the flow describe above, we need to expand the following step:

 (optionally, a lisp function is called here)

now it needs to look something like:

0. offending thread triggers a mach exception

1. (operating system establishes thread_state)

2. enter mach_exception_handler

  2a. signal handler (which may arrange return to a lisp function

  2b. frob the offending threads stack, allocating a context on the
      stack (if appropriate, or always?)

3. exit mach_exception_handler

4. (operating system restores from thread_state)

6. with the context on the stack, transfer control to the lisp
       function

7. restore the thread state from the context which either returns
   control to original location in the offending thread or to wherever
   the error-handling code has modified the context to point to
 

* x86-darwin-os.c (again)

** call_c_function_in_context and signal_emulation_wrapper

We arrange for a function to be a called by the offending the thread
when the mach exception handler returns. Essentially we have our own
BSD-style signal emulation library that calls memory_fault_handler,
sigtrap_handler and sigill_handler, as appropriate. It does this by
calling a function call_c_function_in_context which sets up the EIP of
the thread context to call the specified C function, which the
specified arguments. In this case, signal_emulation_wrapper which
takes as arguments a thread_state, which is a copy of the thread state
as it existed upon entry into catch_exception_raise, and an emulated
signal and siginfo and the signal handling function that
signal_emulation_wrapper is to call.

signal_emulation_wrapper creates a BSD-style signal context and
populates it from the values in the passed in thread_state. It calls
the specified signal_handler, and then sets the values in the
thread_state from the context and loads the address of the thread
state to restore into eax and then traps with a special trap that the
catch_exception_raise looks for, which then extracts the thread state
from the trap exception's thread_state.eax.

[MORE DETAILS TO FOLLOW]


===== BUGS =====

MEH1: on threaded macos builds, init.test.sh fails with a
      memory-fault-error (NOTE: this is a threaded macos issue, not a
      mach exception handler bug).

MEH2: timer.impure lisp fails on mach-exception-handler builds

MEH3: threads.impure lisp fails on mach-exception-handler builds

Update of /cvsroot/sbcl/sbcl/contrib/sb-posix
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv21157/contrib/sb-posix

Modified Files:
	interface.lisp macros.lisp 
Log Message:
1.0.1.1:
    mach exception handlers for x86/macos

    Added experimental support for mach exception handling under
    x86/macos. To enable this, turn on the feature
    :mach-exception-handler at build time.

  * restructure args to sb-posix:define-call so that :largefile
    becomes :options :largefile and add a new :c-name keyword arg.
  * for #+mach-exception-handler builds, make sb-posix:fork
    reestablish the mach exception handling thread after forking.
  * add doc/internals-notes/mach-exception-handler-notes.
  * memory_fault_handler no longer static for BSD.
  * added mach_error_memory_fault_handler for unexpected memory
    faults.
  * #+mach-exception-handler thread changes to allocate and deallocate
    mach ports.
  * added protect_control_stack_{return_}guard_page_thread calls that
    take a thread argument
  * sigill_handler no longer static on x86.
  * mach exception handling code in x86-darwin-os.c. See
    doc/internals-notes/mach-exception-handler-notes for details.


Index: interface.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-posix/interface.lisp,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -d -r1.32 -r1.33
--- interface.lisp	3 Dec 2006 15:24:10 -0000	1.32
+++ interface.lisp	26 Dec 2006 23:10:23 -0000	1.33
@@ -87,7 +87,7 @@
 (define-call* "dup" int minusp (oldfd file-descriptor))
 (define-call* "dup2" int minusp (oldfd file-descriptor)
               (newfd file-descriptor))
-(define-call* ("lseek" :largefile)
+(define-call* ("lseek" :options :largefile)
     off-t minusp (fd file-descriptor) (offset off-t)
     (whence int))
 (define-call* "mkdir" int minusp (pathname filename) (mode mode-t))
@@ -107,7 +107,7 @@
 (define-call* "rmdir" int minusp (pathname filename))
 (define-call* "unlink" int minusp (pathname filename))
 (define-call "opendir" (* t) null-alien (pathname filename))
-(define-call ("readdir" :largefile) (* dirent)
+(define-call ("readdir" :options :largefile) (* dirent)
   ;; readdir() has the worst error convention in the world.  It's just
   ;; too painful to support.  (return is NULL _and_ errno "unchanged"
   ;; is not an error, it's EOF).
@@ -128,7 +128,7 @@
   (define-call "fchown" int minusp (fd file-descriptor)
              (owner uid-t)  (group gid-t))
   (define-call "fdatasync" int minusp (fd file-descriptor))
-  (define-call ("ftruncate" :largefile)
+  (define-call ("ftruncate" :options :largefile)
       int minusp (fd file-descriptor) (length off-t))
   (define-call "fsync" int minusp (fd file-descriptor))
   (define-call "lchown" int minusp (pathname filename)
@@ -137,7 +137,7 @@
   (define-call "mkfifo" int minusp (pathname filename) (mode mode-t))
   (define-call "symlink" int minusp (oldpath filename) (newpath filename))
   (define-call "sync" void never-fails)
-  (define-call ("truncate" :largefile)
+  (define-call ("truncate" :options :largefile)
       int minusp (pathname filename) (length off-t))
   ;; FIXME: Windows does have _mktemp, which has a slightlty different
   ;; interface
@@ -189,7 +189,25 @@
 
   ;; processes, signals
   (define-call "alarm" int never-fails (seconds unsigned))
+
+
+
+  #+mach-exception-handler
+  (progn
+    ;; FIXME this is a lie, of course this can fail, but there's no
+    ;; error handling here yet!
+    (define-call "setup_mach_exceptions" void never-fails)
+    (define-call ("posix_fork" :c-name "fork") pid-t minusp)
+    (defun fork ()
+      (let ((pid (posix-fork)))
+        (when (= pid 0)
+          (setup-mach-exceptions))
+        pid))
+    (export 'fork :sb-posix))
+
+  #-mach-exception-handler
   (define-call "fork" pid-t minusp)
+
   (define-call "getpgid" pid-t minusp (pid pid-t))
   (define-call "getppid" pid-t never-fails)
   (define-call "getpgrp" pid-t never-fails)
@@ -245,7 +263,7 @@
 ;;; mmap, msync
 #-win32
 (progn
- (define-call ("mmap" :largefile) sb-sys:system-area-pointer
+ (define-call ("mmap" :options :largefile) sb-sys:system-area-pointer
    (lambda (res)
      (= (sb-sys:sap-int res) #.(1- (expt 2 sb-vm::n-machine-word-bits))))
    (addr sap-or-nil) (length unsigned) (prot unsigned)
@@ -312,7 +330,7 @@
         (declare (type (or null (sb-alien:alien (* alien-stat))) stat))
         (with-alien-stat a-stat ()
           (let ((r (alien-funcall
-                    (extern-alien ,(real-c-name (list name :largefile)) ,type)
+                    (extern-alien ,(real-c-name (list name :options :largefile)) ,type)
                     (,designator-fun ,arg)
                     a-stat)))
             (when (minusp r)

Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-posix/macros.lisp,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -d -r1.17 -r1.18
--- macros.lisp	12 Nov 2006 23:04:59 -0000	1.17
+++ macros.lisp	26 Dec 2006 23:10:23 -0000	1.18
@@ -28,13 +28,15 @@
 (defun real-c-name (name)
   (etypecase name
     (list
-     (destructuring-bind (name &rest options) name
-
-       (cond #+largefile
-             ((member :largefile options)
-              (format nil "~a_largefile" name))
-             (t
-              name))))
+     (destructuring-bind (name &key c-name options) name
+       (if c-name
+           c-name
+           (cond #+largefile
+                 ((or (eql options :largefile)
+                      (member :largefile options))
+                  (format nil "~a_largefile" name))
+                 (t
+                  name)))))
     (string
      name)))

Update of /cvsroot/sbcl/sbcl-page
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv17553

Modified Files:
	platform-support-platforms.lisp 
Log Message:
FreeBSD/x86 and x86-64 binary for 1.0.1


Index: platform-support-platforms.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl-page/platform-support-platforms.lisp,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -d -r1.54 -r1.55
--- platform-support-platforms.lisp	26 Dec 2006 18:02:59 -0000	1.54
+++ platform-support-platforms.lisp	26 Dec 2006 23:02:03 -0000	1.55
@@ -40,7 +40,8 @@
 (define-port :sparc :solaris :available :link "http://prdownloads.sourceforge.net/sbcl/sbcl-0.9.11-sparc-sunos-binary.tar.bz2?download")
 (define-port :x86 :solaris :available :link "http://prdownloads.sourceforge.net/sbcl/sbcl-0.9.14-x86-solaris-binary.tar.gz?download")
 
-(define-port :x86 :freebsd :available :link "http://prdownloads.sourceforge.net/sbcl/sbcl-1.0-x86-freebsd-binary.tar.bz2?download")
+(define-port :x86 :freebsd :available :link "http://prdownloads.sourceforge.net/sbcl/sbcl-1.0.1-x86-freebsd4-binary.tar.bz2?download")
+(define-port :x86-64 :freebsd :available :link "http://prdownloads.sourceforge.net/sbcl/sbcl-1.0.1-x86-64-freebsd6-binary.tar.bz2?download")
 (define-port :x86 :netbsd :available :link "http://prdownloads.sourceforge.net/sbcl/sbcl-0.9.1-x86-netbsd-binary.tar.bz2?download")
 (define-port :x86 :openbsd :available :link "http://prdownloads.sourceforge.net/sbcl/sbcl-0.8.10-x86-openbsd-binary.tar.bz2?download")

Update of /cvsroot/sbcl/sbcl-page
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv31810

Modified Files:
	index-page.lisp platform-support-platforms.lisp 
Log Message:
SBCL 1.0.1; PPC Darwin binary


Index: index-page.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl-page/index-page.lisp,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- index-page.lisp	30 Nov 2006 07:33:02 -0000	1.27
+++ index-page.lisp	26 Dec 2006 18:02:59 -0000	1.28
@@ -1,6 +1,6 @@
 (define-page :index "About SBCL" "index" index-page :index-order :top)
 
-(defparameter *most-recent-release* (list "1.0" "November 30, 2006"))
+(defparameter *most-recent-release* (list "1.0.1" "December 26, 2006"))
 
 (defun index-page ()
 

Index: platform-support-platforms.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl-page/platform-support-platforms.lisp,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -d -r1.53 -r1.54
--- platform-support-platforms.lisp	1 Dec 2006 02:47:23 -0000	1.53
+++ platform-support-platforms.lisp	26 Dec 2006 18:02:59 -0000	1.54
@@ -33,7 +33,7 @@
 (define-port :alpha :linux :available :link "http://prdownloads.sourceforge.net/sbcl/sbcl-0.9.12-alpha-linux-binary.tar.bz2?download")
 (define-port :hppa :linux :not-maintained)
 
-(define-port :ppc :darwin :available :link "http://prdownloads.sourceforge.net/sbcl/sbcl-1.0-ppc-darwin-binary.tar.bz2?download")
+(define-port :ppc :darwin :available :link "http://prdownloads.sourceforge.net/sbcl/sbcl-1.0.1-ppc-darwin-binary.tar.bz2?download")
 (define-port :x86 :darwin :available :link "http://prdownloads.sourceforge.net/sbcl/sbcl-1.0-x86-darwin-binary.tar.bz2?download")
 (define-port :x86-64 :darwin :in-progress)

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv25239

Modified Files:
	NEWS version.lisp-expr 
Log Message:
1.0.1:
	release, will be tagged as sbcl_1_0_1


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.1119
retrieving revision 1.1120
diff -u -d -r1.1119 -r1.1120
--- NEWS	15 Dec 2006 02:57:52 -0000	1.1119
+++ NEWS	26 Dec 2006 14:57:44 -0000	1.1120
@@ -41,7 +41,7 @@
        to Alastair Bridgewater)
     ** TRACE :ENCAPSULATE NIL (and function end breakpoints)
        work on Windows.
-    ** Lisp is able to unwind foreing exception frames from alien
+    ** Lisp is able to unwind foreign exception frames from alien
        callbacks. (thanks to Alastair Bridgewater)
 
 changes in sbcl-1.0 relative to sbcl-0.9.18:

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3142
retrieving revision 1.3143
diff -u -d -r1.3142 -r1.3143
--- version.lisp-expr	20 Dec 2006 16:19:33 -0000	1.3142
+++ version.lisp-expr	26 Dec 2006 14:57:44 -0000	1.3143
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.0.36"
+"1.0.1"

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=3DContent-Type content=3D"text/html; charset=3Diso-8859-1">
<META content=3D"MSHTML 6.00.2900.2912" name=3D"GENERATOR">
</HEAD>
<BODY>
<DIV><FONT face=3DArial size=3D2><STRONG>TTEN Continues Explosive=20
Growth</STRONG></FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2><STRONG><U>TTEN *** TTEN *** =
TTEN<BR>TTEN - Ten=20
&amp; 10, Inc.</U></STRONG></FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2><STRONG>Current Price</STRONG>:=20
08<BR><STRONG>Short Term Target:</STRONG> .50</FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2><STRONG>TTEN</STRONG> recently =
announced a key=20
development which will enable them to provide Value Added Services to =
the=20
<STRONG>55 million wireless subscribers</STRONG> of ChinaMobile's =
Guangzhou=20
Division through its joint venture with IEC. <STRONG>China Mobile is the =
largest=20
telecommunications provider in China</STRONG>, and the largest among all =
the=20
overseas listed Chinese companies on the Hong Kong and NewYork Stock=20
Exchanges.</FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2><STRONG>TTEN</STRONG> is made up of 4 =
operating=20
subsidiaries:</FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial=20
size=3D2>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbs=
p; Tech=20
10: WIFI and=20
WiMAX<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbs=
p;=20
Mobile 10: Music and mobile entertainment delivered via Internet, G3,=20
etc<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;=
 Dream=20
Learning Center: Digital Media Learning=20
products<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&=
nbsp;=20
Ten &amp; 10 Network: Sales and marketing</FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2>Telecommunications is globally a =
TRILLION dollar=20
industry.</FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2><STRONG><U>TTEN could see explosive =
growth as a=20
newly trading company - 500%-1000% is not =
uncommon.</U></STRONG></FONT></DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D2></FONT>&nbsp;</DIV>
<DIV><FONT face=3DArial size=3D1>Any of the above statements with =
respect to the=20
future predications or goals and events may be seen as only Forward =
Looking and=20
nothing else. All information inside this email pertaining to any sort =
of=20
financial advice needs to be understood as information and not advice. =
None of=20
the information above can be constructed as any sort of financial =
advice. This=20
is a paid advertisement.</FONT></DIV></BODY></HTML>

Update of /cvsroot/sbcl/sbcl/src/runtime
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv1686/src/runtime

Modified Files:
	ppc-darwin-os.c ppc-darwin-os.h 
Log Message:
1.0.0.36:
	Fix the build on ppc/Darwin, with os_context_register_t typedef
	and os_context_pc_addr function.


Index: ppc-darwin-os.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/ppc-darwin-os.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- ppc-darwin-os.c	6 Jun 2006 01:54:42 -0000	1.7
+++ ppc-darwin-os.c	20 Dec 2006 16:19:34 -0000	1.8
@@ -118,6 +118,12 @@
     return &context->uc_mcontext->ss.lr;
 }
 
+os_context_register_t *
+os_context_pc_addr(os_context_t *context)
+{
+    return &context->uc_mcontext->ss.srr0;
+}
+
 void
 os_flush_icache(os_vm_address_t address, os_vm_size_t length)
 {

Index: ppc-darwin-os.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/ppc-darwin-os.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- ppc-darwin-os.h	17 Apr 2005 19:41:28 -0000	1.2
+++ ppc-darwin-os.h	20 Dec 2006 16:19:34 -0000	1.3
@@ -1,6 +1,8 @@
 #ifndef _PPC_DARWIN_OS_H
 #define _PPC_DARWIN_OS_H
 
+typedef unsigned int os_context_register_t;
+
 static inline os_context_t *arch_os_get_context(void **void_context) {
     return (os_context_t *) *void_context;
 }

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv1686

Modified Files:
	version.lisp-expr 
Log Message:
1.0.0.36:
	Fix the build on ppc/Darwin, with os_context_register_t typedef
	and os_context_pc_addr function.


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3141
retrieving revision 1.3142
diff -u -d -r1.3141 -r1.3142
--- version.lisp-expr	20 Dec 2006 15:47:50 -0000	1.3141
+++ version.lisp-expr	20 Dec 2006 16:19:33 -0000	1.3142
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.0.35"
+"1.0.0.36"