[Openmcl-devel] Miscompiled code?

[Waldek Hebisch]

The attached code does not work with current trunk.  It used
to work in 1.5 era and works with other List implementation.
Transcripit below.  This is on 64-bit Core2 running Debian 6.0
(and image from about 2 week old trunk).  I got the same error
on different machine with trunk from yesterday (after rebuilding
the image).

BTW, I getting several failures which look similar, this is
minimalized version of just one.


hebisch at hera:~/kompi/axp104$ ../ccl2/scripts/ccl64
Welcome to Clozure Common Lisp Version 1.8-dev-r15159M-trunk  (LinuxX8664)!
? (load (compile-file "PRS1.lisp"))
;Compiler warnings for "PRS1.lisp" :
;   In LETT: Unused lexical variable L
;   In |pseudoDivide|: Unused lexical variable Q
;   In |semiSubResultantGcdEuclidean2|: Unused lexical variable VP
;   In MYDEG: Unused lexical variable TT
;   In an anonymous lambda form at position 2932: Undeclared free variable DD
;   In an anonymous lambda form at position 2952: Undeclared free variable A1
;   In an anonymous lambda form at position 2992: Undeclared free variable A2
#P"/home/n/k/hebisch/kompi/axp104/PRS1.lx64fsl"
? (|semiSubResultantGcdEuclidean2| a1 a2 dd)
> Error: (0 . 1) is not of type (OR SYMBOL FUNCTION), and can't be FUNCALLed or APPLYed
> While executing: |semiSubResultantGcdEuclidean2|, in process listener(1).
> Type :POP to abort, :R for a list of available restarts.
> Type :? for other options.

-- 
                              Waldek Hebisch
hebisch at math.uni.wroc.pl 
-------------- next part --------------
(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 :genera :lispworks)
                   (function ,(make-list (length l) :initial-element t) t)
               #+(or :genera :lispworks)function
            (car ,gi))
          , at args
          (cdr ,gi))))))

(defmacro LETT (var val &rest L) `(SETQ ,var ,val))

(defmacro QREFELT (vec ind) `(svref ,vec ,ind))

(defmacro qvelt (vec ind)
 `(svref ,vec (the fixnum ,ind)))

(defmacro exit (&rest value)
 `(return-from seq , at value))

(defmacro seq (&rest form)
  (let* ((body (reverse form))
         (val `(return-from seq ,(pop body))))
    (nsubstitute '(progn) nil body) ;don't treat NIL as a label
    `(block seq (tagbody ,@(nreverse body) ,val))))

(defun |spadConstant|(x y) (aref x y))

(defun GETREFV (n) (make-array n :initial-element nil))

(DEFUN |pseudoDivide| (P Q $)
  (SEQ (format t "pseudo Divide")
       (FORCE-OUTPUT)
       (EXIT (VECTOR (|spadConstant| $ 8) (|spadConstant| $ 10) P)))) 

(DEFUN |semiSubResultantGcdEuclidean2| (P Q $)
  (PROG (VP |pdiv| #2=#:G1992)
        (RETURN (SEQ (EXIT (COND ((ZEROP (SPADCALL Q (QREFELT $ 14)))
                                  (CONS (|spadConstant| $ 9) Q))
                                 ('T
                                  (SEQ
                                   (LETT
                                    VP
                                    (VECTOR Q (|spadConstant| $ 9))
                                    . #1=(|polRR|))
                                   (LETT
                                    |pdiv|
                                    (SPADCALL
                                     P
                                     (SPADCALL Q (QREFELT $ 15))
                                     (QREFELT $ 12))
                                    . #1#)
                                   (EXIT
                                    (PROGN
                                     (LETT
                                      #2#
                                      (CONS (QVELT |pdiv| 1) Q)
                                      . #1#)
                                     (GO #2#)))))))
                     #2#
                     (EXIT #2#))))) 


(defun mydeg(x tt) (car (car x)))
(defun myminus(x tt)
    (cond ((null x) nil)
          (t (let ((x0 (car x)))
                  (cons (cons (car x0) (- (cdr x0)))
                        (myminus (cdr x) tt))))))

(defun my_init()
  (LET (($ (GETREFV 22)))
      (setf (aref $ 8)  1)
      (setf (aref $ 9)  (list (cons 0 1)))
      (setf (aref $ 10) nil)
      (setf (aref $ 12) (cons #'|pseudoDivide| $))
      (setf (aref $ 14) (list #'mydeg))
      (setf (aref $ 15) (list #'myminus))
   $))

;;; a1 = '((2 . 6) (1 . -11) (0 . -1))
;;; a2 = '((1 . 12) (0 . 1))
(setf dd (my_init))
(setf a1 '((2 . 6) (1 . -11) (0 . -1)))
(setf a2 '((1 . 12) (0 . 1)))
;;; (|semiSubResultantGcdEuclidean2| a1 a2 dd)