[Gcl-devel] Re: compiler bug

[Camm Maguire]

Greetings, and thanks!

This is fixed here locally -- will let you know when a commit is in,
as it will likely also entail the faster mv stuff.  Might want to do
another local save in case of temporary instability.


This stuff is tricky, but thus far we've cut the mv call time by about
half depending on the test.  We're slightly slower than Schelter mv,
as we support different number of value returns.  It is still possible
to conditionalize this on the compiler knowing whether or not a fixed
number of values are returned.

Do you know which of

multiple-value-bind
multiple-value-setq
multiple-value-prog1
multiple-value-call
multiple-value-list

are most performance critical in acl2?

The basic idea follows the Shelter mv approach -- the first value is
returned as a normal C return, typically in a register.  We then pass
a leading extra argument indicating the stack where additional
arguments are to be placed.  0 is passed in the frequent case where we
only want one value, in this case no writing is done at all.
Furthermore, the callee can write straight to the C stack of the
caller, which would appear to avoid extra copying from the value
stack, but gcc is pretty smart about storing stuff in registers, so
this might only differ in copying from the vs into registers
vs. copying from the C stack into registers.  In general, though, the
performance difference shows up the more values that are involved.

Here is a mv-bind C snippet:

        register object  V6;
        object V5[2];
        #define V7 V5[0]
        #define V8 V5[1]
        V6= ((*LnkLI1)(V5,(V2)));/*V6 the fiirst value, V5 the rest*/
                                 /* the body then refers to the V7 and
                                    V8 cpp defines */
        {register object *_x=vs_top>V5 ? vs_top : V5;
        vs_top=sup;for (;_x<V5+2;*_x++=Cnil);}


And a values:

        { register object V5;
        V5= (V4);/* the first value*/
        {
        register object *V6=(object *)V3;
        if (V6) {     /*the others if a stack is provided*/
        *V6++= (V4);
        *V6++= (V4);
        vs_top=V6;
        } else {     /* otherwise, the forms are evaluated and thrown
                        away - as these are symbols here, nothing is
                        written.  In general, if we can pass
                        no-side-effect properties reliably, this can
                        always be empty.
        }}
        {object V7 = (V5);return
        (V7);}
        }


What is the performance difference to acl2 from Shelter vs. regular mv?

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