A test case for the issue of SBCL crashes should it load .Net Core runtime on Linux

sb-net-core-crash.lisp

;;; This file reproduces tha fact that SBCL crashes
;;;   while .Net runtime is loaded
;;; .Net Core SDK must be installed

;;; run the file like 'sbcl --script sb-net-core-crash.lisp'

(defun version-compare (left right)
  (labels ((parse (c)
             ;; Given .Net version naming convention,
             ;;   3.0.0 is actually greater then 3.0.0-rc1
             (or (ignore-errors (parse-integer c))
                 -1))
           (split (str &aux (end (length str)))
             (loop :with start = 0
                   :with components = '()
                   :for i :below end
                   :for c = (char str i)
                   :when (member c '(#\. #\-))
                     :do (push (subseq str start i)
                               components)
                         (setf start (1+ i))
                   :finally (unless (= start end)
                              (push (subseq str start end) components))
                            (return (nreverse (mapcar #'parse components)))))
           (cmp (a b) (cond ((> a b) 1) ((< a b) -1) (t 0)))
           (pad (list other-length)
             (let ((length (length list)))
               (if (< length other-length)
                 (append list (make-list (- other-length length)
                                         :initial-element 0))
                 list))))
    (loop :with v1 = (split left)
          :with v2 = (split right)
          :with v1-len = (length v1)
          :with v2-len = (length v2)
          :for left :on (pad v1 v2-len)
          :and right :on (pad v2 v1-len)
          :for a = (car left)
          :for b = (car right)
          :do (cond ((< a b) (return -1))
                    ((> a b) (return 1)))
          :finally (return (cond (left (cmp a 0))
                                 (right (cmp 0 b))
                                 (t 0))))))

(defun version> (left right)
  (= 1 (version-compare left right)))

(defun find-dotnet ()  
  (let* ((out (with-output-to-string (s)
                (sb-ext:run-program "dotnet" '("--list-runtimes")
                                    :search t
                                    :output s)))
         (list (with-input-from-string (in out)
                 (loop :for line = (read-line in nil)                       
                       :while line
                       :when (search "Microsoft.NETCore.App" line)
                         :collect (let* ((ver-start (1+ (position #\Space line)))
                                         (ver-end (position #\Space line :start ver-start))
                                         (path-start (1+ (position #\[ line)))
                                         (path-end (position #\] line))
                                         (version (subseq line ver-start ver-end))
                                         (dir (merge-pathnames
                                               (make-pathname
                                                :directory (list :relative version))
                                               (truename (subseq line path-start path-end))))
                                         (lib (truename
                                               (merge-pathnames
                                                #+win32
                                                "coreclr.dll"
                                                #+linux
                                                "libcoreclr.so"
                                                #+darwin
                                                "libcoreclr.dylib"
                                                #-(or win32 linux darwin)
                                                (error "Unsupported platform")
                                                dir))))
                                    (cons version lib)))))
         (latest (first (sort list #'version> :key #'car))))
    (cdr latest)))

(defvar *coreclr-location* (find-dotnet))

(defun load-dotnet ()
  (format *error-output* "Loading ~a~%" *coreclr-location*)
  (load-shared-object *coreclr-location*))

(defvar *coreclr-lib* (load-dotnet))

(defconstant +path-separator+ #+win32 #\; #-win32 #\:)

(defun get-trusted-platform-assemblies ()
  (format nil (concatenate 'string "~{~a" "~^" (string +path-separator+) "~}")
          (directory (make-pathname :type "dll"
                                    :name :wild
                                    :defaults *coreclr-location*))))

(defvar *trusted-platform-assemblies*
  (get-trusted-platform-assemblies))

#+win32
(progn
  (sb-alien:define-alien-routine
      ("GetModuleFileNameW" get-module-file-name)
    sb-alien:unsigned-int
    (module sb-sys:system-area-pointer)
    (buffer sb-sys:system-area-pointer)
    (size sb-alien:unsigned-int))
  (defun get-exe-path ()
    ;; 1K ought to be enough for anybody
    (sb-alien:with-alien ((buf (array char 1024)))
      (get-module-file-name (sb-sys:int-sap 0)
                            (sb-alien:alien-sap buf)
                            1024)
      (sb-alien:cast buf (c-string :external-format :utf-16le)))))

#+linux
(defun get-exe-path ()
  (namestring (truename "/proc/self/exe")))

#+darwin
(progn
  (sb-alien:define-alien-routine
      ("_NSGetExecutablePath" ns-get-executable-path)
    sb-alien:int
    (buf sb-sys:system-area-pointer)
    (size sb-alien:unsigned-int))  
  (defun get-exe-path ()
    ;; 1K ought to be enough for anybody
    (sb-alien:with-alien ((buf (array char 1024)))
      (ns-get-executable-path (sb-alien:alien-sap buf) 1024)
      (sb-alien:cast buf c-string))))


(sb-alien:define-alien-routine
    ("coreclr_initialize" %coreclr-initialize)
  sb-alien:unsigned-int
  (exe-path sb-alien:c-string)
  (app-domain-name sb-alien:c-string)
  (propcount sb-alien:int)
  (propkeys (array sb-alien:c-string 1))
  (propvals (array sb-alien:c-string 1))
  (host-handle sb-alien:system-area-pointer :out)
  (domain-id sb-alien:unsigned-int :out))

(defun coreclr-initialize ()
  (sb-alien:with-alien ((keys (array sb-alien:c-string 1))
                        (values (array sb-alien:c-string 1)))
    (let ((key (sb-alien:make-alien-string "TRUSTED_PLATFORM_ASSEMBLIES"))
          (value (sb-alien:make-alien-string *trusted-platform-assemblies*)))
      (setf (sb-alien:deref keys 0) key
            (sb-alien:deref values 0) value)
      (unwind-protect
           (multiple-value-bind
                 (rv host-handle domain-id)
               (%coreclr-initialize (get-exe-path) "SBCL" 1 keys values)
             (unless (zerop rv)
               (error "Unable to initialize CoreCLR: 0x~8,'0X" rv))
             (format *error-output* "Initialized CoreCLR ~%")
             (cons host-handle domain-id))
        (sb-alien:free-alien key)
        (sb-alien:free-alien value)))))

(defvar *host-domain* (coreclr-initialize))

;;; Here you'll get the crash on Linux
(dotimes (i 1000)
  (compile 'foo `(lambda (x) (+ x ,(random 100)))))

Sent the dump to sbcl-devel and attached it to the bug report on launchpad https://bugs.launchpad.net/sbcl/+bug/1834964