[Openmcl-devel] Mangled list

[R. Matthew Emerson]

Gary checked in a fix for this bug in the trunk a few days ago.

http://trac.clozure.com/ccl/ticket/1241


On Nov 3, 2014, at 1:07 AM, Waldek Hebisch <hebisch at math.uni.wroc.pl> wrote:

> When I compile and run program below like:
> 
> (load (compile-file "ttt5.lisp"))
> (ainsert ll 7.0d0 9.0d0 vv)
> 
> I get the following printout:
> 
> (1.0D0 2.0D0 3.0D0)
> (1.0D0 8.0D0 . 138567600)
> 
> The ainsert function is supposed to insert computed value
> after the first element of the list.  The value is
> inserted, but the list gets mangled.
> 
> Removing declarations changes second printout to expected
> 
> (1.0D0 8.0D0 2.0D0 3.0D0)
> 
> Similarly, after removing first printout problem disappears.
> 
> This is using 1.10 release on 64-bit Fedora 9.
> 
> This is minimized example.  Real problem occured in FriCAS
> plotting code.  In real example I do not have first printout and
> problem appears later (there is extra code and two insertions
> and apparently only second insertion fails).
> 
> --------------------<cut here ttt5.lisp>----------------------
> 
> (defun PRETTYPRINT (x &optional (stream *standard-output*))
>  (let ((*print-pretty* t) (*print-array* t))
>    (prin1 x stream))
>  (terpri stream))
> 
> (defmacro SPADCALL (&rest L)
>  (let ((args (butlast l))
>        (fn (car (last l)))
>        (gi (gensym)))
>     ;; (values t) indicates a single return value
>    `(let ((,gi ,fn))
>       (the (values t)
>         (funcall
>          (the #-(or :GCL :genera :lispworks)
>                   (function ,(make-list (length l) :initial-element t) t)
>               #+(or :GCL :genera :lispworks)function
>            (car ,gi))
>          , at args
>          (cdr ,gi))))))
> 
> (defmacro qrefelt (vec ind)
> `(svref ,vec ,ind))
> 
> (defmacro DEF_DF_BINOP (name op) `(defmacro ,name (x y) `(,',op ,x ,y)))
> (DEF_DF_BINOP |add_DF| +)
> (DEF_DF_BINOP |div_DF| /)
> 
> (DEFUN ainsert (|st| \t0 \t1 $)
>  (declare (type (DOUBLE-FLOAT) \t0))
>  (declare (type (DOUBLE-FLOAT) \t1))
>  (LET ((\t nil) (|tj| 0.0d0))
>      (declare (type (DOUBLE-FLOAT) |tj|))
>      (SETF \t |st|)
>      (PRETTYPRINT \t)
>      (SETF |tj| (|div_DF| (|add_DF| \t0 \t1)
>            (FLOAT 2 MOST-POSITIVE-DOUBLE-FLOAT)))
>      (SPADCALL \t '|rest| (CONS |tj| (CDR \t)) (QREFELT $ 8))
>      (PRETTYPRINT \t)))
> 
> (DEFUN set_rest (l sel r1 $) (setf (cdr l) r1))
> 
> (defvar vv)
> (setf vv (make-array '(9)))
> (setf (aref vv 8) (list (function set_rest)))
> (defvar ll)
> (setf ll (list 1.0d0 2.0d0 3.0d0))
> ;;; (ainsert ll 7.0d0 9.0d0 vv)
> 
> ----------------------<cut here>--------------------------