101 lines
3.0 KiB
Scheme
101 lines
3.0 KiB
Scheme
(load "shared/util.scm")
|
|
(load "shared/sicp-regsim.scm")
|
|
|
|
(display "\nex-5.14 - factorial-stack-evaluation\n")
|
|
|
|
(define factorial-machine (make-machine
|
|
'(n val continue)
|
|
(list (list '= =) (list '- -) (list '* *))
|
|
'(controller
|
|
(assign continue (label fact-done)) ; set up final return address
|
|
fact-loop
|
|
(test (op =) (reg n) (const 1))
|
|
(branch (label base-case))
|
|
;; Set up for the recursive call by saving n and continue.
|
|
;; Set up continue so that the computation will continue
|
|
;; at after-fact when the subroutine returns.
|
|
(save continue)
|
|
(save n)
|
|
(assign n (op -) (reg n) (const 1))
|
|
(assign continue (label after-fact))
|
|
(goto (label fact-loop))
|
|
after-fact
|
|
(restore n)
|
|
(restore continue)
|
|
(assign val (op *) (reg n) (reg val)) ; val now contains n(n - 1)!
|
|
(goto (reg continue)) ; return to caller
|
|
base-case
|
|
(assign val (const 1)) ; base case: 1! = 1
|
|
(goto (reg continue)) ; return to caller
|
|
fact-done)))
|
|
|
|
(define (run-machine-for n)
|
|
(display "factorial ") (display n)
|
|
((factorial-machine 'stack) 'initialize)
|
|
(set-register-contents! factorial-machine 'n n)
|
|
(start factorial-machine)
|
|
((factorial-machine 'stack) 'print-statistics)
|
|
(newline))
|
|
|
|
(map run-machine-for '(10))
|
|
|
|
; For each recursion there are two pushes and there are (n - 1) recursions.
|
|
; total-pushes(n) = (n - 1) * 2
|
|
; max-depth: (n - 1) * 2
|
|
|
|
(display "\nex-5.15 - instruction-count\n")
|
|
|
|
(set-register-contents! factorial-machine 'n 1)
|
|
(factorial-machine 'reset-instruction-acount)
|
|
(start factorial-machine)
|
|
(assert (factorial-machine 'instruction-count) 5)
|
|
|
|
(display "\nex-5.16 - instruction-tracing\n")
|
|
|
|
(display "[ok]\n")
|
|
|
|
(display "\nex-5.17 - instruction-tracing-labels\n")
|
|
|
|
(factorial-machine 'trace-on)
|
|
(start factorial-machine)
|
|
(factorial-machine 'trace-off)
|
|
(start factorial-machine)
|
|
|
|
(display "\nex-5.18 - register-tracing\n")
|
|
|
|
((factorial-machine 'trace-on-reg) 'val)
|
|
(set-register-contents! factorial-machine 'n 5)
|
|
(start factorial-machine)
|
|
(assert (get-register-contents factorial-machine 'val) 120)
|
|
|
|
((factorial-machine 'trace-off-reg) 'val)
|
|
(set-register-contents! factorial-machine 'n 5)
|
|
(start factorial-machine)
|
|
|
|
(display "\nex-5.19 - breakpoint\n")
|
|
|
|
(define (set-breakpoint machine label n)
|
|
((machine 'set-breakpoint) label n))
|
|
|
|
(define (cancel-breakpoint machine label n)
|
|
((machine 'cancel-breakpoint) label n))
|
|
|
|
(define (proceed machine)
|
|
(machine 'proceed))
|
|
|
|
(set-register-contents! factorial-machine 'n 6)
|
|
(set-register-contents! factorial-machine 'val 0)
|
|
|
|
(set-breakpoint factorial-machine 'fact-loop 1)
|
|
(start factorial-machine)
|
|
|
|
(assert (get-register-contents factorial-machine 'n) 6)
|
|
(proceed factorial-machine)
|
|
(assert (get-register-contents factorial-machine 'n) 5)
|
|
(proceed factorial-machine)
|
|
(cancel-breakpoint factorial-machine 'fact-loop 1)
|
|
(assert (get-register-contents factorial-machine 'n) 4)
|
|
(proceed factorial-machine)
|
|
(assert (get-register-contents factorial-machine 'val) 720)
|
|
|