mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Fixed a stack leak. Now observing actual performance.

Browse source 
* src/*.[ch]:  Replaced `scm_mem2symbol' by `scm_from_locale_symboln' and
  `scm_ulong2num' by `scm_from_ulong'.
* src/vm_system.c (tail-call):  Fixed stack leak (SP lacked decrement by
  one more Scheme object in the tail-recursive case).
* benchmark/measure.scm (measure):  Make sure we are using the compiled
  procedure (i.e. a program object) when measuring.  This yields better
  results than before.  :-)
* doc/guile-vm.texi:  Augmented the instruction set documentation with
  branch instructions, `call' and `tail-call'.

git-archimport-id: lcourtes@laas.fr--2004-libre/guile-vm--revival--0.6--patch-7
This commit is contained in:
Ludovic Court`es 2005-05-02 16:32:32 +00:00 • committed by Ludovic Courtès
parent 2d80426a3e
commit f41cb00ce2
10 changed files with 149 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

22
benchmark/lib.scm
View file

@ -16,12 +16,12 @@
(g-c-d x (- y x))
(g-c-d (- x y) y))))
(define (loop how-long)
(define (loop n)
;; This one shows that procedure calls are no faster than within the
;; interpreter: the VM yields no performance improvement.
(if (= 0 how-long)
(if (= 0 n)
0
(loop (1- how-long))))
(loop (1- n))))
;; Disassembly of `loop'
;;
@ -35,7 +35,7 @@
; 11 (link "1-")
; 15 (vector 3)
; 17 (make-int8:0) ;; 0
; 18 (load-symbol "how-long") ;; how-long
; 18 (load-symbol "n") ;; n
; 28 (make-false) ;; #f
; 29 (make-int8:0) ;; 0
; 30 (list 3)
@ -92,25 +92,27 @@
; 23 (tail-call 1)
(define (loopi how-long)
(define (loopi n)
;; Same as `loop'.
(let loopi ((how-long how-long))
(if (= 0 how-long)
(let loopi ((n n))
(if (= 0 n)
0
(loopi (1- how-long)))))
(loopi (1- n)))))
(define (do-cons x)
;; This one shows that the built-in `cons' instruction yields a significant
;; improvement (speedup: 1.4).
;; improvement (speedup: 1.5).
(let loop ((x x)
(result '()))
(if (<= x 0)
result
(loop (1- x) (cons x result)))))
(define big-list (iota 500000))
(define (copy-list lst)
;; Speedup: 1.3.
;; Speedup: 5.9.
(let loop ((lst lst)
(result '()))
(if (null? lst)