Lisp HUG Maillist Archive

compiler crash, need workaround

Can you make this work?

	Thanks, Joel

---
(compile-file "/tmp/x.lisp")
;;; Compiling file /tmp/x.lisp ...
;;; Safety = 3, Speed = 1, Space = 1, Float = 1, Interruptible = 1
;;; Compilation speed = 1, Debug = 2, Fixnum safety = 3
;;; Source level debugging is on
;;; Source file recording is  on
;;; Cross referencing is on
; (LISPWORKS:TOP-LEVEL-FORM 0)
; (LISPWORKS:TOP-LEVEL-FORM 1)
; COMMON-LISP-USER::INTEGER-TO-FLOAT
; (LISPWORKS:TOP-LEVEL-FORM 3)
;;;*** Warning in COMMON-LISP-USER::READ-SINGLE-FLOAT-CAREFULLY: Ignoring type declaration with illegal type COMMON-LISP-USER::OCTET-VECTOR
;;;*** Warning in COMMON-LISP-USER::READ-SINGLE-FLOAT-CAREFULLY: Ignoring type declaration with illegal type COMMON-LISP-USER::VECTOR-INDEX

**++++ Error in COMMON-LISP-USER::READ-SINGLE-FLOAT-CAREFULLY: 
  Segmentation violation(11) [code 0] at 4130928BCA
     {Offset 310 inside #<Function 1 subfunction of (TOP-LEVEL-FORM 8) 4130928A94>}
rax            0 ; rbx   41302CC65C ; rcx            1 ; rdx   4000049839
rsp   404024B008 ; rbp   404024B018 ; rdi   40C01A8009 ; rsi   40C00CDC99
r8            1F ; r9           B2F ; r10   404021FF03 ; r11   40201D0183
r12   4000000000 ; r13   40A0187573 ; r14   4000049839 ; r15   4130928A94
;; Processing Cross Reference Information
; *** 1 error detected, no fasl file produced.

---

x.lisp:

(in-package :cl-user)

(defun integer-to-float (int)
  #-ieee-floating-point (error "fixme")
  (fli:with-integer-bytes(ptr len) int
    (let ((ft (ecase len
                (4 :lisp-single-float)
                (8 :lisp-double-float))))
      (fli:with-coerced-pointer
          (y :type ft) ptr
        (fli:dereference y)))))

(declaim (ftype (function (octet-vector
                           vector-index
                           vector-index)
                          (values single-float vector-index &optional))
                read-single-float-carefully)
         #+opt (inline read-single-float-carefully))

(defun read-single-float-carefully (buffer index limit)
  "Read a SINGLE-FLOAT from BUFFER starting at INDEX.  The float is stored
in BUFFER as a 4-octet little-endian IEEE single precision value.  Both the
float and the index of the first octet following it are returned.  If
reading the float would require octets beyond LIMIT, then signal
PARSE-OVERFLOW."
  (declare (type octet-vector buffer)
           (type vector-index index limit))
  (when (> (+ index 4) limit)
    (error 'data-exhausted))
  (let ((bits (aref buffer index)))
    (incf index)
    (setf bits (logior bits (ash (aref buffer index) 8)))
    (incf index)
    (setf bits (logior bits (ash (aref buffer index) 16)))
    (incf index)
    (setf bits (logior bits (ash (aref buffer index) 24)))
    (incf index)
    ;; BITS must have the correct sign.
    (when (= (ldb (byte 1 31) bits) 1)    ; sign bit set, so negative value
      (decf bits (ash 1 32)))
    (values (integer-to-float bits) index)
    ))


--------------------------------------------------------------------------
- for hire: mac osx device driver ninja, kernel extensions and usb drivers
---------------------+------------+---------------------------------------
http://wagerlabs.com | @wagerlabs | http://www.linkedin.com/in/joelreymont
---------------------+------------+---------------------------------------


Updated at: 2020-12-10 08:37 UTC