guile/guile-lightning test.scm

[Marius Vollmer]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Marius Vollmer <address@hidden> 01/03/20 15:47:43

Modified files:
        guile-lightning: test.scm 

Log message:
        Fibonaccies, this time.

CVSWeb URLs:
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-lightning/test.scm.diff?r1=1.2&r2=1.3

Patches:
Index: guile/guile-lightning/test.scm
diff -u guile/guile-lightning/test.scm:1.2 guile/guile-lightning/test.scm:1.3
--- guile/guile-lightning/test.scm:1.2  Mon Mar 19 18:01:25 2001
+++ guile/guile-lightning/test.scm      Tue Mar 20 15:47:43 2001
@@ -1,63 +1,76 @@
 (load "lightning.scm")
 (use-modules (lightning))
 
-(define (fak n)
-  (do ((n n (1- n))
-       (r 1 (* r 2)))
-      ((zero? n) r)))
+(define (fib n)
+  (if (< n 2)
+      1
+      (+ (fib (- n 1)) (fib (- n 2)))))
+
+(define asm-fib (assemble `(fib
+                             (prolog 1)
+                             (arg n)
+                             (getarg v0 n)
+                             (prepare 2)
+                             (mov r0 (scm 2))
+                             (pusharg r0)
+                             (pusharg v0)
+                             (finish (subr "less_p"))
+                             (retval r0)
+                             (beq l0 r0 (scm #f))
+                             (mov ret (scm 1))
+                             (ret)
+                           l0
+                             (prepare 2)
+                             (mov r0 (scm 2))
+                             (pusharg r0)
+                             (pusharg v0)
+                             (finish (subr "difference"))
+                             (retval r0)
+                             (prepare 1)
+                             (pusharg r0)
+                             (finish (label fib))
+                             (retval v2)
+                             (prepare 2)
+                             (mov r0 (scm 1))
+                             (pusharg r0)
+                             (pusharg v0)
+                             (finish (subr "difference"))
+                             (retval r0)
+                             (prepare 1)
+                             (pusharg r0)
+                             (finish (label fib))
+                             (retval v1)
+                             (prepare 2)
+                             (pusharg v2)
+                             (pusharg v1)
+                             (finish (subr "sum"))
+                             (retval ret)
+                             (ret))))
+
+(define asm-fixfib (assemble `(fib
+                                (prolog 1)
+                                (arg n)
+                                (getarg v0 n)
+                                (bge l0 v0 (scm 2))
+                                (mov ret (scm 1))
+                                (ret)
+                              l0
+                                (sub r0 v0 (scm 2))
+                                (add r0 r0 (scm 0))
+                                (prepare 1)
+                                (pusharg r0)
+                                (finish (label fib))
+                                (retval v2)
+                                (sub r0 v0 (scm 1))
+                                (add r0 r0 (scm 0))
+                                (prepare 1)
+                                (pusharg r0)
+                                (finish (label fib))
+                                (retval v1)
+                                (sub ret v2 (scm 0))
+                                (add ret ret v1)
+                                (ret))))
 
-(define (fak1 n)
-  (define (fak-aux n r)
-    (if (zero? n) r (fak-aux (1- n) (* r 1))))
-  (fak-aux n 1))
+;(disassemble asm-fib)
 
-(define asmfak (assemble
-               '(  (prolog 1)
-                   (arg n)
-                   (getarg v2 n)
-                   (mov v1 (scm 1))
-                 loop
-;                  (beq return v2 (scm 0))
-                   (prepare 1)
-                   (pusharg v2)
-                   (finish (subr "zero_p"))
-                   (retval v0)
-                   (bne return v0 (scm #f))
-                   (prepare 2)
-                   (pusharg v1)
-                   (pusharg v2)
-                   (finish (subr "product"))
-                   (retval v1)
-                   (prepare 2)
-                   (mov v0 (scm 1))
-                   (pusharg v0)
-                   (pusharg v2)
-                   (finish (subr "difference"))
-                   (retval v2)
-                   (b loop)
-                 return
-                   (mov ret v1)
-                   (ret))))
-
-(define fixfak (assemble
-               '(  (prolog 1)
-                   (arg n)
-                   (getarg v2 n)
-                   (mov v1 (scm 1))
-                 loop
-                   (beq return v2 (scm 0))
-                   (rsh r0 v1 2)
-                   (sub r1 v2 (scm 0))
-                   (mul r0 r0 r1)
-                   (add v1 r0 (scm 0))
-                   (sub v2 v2 (scm 1))
-                   (add v2 v2 (scm 0))
-                   (b loop) ; hack
-                 return
-                   (mov ret v1)
-                   (ret))))
-
-(disassemble fixfak)
-
-(format #t "~A\n" (asmfak 50))
-
+(assert-repl-verbosity #t)