[Gcl-devel] Re: compiler bug

[Camm Maguire]

Greetings, and thanks!  This should be cleared now.

Take care,

Robert Boyer <address@hidden> writes:

> Here is a nonsuccinct but dumb bug report on the GCL
> compiler in today's GCL 2.7.0.
> 
> Running the Gabriel benchmark named 'browse' at safety=3
> does not cause an error, but running it at a lower value of
> safety does.  I suspect it has something to do with the
> number of values being returned/inferred/claimed.
> 
> Bob
> 
> -------------------------------------------------------------------------------
> 
> GCL (GNU Common Lisp)  2.7.0 ANSI    Jul  7 2006 15:09:03
> ...
> >(proclaim '(optimize (safety 2)))
> 
> NIL
> 
> >(load (compile-file "browse.cl"))
> 
> ;; Compiling browse.cl.
> ;; End of Pass 1.  
> ;; End of Pass 2.  
> ;; OPTIMIZE levels: Safety=2, Space=0, Speed=3, (Debug quality ignored)
> ;; Finished compiling browse.o.
> Loading /v/filer2/boyer/gabriel/browse.o
> Callee INVESTIGATE sigchange NIL to ((T T) T), recompiling BROWSE
> ;; Compiling /tmp/gazonk_15374_bzAulG.lsp.
> ;; End of Pass 1.  
> ;; End of Pass 2.  
> ;; OPTIMIZE levels: Safety=2, Space=0, Speed=3, (Debug quality ignored)
> ;; Finished compiling /tmp/gazonk_15374_bzAulG.o.
> Loading /tmp/gazonk_15374_bzAulG.o
> start address -T 0xac4af20 Finished loading /tmp/gazonk_15374_bzAulG.o
> Callee BROWSE sigchange (NIL *) to (NIL T), recompiling TESTBROWSE
> ;; Compiling /tmp/gazonk_15374_mn3Yfi.lsp.
> ;; End of Pass 1.  
> ;; End of Pass 2.  
> ;; OPTIMIZE levels: Safety=2, Space=0, Speed=3, (Debug quality ignored)
> ;; Finished compiling /tmp/gazonk_15374_mn3Yfi.o.
> Loading /tmp/gazonk_15374_mn3Yfi.o
> start address -T 0xac49700 Finished loading /tmp/gazonk_15374_mn3Yfi.o
> start address -T 0xac827c0 Finished loading /v/filer2/boyer/gabriel/browse.o
> 5394
> 
> >(testbrowse)
> 
> Error in TESTBROWSE [or a callee]: NIL is not of type NUMBER.
> 
> Fast links are on: do (si::use-fast-links nil) for debugging
> Broken at ERROR.  Type :H for Help.
>  1 (Continue) Return to top level.
> dbl:>>
> 
> -------------------------------------------------------------------------------
> 
> GCL (GNU Common Lisp)  2.7.0 ANSI    Jul  7 2006 15:09:03
> ...
> >(proclaim '(optimize (safety 3)))
> 
> NIL
> 
> >(load (compile-file "browse.cl"))
> 
> ;; Compiling browse.cl.
> ;; End of Pass 1.  
> ;; End of Pass 2.  
> ;; OPTIMIZE levels: Safety=3, Space=0, Speed=3, (Debug quality ignored)
> ;; Finished compiling browse.o.
> Loading /v/filer2/boyer/gabriel/browse.o
> Callee INVESTIGATE sigchange NIL to ((T T) T), recompiling BROWSE
> ;; Compiling /tmp/gazonk_15396_Ba3TyK.lsp.
> ;; End of Pass 1.  
> ;; End of Pass 2.  
> ;; OPTIMIZE levels: Safety=3, Space=0, Speed=3, (Debug quality ignored)
> ;; Finished compiling /tmp/gazonk_15396_Ba3TyK.o.
> Loading /tmp/gazonk_15396_Ba3TyK.o
> start address -T 0xac76478 Finished loading /tmp/gazonk_15396_Ba3TyK.o
> Callee BROWSE sigchange (NIL *) to (NIL T), recompiling TESTBROWSE
> ;; Compiling /tmp/gazonk_15396_MykYLq.lsp.
> ;; End of Pass 1.  
> ;; End of Pass 2.  
> ;; OPTIMIZE levels: Safety=3, Space=0, Speed=3, (Debug quality ignored)
> ;; Finished compiling /tmp/gazonk_15396_MykYLq.o.
> Loading /tmp/gazonk_15396_MykYLq.o
> start address -T 0xac26800 Finished loading /tmp/gazonk_15396_MykYLq.o
> start address -T 0xac8c720 Finished loading /v/filer2/boyer/gabriel/browse.o
> 15982
> 
> >(testbrowse)
> 
> real time       :      1.120 secs
> run-gbc time    :      0.920 secs
> child run time  :      0.000 secs
> gbc time        :      0.080 secs
> 
> NIL 
> NIL
> 
> >
> 
> -------------------------------------------------------------------------------
> Here's the file in question, 'browse.cl'.
> 
> 
> ;; $Header: browse.cl,v 1.2 88/01/03 19:28:21 layer Exp $
> ;; $Locker:  $
> 
> ;;; BROWSE -- Benchmark to create and browse through an AI-like data base
> ;;; of units.
> 
> ;;; n is # of symbols
> ;;; m is maximum amount of stuff on the plist
> ;;; npats is the number of basic patterns on the unit
> ;;; ipats is the instantiated copies of the patterns
> 
> (eval-when (eval load compile)
>   (defvar *browse-rand* 21)
>   (proclaim '(type fixnum *browse-rand*))
>   (defconstant *browse-star* (code-char 42))
>   (defconstant *browse-questionmark* (code-char 63)))
> 
> (eval-when (eval load compile)
>   ;; maybe SYMBOL-NAME
>   (defmacro browse-char1 (x) `(schar (symbol-name ,x) 0)))
> 
> 
> (defun browse-init (n m npats ipats)
>   (declare (type fixnum n m npats))
>   (setq *browse-rand* 21)
>   (let ((ipats (copy-tree ipats)))
>     (do ((p ipats (cdr p)))
>       ((null (cdr p)) (rplacd p ipats)))      
>     (do ((n n (the fixnum (1- n)))
>        (i m (cond ((= i 0) m)
>                   (t (the fixnum (1- i)))))
>        (name (gentemp) (gentemp))
>        (a ()))
>       ((= n 0) a)
>       (declare (type fixnum n i)) 
>       (push name a)
>       (do ((i i (the fixnum (1- i))))
>         ((= i 0))
>       (declare (type fixnum i))
>       (setf (get name (gensym)) nil))
>       (setf (get name 'pattern)
>           (do ((i npats (the fixnum (1- i)))
>                (ipats ipats (cdr ipats))
>                (a ()))
>               ((= i 0) a)
>             (declare (type fixnum i))
>             (push (car ipats) a)))
>       (do ((j (the fixnum (- m i)) (the fixnum (1- j))))
>         ((= j 0))
>       (declare (type fixnum j))
>       (setf (get name (gensym)) nil)))))  
> 
> 
> (defun browse-random ()
>   (setq *browse-rand* (rem (the fixnum (* *browse-rand* 17)) 251)))
> 
> (defun browse-randomize (l)
>   (do ((a ()))
>       ((null l) a)
>     (let ((n (rem (the fixnum (browse-random)) (the fixnum (length l)))))
>       (declare (type fixnum n))
>       (cond ((= n 0)
>            (push (car l) a)
>            (setq l (cdr l)))
>           (t 
>            (do ((n n (the fixnum (1- n)))
>                 (x l (cdr x)))
>                ((= n 1)
>                 (push (cadr x) a)
>                 (rplacd x (cddr x)))
>              (declare (type fixnum n))))))))
> 
> (defun match (pat dat alist)
>   (cond ((null pat)
>        (null dat))
>       ((null dat) ())
>       ((or (eq (car pat) '?)
>            (eq (car pat)
>                (car dat)))
>        (match (cdr pat) (cdr dat) alist))
>       ((eq (car pat) '*)
>        (or (match (cdr pat) dat alist)
>            (match (cdr pat) (cdr dat) alist)
>            (match pat (cdr dat) alist)))
>       (t (cond ((atom (car pat))
>                       ;;replace eq by 'eql for char   
>                 (cond ((eql (browse-char1 (car pat))
>                            *browse-questionmark*)
>                        (let ((val (assoc (car pat) alist)))
>                          (cond (val (match (cons (cdr val)
>                                                  (cdr pat))
>                                            dat alist))
>                                (t (match (cdr pat)
>                                          (cdr dat)
>                                          (cons (cons (car pat)
>                                                      (car dat))
>                                                alist))))))
>                       ((eql (browse-char1 (car pat)) *browse-star*)
>                        (let ((val (assoc (car pat) alist)))
>                          (cond (val (match (append (cdr val)
>                                                    (cdr pat))
>                                            dat alist))
>                                (t 
>                                 (do ((l () (nconc l (cons (car d) nil)))
>                                      (e (cons () dat) (cdr e))
>                                      (d dat (cdr d)))
>                                     ((null e) ())
>                                   (cond ((match (cdr pat) d
>                                                 (cons (cons (car pat) l)
>                                                       alist))
>                                          (return t))))))))))
>                (t (and 
>                     (not (atom (car dat)))
>                     (match (car pat)
>                            (car dat) alist)
>                     (match (cdr pat)
>                            (cdr dat) alist)))))))
> 
> (defun browse ()
>   (investigate (browse-randomize 
>                (browse-init 100 10 4 '((a a a b b b b a a a a a b b a a a)
>                                        (a a b b b b a a
>                                         (a a)(b b))
>                                        (a a a b (b a) b a b a))))
>              '((*a ?b *b ?b a *a a *b *a)
>                (*a *b *b *a (*a) (*b))
>                (? ? * (b a) * ? ?))))
> 
> (defun investigate (units pats)
>   (do ((units units (cdr units)))
>       ((null units))
>     (do ((pats pats (cdr pats)))
>       ((null pats))
>       (do ((p (get (car units) 'pattern)
>             (cdr p)))
>         ((null p))
>       (match (car pats) (car p) ())))))
> 
> (defun testbrowse ()
>   (print (time (browse))))
> 
> 
> 

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