[I think this belongs to cmucl-imp but I also send a copy to
cmucl-help where this originated because some participants of the
original thread might not be subscribers to cmucl-imp. So, sorry for
the double post.]

Gerd Moellmann <[EMAIL PROTECTED]> writes:

> Could be, or it could be some bug.  I'd be very interested in an
> example of manageable size, the smaller the better, that shows the
> slowdown.  CL-PPCRE looks too large to find out where its hot spots
> are in reasonable time, without knowing anything about it.

OK, I've found something. I tried to find the bottleneck in CL-PPCRE
with the help of the PROFILE package and it turned out that I just
didn't look close enough.

The good thing: It's not Gerd's PCL that's responsible for the
slowdown.

The bad thing: Something that's relatively new in CMUCL[1] seems to be
responsible for a significant slowdown in GC times.

After fiddling around with various test cases I finally saw that the
difference between the old "fast" code and the new "slow" code was
always exactly the GC time. CL-PPCRE was just a good lackmus test for
this because it has to cons a lot to create scanners.

I then switched to the 18e-pre1 binaries from 2003-03-23 and found the
same results - GC is slower by a factor of about 10 to 15! I think
that's quite a lot and I wonder if that's considered acceptable. In my
particular case (the CL-PPCRE test suite) the new, slower GC is
responsible for almost doubling the overall execution time (it has
been increased from 1.3 to 2.4 seconds).

For what it's worth I've attached a reproducible test case below. It
wasn't hand-tailored to showcase the GC slowdown (but rather is a
remainder of my fruitless attempts to profile CL-PPCRE and find some
leak there) but it's pretty small and shows the differences in GC time
quite drastically. I guess that any code which conses enough will show
the difference.

In both cases the code was of course compiled.

Hope that helps,
Edi.

[1] compared to 18e-pre, built 2002-12-19 which I've been using -
    downloaded as a pre-built binary from some CMUCL mirror


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

[EMAIL PROTECTED]:/usr/local/lisp/source/cl-ppcre > cmucl
; Loading #p"/home/edi/.cmucl-init".
CMU Common Lisp 18e-pre, built 2002-12-19 on melbourne, running on bird.agharta.de
Send questions to [EMAIL PROTECTED] and bug reports to [EMAIL PROTECTED]
Loaded subsystems:
    Python 1.0, target Intel x86
    CLOS based on PCL version:  September 16 92 PCL (f)
* (load "test")

T
* (time (test 100000))
Compiling LAMBDA NIL:
Compiling Top-Level Form:

Evaluation took:
  5.63 seconds of real time
  4.985352 seconds of user run time
  0.61914 seconds of system run time
  [Run times include 0.16 seconds GC run time]
  164 page faults and
  240,012,224 bytes consed.
NIL
* (time (test 1000000))
Compiling LAMBDA NIL:
Compiling Top-Level Form:

Evaluation took:
  56.31 seconds of real time
  50.095703 seconds of user run time
  5.988281 seconds of system run time
  [Run times include 1.54 seconds GC run time]
  0 page faults and
  2,400,017,792 bytes consed.
NIL
* *features*

(:MK-DEFSYSTEM :PCL-STRUCTURES :PORTABLE-COMMONLOOPS :PYTHON :PCL :GLIBC2
 :LINUX :UNIX :LINKAGE-TABLE :GENCGC :MP :I486 :X86 :IEEE-FLOATING-POINT
 :ANSI-CL :COMMON-LISP :COMMON :NEW-COMPILER :HASH-NEW :CONSERVATIVE-FLOAT-TYPE
 :RANDOM-MT19937 :RELATIVE-PACKAGE-NAMES :CMU18D :CMU18 :CMU)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

[EMAIL PROTECTED]:/usr/local/lisp/source/cl-ppcre > cmucl
; Loading #p"/home/edi/.cmucl-init".
CMU Common Lisp 18e-pre1 2003-03-23-004, running on bird.agharta.de
With core: /usr/local/lib/cmucl/lib/lisp.core
Dumped on: Sun, 2003-03-23 12:45:32+01:00 on orion
See <http://www.cons.org/cmucl/> for support information.
Loaded subsystems:
    Python 1.1, target Intel x86
    CLOS 18e (based on PCL September 16 92 PCL (f))
* (load "test")

T
* (time (test 100000))
; Compiling LAMBDA NIL:
; Compiling Top-Level Form:

; Evaluation took:
;   7.95 seconds of real time
;   7.354492 seconds of user run time
;   0.552734 seconds of system run time
;   9,527,904,135 CPU cycles
;   [Run times include 2.48 seconds GC run time]
;   159 page faults and
;   240,019,392 bytes consed.
;
NIL
* (time (test 1000000))
; Compiling LAMBDA NIL:
; Compiling Top-Level Form:

; Evaluation took:
;   79.49 seconds of real time
;   73.731445 seconds of user run time
;   5.342774 seconds of system run time
;   95,293,730,151 CPU cycles
;   [Run times include 24.59 seconds GC run time]
;   0 page faults and
;   2,400,088,000 bytes consed.
;
NIL
* *features*

(:MK-DEFSYSTEM :PCL-STRUCTURES :PORTABLE-COMMONLOOPS :PCL :PYTHON :PENTIUM
 :I486 :LINKAGE-TABLE :MP :GENCGC :GLIBC2.1 :CMU18 :CMU18E
 :RELATIVE-PACKAGE-NAMES :CONSERVATIVE-FLOAT-TYPE :RANDOM-MT19937 :HASH-NEW
 :X86 :LINUX :GLIBC2 :UNIX :COMMON :CMU :NEW-COMPILER :COMMON-LISP :ANSI-CL
 :IEEE-FLOATING-POINT)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; This is test.lisp ;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun create-ranges-from-hash (hash &key downcasep)
  (declare (optimize speed
                     (safety 0)
                     (space 0)
                     (debug 0)
                     (compilation-speed 0)
                     #+:lispworks (hcl:fixnum-safety 0)))
  "Tries to identify up to three intervals (with respect to CHAR<)
which together comprise HASH. Returns NIL if this is not possible.
If DOWNCASEP is true it will treat the hash-table as if it represents
both the lower-case and the upper-case variants of its members and
will only return the respective lower-case intervals."
  ;; discard empty hash-tables
  (unless (and hash (plusp (hash-table-count hash)))
    (return-from create-ranges-from-hash nil))
  (loop with min1 and min2 and min3
        and max1 and max2 and max3
        ;; loop through all characters in HASH, sorted by CHAR<
        for chr in (sort (loop for chr being the hash-keys of hash
                               collect (if downcasep
                                         (char-downcase chr)
                                         chr))
                         #'char<)
        for code = (char-code chr)
        ;; MIN1, MAX1, etc. are _exclusive_
        ;; bounds of the intervals identified so far
        do (cond
             ((not min1)
               ;; this will only happen once, for the first character
               (setq min1 (1- code)
                     max1 (1+ code)))
             ((<= (the fixnum min1) code (the fixnum max1))
               ;; we're here as long as CHR fits into the first interval
               (setq min1 (min (the fixnum min1) (1- code))
                     max1 (max (the fixnum max1) (1+ code))))
             ((not min2)
               ;; we need to open a second interval
               ;; this'll also happen only once
               (setq min2 (1- code)
                     max2 (1+ code)))
             ((<= (the fixnum min2) code (the fixnum max2))
               ;; CHR fits into the second interval
               (setq min2 (min (the fixnum min2) (1- code))
                     max2 (max (the fixnum max2) (1+ code))))
             ((not min3)
               ;; we need to open the third interval
               ;; happens only once
               (setq min3 (1- code)
                     max3 (1+ code)))
             ((<= (the fixnum min3) code (the fixnum max3))
               ;; CHR fits into the third interval
               (setq min3 (min (the fixnum min3) (1- code))
                     max3 (max (the fixnum max3) (1+ code))))
             (t
               ;; we're out of luck, CHR doesn't fit
               ;; into one of the three intervals
               (return nil)))
        ;; on success return all bounds
        ;; make them inclusive bounds before returning
        finally (return (values (code-char (1+ min1))
                                (code-char (1- max1))
                                (and min2 (code-char (1+ min2)))
                                (and max2 (code-char (1- max2)))
                                (and min3 (code-char (1+ min3)))
                                (and max3 (code-char (1- max3)))))))

(defun test (n)
  (declare (optimize speed
                     (safety 0)
                     (space 0)
                     (debug 0)
                     (compilation-speed 0)
                     #+:lispworks (hcl:fixnum-safety 0)))
  (declare (fixnum n))
  (dolist (char-list '((#\a)
                       (#\a #\x)
                       (#\a #\x #\D)
                       (#\a #\k #\x #\D)
                       ((#\a . #\h))
                       ((#\a . #\h) (#\A . #\H))
                       ((#\a . #\h) (#\A . #\H) (#\0 . #\8))
                       ((#\a . #\h) (#\A . #\H) (#\0 . #\8) #\k)))
    (loop with hash = (make-hash-table)
          for char/pair in char-list
          do (cond ((characterp char/pair)
                     (setf (gethash char/pair hash) t))
                   (t (loop for code from (char-code (car char/pair)) to (char-code 
(cdr char/pair))
                            do (setf (gethash (code-char code) hash) t))))
          finally (loop for i of-type fixnum below n
                        do (create-ranges-from-hash hash)))))
                            
                                                     
                           

Reply via email to