[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

A bug fix




I forgot who detected this bug....

There was a bug in the function definition of c2LAMBDA-EXPR-WITHOUT-KEY
in the file cmpnew/cmplam.lsp.  To fix the bug, replace the first
clause of the COND form:

  (cond (optionals ....)
        (rest ...)
        (t ...))

with the following clause.

       (optionals
         (let ((*clink* *clink*)
               (*unwind-exit* *unwind-exit*)
               (*ccb-vs* *ccb-vs*))
           (when rest
             (wt-nl "vs_top[0]=Cnil;")
             (wt-nl "{object *p=vs_top, *q=vs_base+" (length optionals) ";")
             (wt-nl " for(;p>q;p--)p[-1]=MMcons(p[-1],p[0]);}"))
           (do ((opts optionals (cdr opts)))
               ((endp opts))
               (declare (object opts))
             (push (next-label) labels)
             (wt-nl "if(vs_base>=vs_top){")
             (reset-top)
             (wt-go (car labels)) (wt "}")
             (c2bind (caar opts))
             (when (caddar opts) (c2bind-loc (caddar opts) t))
             (when (cdr opts) (wt-nl "vs_base++;"))
             )
           (when rest (c2bind rest))
           )

         (wt-nl) (reset-top)

         (let ((label (next-label)))
           (wt-nl) (wt-go label)

           (setq labels (reverse labels))

           ;;; Bind unspecified optional parameters.
           (dolist** (opt optionals)
             (wt-label (car labels))
             (pop labels)
             (c2bind-init (car opt) (cadr opt))
             (when (caddr opt) (c2bind-loc (caddr opt) nil)))

             (when rest (c2bind-loc rest nil))

             (wt-label label)))

-- Taiichi