Added support for clisp, cmucl, ecl, sbcl.
Benchmark (execution time and memory footprint) for mapleok.input:
(after patch vs before patch)
====
)time long
)storage long
systemCommand "read src/input/mapleok.input"
====
sbcl:
10.2s 7.5GB vs 14.4s 13.5GB
cmucl:
17.4s 5.3GB vs 24.9s 8.3GB
clisp:
132s 7.7GB vs 222s 13.7GB
ecl:
46s vs 79s
I've added debugging facility, so that you can test its effects
without compiling twice:
by using "setExpandCacheThreshold(6000)$SCACHE Kernel EXPR INT"
you effectively disable recycle on kernel cache.
I'll try to find more benchmarks as well.
BTW, lispworks and clozurecl doesn't have weak pointers,
but lispworks has weak hashtable and clozurecl has weak array.
They can be implemented, but a bit more complicated.
- Qian
--
You received this message because you are subscribed to the Google Groups
"FriCAS - computer algebra system" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to [email protected].
To view this discussion visit
https://groups.google.com/d/msgid/fricas-devel/049e7911-9045-4418-9f6a-ef83a3a7cd4b%40gmail.com.
diff --git a/src/algebra/kl.spad b/src/algebra/kl.spad
index 0365b60f..bcc2be37 100644
--- a/src/algebra/kl.spad
+++ b/src/algebra/kl.spad
@@ -28,6 +28,9 @@ SortedCache(S : CachableSet) : Exports == Implementation where
Exports ==> with
clearCache : () -> Void
++ clearCache() empties the cache.
+ getCache : () -> PrimitiveArray S
+ compactCache : () -> Void
+ setExpandCacheThreshold : PositiveInteger -> PositiveInteger
enterInCache : (S, S -> Boolean) -> S
++ enterInCache(x, f) enters x in the cache, calling \spad{f(y)} to
++ determine whether x is equal to y. It returns x with an integer
@@ -55,11 +58,29 @@ SortedCache(S : CachableSet) : Exports == Implementation where
cache : PrimitiveArray S := empty()$(PrimitiveArray S)
cache_size : N := 0
cache_use : N := 0
+ ExpandCacheThreshold : PositiveInteger := 300
+
+ getCache() == cache
+
+ setExpandCacheThreshold n ==
+ old := ExpandCacheThreshold
+ ExpandCacheThreshold :=n
+ old
+
+ compactCache() ==
+ cache_size = 0 => void()
+ not HAVE_WEAK_POINTERP()$Lisp => void()
+ ocache := cache
+ x := ocache.0
+ cache := new(cache_size, x)$(PrimitiveArray S)
+ cache_use := COMPACT_WEAK_ARRAY(cache, ocache, cache_use, x)$Lisp
+ void()
expandCache(x) ==
if cache_size = cache_use then
+ compactCache()
ocache := cache
- cache_size := 2*cache_size + 10
+ cache_size := cache_use + ExpandCacheThreshold
cache := new(cache_size, x)$(PrimitiveArray S)
for k in 0..(cache_use - 1) repeat
cache(k) := ocache(k)
@@ -67,7 +88,6 @@ SortedCache(S : CachableSet) : Exports == Implementation where
insertBefore(l, x) ==
k : Integer
- expandCache(x)
vscan := cache
for k in 0..(cache_use - l - 1) repeat
vscan(cache_use - k) := vscan(cache_use - k - 1)
@@ -95,7 +115,6 @@ SortedCache(S : CachableSet) : Exports == Implementation where
void
insertAtEnd(x : S) : Void ==
- expandCache(x)
cache(cache_use) := x
cache_use := cache_use + 1
void
@@ -116,6 +135,7 @@ SortedCache(S : CachableSet) : Exports == Implementation where
enterInCache(x : S, equal? : S -> Boolean) ==
(res := linearSearch(equal?)) case S => res
+ expandCache(x)
setPosition(x, 1 + cache_use)
insertAtEnd(x)
x
@@ -166,6 +186,7 @@ SortedCache(S : CachableSet) : Exports == Implementation where
"failed"
enterInCache(x : S, triage : (S, S) -> Integer) ==
+ expandCache(x)
zero?(cache_use) =>
setPosition(x, DIFF)
insertAtEnd(x)
diff --git a/src/lisp/primitives.lisp b/src/lisp/primitives.lisp
index 65783b28..193a65c9 100644
--- a/src/lisp/primitives.lisp
+++ b/src/lisp/primitives.lisp
@@ -892,3 +892,40 @@
`(let ((|$BreakMode| '|trapSpadErrors|))
(declare (special |$BreakMode|))
(CATCH '|trapSpadErrors| ,form)))
+
+(defun fullgc ()
+ #+:cmu
+ (ext:gc :full t)
+ #+:sbcl
+ (sb-ext:gc :full t)
+ #-(or :cmu :sbcl)
+ (reclaim))
+
+(defun HAVE_WEAK_POINTERP ()
+ #+(or :clisp :cmu :ecl :sbcl) t
+ #-(or :clisp :cmu :ecl :sbcl) nil)
+
+(defun make-weak-pointer (object)
+ #+(or :clisp :cmu :ecl)
+ (ext:make-weak-pointer object)
+ #+:sbcl
+ (sb-ext:make-weak-pointer object))
+
+(defun weak-pointer-value (weak-pointer)
+ #+(or :clisp :cmu :ecl)
+ (ext:weak-pointer-value weak-pointer)
+ #+:sbcl
+ (sb-ext:weak-pointer-value weak-pointer))
+
+(defun COMPACT_WEAK_ARRAY (newarray oldarray size default_element)
+ (dotimes (i size)
+ (setf (aref newarray i) (make-weak-pointer (aref oldarray i)))
+ (setf (aref oldarray i) nil))
+ (fullgc)
+ (do ((i 0 (1+ i)) (j 0))
+ ((= i size) j)
+ (multiple-value-bind (value valid)
+ (weak-pointer-value (aref newarray i))
+ (if valid (progn (setf (aref newarray j) value)
+ (setq j (1+ j))))
+ (if (> i j) (setf (aref newarray i) default_element)))))
