[Openmcl-devel] Mangled list

[Waldek Hebisch]

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>--------------------------

-- 
                              Waldek Hebisch
hebisch at math.uni.wroc.pl