[Gcl-devel] Re: [Axiom-mail] A slow summation

[Camm Maguire]

Greetings, and thanks!

The problem here is the slow coerce in 2.6.x:

(defun coerce (object type)
  (when (typep object type)
        ;; Just return as it is.
        (return-from coerce object))
  (when (classp type)
    (specific-error :wrong-type-argument "Cannot coerce ~S to class ~S~%" 
object type))
  (setq type (normalize-type type))
  (case (car type)
    (list
     (do ((l nil (cons (elt object i) l))
          (i (1- (length object)) (1- i)))
         ((< i 0) l)))
    ((array simple-array)
     (unless (or (endp (cdr type))
                 (endp (cddr type))
                 (eq (caddr type) '*)
                 (endp (cdr (caddr type))))
             (error "Cannot coerce to an multi-dimensional array."))
     (do ((seq (make-sequence type (length object)))
          (i 0 (1+ i))
          (l (length object)))
         ((>= i l) seq)
       (setf (elt seq i) (elt object i))))
    (character (character object))
    (float (float object))
    ((short-float) (float object 0.0S0))
    ((single-float double-float long-float) (float object 0.0L0))
    (complex
     (if (or (null (cdr type)) (null (cadr type)) (eq (cadr type) '*))
         (complex (realpart object) (imagpart object))
         (complex (coerce (realpart object) (cadr type))
                  (coerce (imagpart object) (cadr type)))))
    (t (error "Cannot coerce ~S to ~S." object type))))

The elt usage effectively makes the loop quadratic.

Here is the version in 2.7.0, which still needs work, but will lilely be 
noticeably better:

(defconstant +coerce-list+ '(list vector string array character short-float 
long-float float complex function null cons))

(defun coerce (object type)
  (declare (optimize (safety 1)))
  (check-type type (and (not null) type-spec))
  (when (typep-int object type)
    (return-from coerce object))
  (let ((tp (or (car (member (if (atom type) type (car type)) +coerce-list+))
                (car (member type +coerce-list+ :test 'subtypep1)))))
    (case tp
      (function
       (coerce 
        (cond ((symbolp object) (cond ((fboundp object) (symbol-function 
object)) ((check-type-eval object type))))
              ((and (consp object) (eq (car object) 'lambda)) (values (eval 
`(function ,object))))
              ((function-identifierp object) (coerce (get (cadr object) 
'setf-function) tp))
              ((check-type-eval object type)))
        type))
       ((null cons list)
       (let* ((l (length object))
              (x (sequence-type-length-type type)))
         (when x (check-type l x))
         (do ((ll nil (cons (aref object i) ll))
              (i (1- l) (1- i)))
             ((< i 0) ll))))
      ((vector string array)
       (let* ((l (length object))
              (x (sequence-type-length-type type))
              (v (typep object 'list)))
         (when x (check-type-eval l x))
         (do ((seq (make-sequence type l))
              (i 0 (1+ i))
              (p (and v object) (and p (cdr p))))
             ((>= i l) seq)
          (setf (aref seq i) (if p (car p) (aref object i))))));;FIXME
      (character (character object))
      (short-float (float object 0.0S0))
      (long-float (float object 0.0L0))
      (float (float object))
      (complex
       (if (or (atom type) (null (cdr type)) (null (cadr type)) (eq (cadr type) 
'*))
           (complex (realpart object) (imagpart object))
         (complex (coerce (realpart object) (cadr type))
                  (coerce (imagpart object) (cadr type)))))
      (otherwise (check-type-eval object type)))))

(defun sequence-type-length-type-int (type)
    (case (car type)
          (cons (do ((i 0 (1+ i)) (x type (caddr type))) 
                    ((not (eq 'cons (car x))) 
                     (cond ((equal x '(member nil)) `(eql ,i))
                           ((not (equal x '(t))) `(eql ,(1+ i)))
                           ('(integer 1)))) (declare (seqind i))))
          (member (unless (cadr type) `(eql 0)))
          (array (and (cddr type) (consp (caddr type)) (= (length (caddr type)) 
1) (integerp (caaddr type))
                    `(eql ,(caaddr type))))
          ((or and) (reduce (lambda (&rest xy) (when xy 
                                                 (and (integerp (car xy)) 
                                                      (integerp (cadr xy)) 
                                                      (equal (car xy) (cadr 
xy)) (car xy))))
                            (mapcar 'sequence-type-length-type-int (cdr 
type))))))
          
(defun sequence-type-length-type (type)
  (cond ((eq type 'null) `(eql 0));;FIXME accelerators
        ((eq type 'cons) `(integer 1))
        ((consp type) (sequence-type-length-type-int (normalize-type type)))))


Coerce is almost inlineable -- I just have to put in compile-time
evaluation of constant typed forms with no side effects.

At one time I experimented with elt keeping a static pointer to the
last cons to make it linear in the usual case of subsequent access,
but rejected it as too dangerous.

As you have a workaround, I can leave 2.6.8pre alone in this regard,
yes?

Take care,


Waldek Hebisch <address@hidden> writes:

> Bill Page wrote:
> > On 6/15/07, Waldek Hebisch wrote:
> > > On my machine, I get the following (on the second run, to
> > > exclude time for loading):
> > >
> > >                                       gcl      sbcl          sbcl
> > >                                              interpreted  compiled
> > >  reduce(+,[1.0/i for i in 1..20000])   8.70      1.76        0.17
> > >  [i for i in 1..20000];                6.23      0.78        0.01
> > >  expand(1..20000);                     0         0.004       0.01
> > >
> 
> > Waldek, thank you very much for running this comparison!
> > 
> > So, the conclusion might be that I was wrong: the slowness *is*
> > because of the way that Axiom interpreter runs this code in
> > interpreted mode in GCL, right? It could still be that this interpreted
> > Lisp code is not written in an optimal manner.
> > 
> 
> As I wrote, it turned out that GCL interpreter is quite fast.  After
> using modified LIST2VEC function (patch below, applied to wh-sandbox),
> I get the following timings:
> 
>  reduce(+,[1.0/i for i in 1..20000])    0.69
>  [i for i in 1..20000];                 0.09
> 
> It seems that now significant part of execution time goes into
> floating point arithmetic.
> 
> --- src/interp/vmlisp.lisp.pamphlet   (wersja 606)
> +++ src/interp/vmlisp.lisp.pamphlet   (kopia robocza)
> @@ -1107,8 +1107,21 @@
>  
>  (defun GETREFV (n) (make-array n :initial-element nil))
>  
> +#-:GCL
>  (defun LIST2VEC (list) (coerce list 'vector))
>  
> +;;; At least in gcl 2.6.8 coerce is slow, so we roll our own version
> +#+:GCL
> +(defun LIST2VEC (list)
> +    (if (consp list)
> +        (let* ((len (length list))
> +               (vec (make-array len)))
> +             (dotimes (i len)
> +                  (setf (aref vec i) (pop list)))
> +             vec)
> +        (coerce list 'vector)))
> +
> +
>  (define-function 'LIST2REFVEC #'LIST2VEC)
>  
>  ; 16.2 Accessing
> 
> -- 
>                               Waldek Hebisch
> address@hidden 
> 
> 
> 

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