[Top][All Lists]

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

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

From: Camm Maguire
Subject: [Gcl-devel] Re: [Axiom-mail] A slow summation
Date: 16 Jun 2007 13:12:33 -0400
User-agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.4

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)
     (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))
     (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
        (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)))
       ((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))
       (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 
(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,

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

reply via email to

[Prev in Thread] Current Thread [Next in Thread]