[Gcl-devel] Re: address@hidden: GCL Compiler Bug]

[Matt Kaufmann]

That was quick!  Thanks for this and all your GCL work.

-- Matt
   Cc: address@hidden, address@hidden
   From: Camm Maguire <address@hidden>
   Date: 06 Mar 2004 09:20:11 -0500
   User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2
   Content-Type: text/plain; charset=us-ascii

   Hi Matt, and thanks for the report!

   This patch seems to do the trick.  Am testing, and will include in
   2.6.2 if all holds up.  You and the submitter might want to test too.

   Take care,

   =============================================================================
   Index: gcl_cmpinline.lsp
   ===================================================================
   RCS file: /cvsroot/gcl/gcl/cmpnew/gcl_cmpinline.lsp,v
   retrieving revision 1.6
   diff -u -r1.6 gcl_cmpinline.lsp
   --- gcl_cmpinline.lsp        31 Oct 2003 01:22:12 -0000      1.6
   +++ gcl_cmpinline.lsp        6 Mar 2004 14:15:34 -0000
   @@ -53,25 +53,51 @@

    (defun args-info-changed-vars (var forms)
      (case (var-kind var)
   -        ((LEXICAL FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT)
   -         (dolist** (form forms)
   -           (when (member var (info-changed-vars (cadr form)))
   +    ((LEXICAL FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT)
   +     (dolist** (form forms)
   +           (when (member var (info-changed-vars (cadr form)))
                     (return-from args-info-changed-vars t))))
   -        (REPLACED nil)
   -        (t (dolist** (form forms nil)
   -             (when (or (member var (info-changed-vars (cadr form)))
   -                       (info-sp-change (cadr form)))
   +    (REPLACED nil)
   +    (t (dolist** (form forms nil)
   +             (when (or (member var (info-changed-vars (cadr form)))
   +                       (info-sp-change (cadr form)))
                       (return-from args-info-changed-vars t)))))
      )

   +;; Variable references in arguments can also be via replaced variables
   +;; (see gcl_cmplet.lsp) It appears that this is not necessary when
   +;; checking for changed variables, as matches would appear to require
   +;; that the variable not be replaced.  It might be better to provide a
   +;; new slot in the var structure to point to the variable by which one
   +;; is replaced -- one would need to consider chains in such a case.
   +;; Here we match on the C variable reference, which should be complete.
   +;; 20040306 CM
   +
   +(defun var-rep-loc (x)
   +  (and
   +   (eq (var-kind x) 'replaced)
   +   (consp (var-loc x)) ;; may not be necessary, but vars can also be 
replaced to 'locations
   +                       ;; see gcl_cmplet.lsp
   +   (cadr (var-loc x))))
   +
   +(defmacro eql-not-nil (x y) `(and ,x (eql ,x ,y)))
   +
   +(defun var-rep-eq (x y)
   +  (or
   +   (eq x y)
   +   (let ((rx (var-rep-loc x)) (ry (var-rep-loc y)))
   +     (or (eql-not-nil (var-loc x) ry)
   +     (eql-not-nil (var-loc y) rx)
   +     (eql-not-nil rx ry)))))
   +
    (defun args-info-referred-vars (var forms)
      (case (var-kind var)
            ((LEXICAL REPLACED FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT)
             (dolist** (form forms nil)
   -           (when (member var (info-referred-vars (cadr form)))
   +           (when (member var (info-referred-vars (cadr form)) :test 
#'var-rep-eq)
                     (return-from args-info-referred-vars t))))
            (t (dolist** (form forms nil)
   -             (when (or (member var (info-referred-vars (cadr form)))
   +             (when (or (member var (info-referred-vars (cadr form)) :test 
#'var-rep-eq)
                           (info-sp-change (cadr form)))
                       (return-from args-info-referred-vars t))))
            ))
   Index: sys-proclaim.lisp
   ===================================================================
   RCS file: /cvsroot/gcl/gcl/cmpnew/sys-proclaim.lisp,v
   retrieving revision 1.3
   diff -u -r1.3 sys-proclaim.lisp
   --- sys-proclaim.lisp        1 Dec 2003 01:54:11 -0000       1.3
   +++ sys-proclaim.lisp        6 Mar 2004 14:15:36 -0000
   @@ -55,7 +55,7 @@
        '(FTYPE (FUNCTION (*) T) MAKE-FUN LIST-INLINE LIST*-INLINE WT-CLINK
                FCALLN-INLINE MAKE-BLK CS-PUSH MAKE-VAR MAKE-TAG MAKE-INFO)) 
    (PROCLAIM
   -    '(FTYPE (FUNCTION (T) T) TAG-LABEL C1BOOLE3 TAG-UNWIND-EXIT
   +    '(FTYPE (FUNCTION (T) T) VAR-REP-LOC TAG-LABEL C1BOOLE3 TAG-UNWIND-EXIT
                SCH-GLOBAL TAG-VAR C1ASH-CONDITION TAG-SWITCH C1ASH
                ARGS-CAUSE-SIDE-EFFECT WT-VV C1LENGTH WT-CAR ADD-CONSTANT
                WT-CDR WT-CADR VAR-NAME GET-ARG-TYPES VAR-REF WT-VS-BASE
   @@ -116,7 +116,7 @@
                CMPWARN CMPNOTE C1CASE ADD-INIT UNWIND-EXIT WT-INTEGER-LOC
                FAST-LINK-PROCLAIMED-TYPE-P)) 
    (PROCLAIM
   -    '(FTYPE (FUNCTION (T T) T) PROCLAIM-VAR CO1LDB SET-JUMP-TRUE CO1EQL
   +    '(FTYPE (FUNCTION (T T) T) VAR-REP-EQ PROCLAIM-VAR CO1LDB SET-JUMP-TRUE 
CO1EQL
                CO1SPECIAL-FIX-DECL CO1TYPEP WT-FIXNUM-VALUE CO1SCHAR
                WT-CHARACTER-VALUE CO1CONS WT-LONG-FLOAT-VALUE CO1READ-BYTE
                WT-SHORT-FLOAT-VALUE CO1READ-CHAR CO1WRITE-BYTE C1DECL-BODY
   =============================================================================

   Matt Kaufmann <address@hidden> writes:

   > Hi, Camm --
   > 
   > Below is an email reporting a problem with GCL 2.5.0, but I've just checked
   > that the problem still occurs with a version of GCL 2.6.1 (built Nov. 16 
at UT
   > CS).  The problem goes away if you do this before compilation, in which 
case
   > the message about eliminating tail recursion goes away.
   > 
   > (proclaim (quote (optimize (speed 0)
   >                       (space 0)
   >                       (safety 3))))
   > 
   > But if you use (safety 2), GCL says it's doing tail recursion elimination 
and
   > the problem occurs.
   > 
   > Please let me know if there's a better way for me to report such possible
   > issues, or if there's a changelog on the web that I should search first.
   > 
   > Thanks --
   > -- Matt
   > From: "Erik H. Reeber" <address@hidden>
   > Subject: GCL Compiler Bug
   > To: Matt Kaufmann <address@hidden>
   > Date: Fri, 5 Mar 2004 12:40:27 -0600 (CST)
   > 
   > 
   > Hello,
   > 
   >    I'm using GCL version 2.5.0 and I ran into a wierd compiler bug related
   > to tail recursive elimination (I think).
   > 
   >    It's an easy bug to work around, but I figured you might like to see
   > it.  I also am not sure what the protocol is for reporting bugs like
   > this or whether it is a known bug, so I'm hoping you can tell me what to
   > do.
   > 
   > Here's a simplified version of my function that exhibits the bug:
   > 
   > (defun wierd-problem (s n x)
   >   (if (endp s)
   >       (reverse x)
   >     (let ((y n)
   >           (new-n (1+ n)))
   >       (wierd-problem (cdr s) new-n (cons y x)))))
   > 
   > Here's an example output, before compilation:
   > 
   > ACL2 !>(wierd-problem '(a b) 1 nil)
   > (1 2)
   > 
   > and after compilation:
   > 
   > ACL2 !>(wierd-problem '(a b) 1 nil)
   > (2 3)
   > 
   > 
   > - -Erik
   > ----------
   > 
   > 
   > 
   > 

   -- 
   Camm Maguire                                         address@hidden
   ==========================================================================
   "The earth is but one country, and mankind its citizens."  --  Baha'u'llah