1.0.4.31: remove *internal-error-context*

[sbcl.git] / src / code / host-c-call.lisp

diff --git a/src/code/host-c-call.lisp b/src/code/host-c-call.lisp
index 1976a2f..eb12c39 100644 (file)
--- a/src/code/host-c-call.lisp
+++ b/src/code/host-c-call.lisp
@@ -36,7 +36,11 @@
 
 (define-alien-type-method (c-string :lisp-rep) (type)
   (declare (ignore type))
-  '(or simple-string null (alien (* char))))
+  '(or simple-string null (alien (* char)) (simple-array (unsigned-byte 8))))
+
+(define-alien-type-method (c-string :deport-pin-p) (type)
+  (declare (ignore type))
+  t)
 
 (defun c-string-needs-conversion-p (type)
   #+sb-xc-host
@@ -77,45 +81,27 @@
             `(%naturalize-c-string ,alien))))
 
 (define-alien-type-method (c-string :deport-gen) (type value)
+  (declare (ignore type))
   `(etypecase ,value
      (null (int-sap 0))
      ((alien (* char)) (alien-sap ,value))
-     ;; FIXME: GC safety alert! These SAPs are not safe, since the
-     ;; Lisp string can move. This is not hard to arrange, for example
-     ;; the following will fail very quickly on a SB-UNICODE build:
-     ;;
-     ;;   (setf (bytes-consed-between-gcs) 4096)
-     ;;   (define-alien-routine "strcmp" int (s1 c-string) (s2 c-string))
-     ;;
-     ;;   (loop
-     ;;     (let ((string "hello, world"))
-     ;;       (assert (zerop (strcmp string string)))))
-     ;;
-     ;; (This will appear to work on post-0.9.8.19 GENCGC, since
-     ;;  the GC no longer zeroes memory immediately after releasing
-     ;;  it after a minor GC. Either enabling the READ_PROTECT_FREE_PAGES
-     ;;  #define in gencgc.c or modifying the example so that a major
-     ;;  GC will occasionally be triggered would unmask the bug).
-     ;;
-     ;; The pure VECTOR-SAP branch for the SIMPLE-BASE-STRING case
-     ;; will generally be very hard to trigger on GENCGC (even when
-     ;; threaded) thanks to GC conservativeness. It's mostly a problem
-     ;; on cheneygc.  -- JES, 2006-01-13
+     (vector (vector-sap ,value))))
+
+(define-alien-type-method (c-string :deport-alloc-gen) (type value)
+  `(etypecase ,value
+     (null nil)
+     ((alien (* char)) ,value)
      (simple-base-string
       ,(if (c-string-needs-conversion-p type)
            ;; If the alien type is not ascii-compatible (+SB-UNICODE)
            ;; or latin-1-compatible (-SB-UNICODE), we need to do
            ;; external format conversion.
-           `(vector-sap (string-to-c-string ,value
-                                            (c-string-external-format ,type)))
+           `(string-to-c-string ,value
+                                (c-string-external-format ,type))
            ;; Otherwise we can just pass it uncopied.
-           `(vector-sap ,value)))
-     ;; This case, on the other hand, will cause trouble on GENCGC, since
-     ;; we're taking the SAP of a immediately discarded temporary -> the
-     ;; conservativeness doesn't protect us.
-     ;; -- JES, 2006-01-13
+           value))
      (simple-string
-      (vector-sap (string-to-c-string ,value
-                                      (c-string-external-format ,type))))))
+      (string-to-c-string ,value
+                          (c-string-external-format ,type)))))
 
 (/show0 "host-c-call.lisp end of file")