felixm
/
SICP
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Implement till 5.18

main
Felix Martin 2021-03-30 19:49:09 -04:00
parent e22a52b7f3
commit bb870cbdf1
3 changed files with 69 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
ex-5_14-xx.scm → ex-5_14-19.scm
View File

@ -34,7 +34,6 @@
((factorial-machine 'stack) 'initialize)
(set-register-contents! factorial-machine 'n n)
(start factorial-machine)
; (assert (get-register-contents factorial-machine 'val) 720)
((factorial-machine 'stack) 'print-statistics)
(newline))
@ -44,6 +43,35 @@
; total-pushes(n) = (n - 1) * 2
; max-depth: (n - 1) * 2
(display "\nex-5.15 - instruction-counting\n")
(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")
(display "\nex-5.16\n")

4
ex-5_20-xx.scm Normal file
View File

@ -0,0 +1,4 @@
(load "util.scm")
(load "misc/sicp-regsim.scm")
(display "\nex-5.20\n")

38
misc/sicp-regsim.scm
View File

@ -24,12 +24,21 @@
machine))
(define (make-register name)
(let ((contents '*unassigned*))
(let ((contents '*unassigned*)
(trace #f))
(define (set value)
(if trace
(begin
(display "set! ") (display name)
(display " from ") (display contents)
(display " to ") (display value) (newline)))
(set! contents value))
(define (dispatch message)
(cond ((eq? message 'get) contents)
((eq? message 'set)
(lambda (value) (set! contents value)))
((eq? message 'set) set)
((eq? message 'name?) name)
((eq? message 'trace-on) (set! trace #t))
((eq? message 'trace-off) (set! trace #f))
(else
(error "Unknown request -- REGISTER" message))))
dispatch))
@ -110,6 +119,8 @@
(let ((pc (make-register 'pc))
(flag (make-register 'flag))
(stack (make-stack))
(instruction-count 0)
(instruction-trace #f)
(the-instruction-sequence '()))
(let ((the-ops
(list (list 'initialize-stack
@ -138,6 +149,12 @@
'done
(begin
((instruction-execution-proc (car insts)))
(if instruction-trace
(begin
(display (instruction-text (car insts)))
(newline)))
(if (not (eq? 'label (car (instruction-text (car insts)))))
(set! instruction-count (+ instruction-count 1)))
(execute)))))
(define (dispatch message)
(cond ((eq? message 'start)
@ -145,6 +162,15 @@
(execute))
((eq? message 'install-instruction-sequence)
(lambda (seq) (set! the-instruction-sequence seq)))
((eq? message 'instruction-count) instruction-count)
((eq? message 'reset-instruction-acount)
(set! instruction-count 0) 'ok)
((eq? message 'trace-on) (set! instruction-trace #t) 'ok)
((eq? message 'trace-off) (set! instruction-trace #f) 'ok)
((eq? message 'trace-on-reg)
(lambda (reg-name) ((lookup-register reg-name) 'trace-on)))
((eq? message 'trace-off-reg)
(lambda (reg-name) ((lookup-register reg-name) 'trace-off)))
((eq? message 'allocate-register) allocate-register)
((eq? message 'get-register) lookup-register)
((eq? message 'install-operations)
@ -181,7 +207,7 @@
(lambda (insts labels)
(let ((next-inst (car text)))
(if (symbol? next-inst)
(receive insts
(receive (cons (make-instruction (list 'label next-inst)) insts)
(cons (make-label-entry next-inst
insts)
labels))
@ -239,6 +265,8 @@
(make-save inst machine stack pc))
((eq? (car inst) 'restore)
(make-restore inst machine stack pc))
((eq? (car inst) 'label)
(make-label pc))
((eq? (car inst) 'perform)
(make-perform inst machine labels ops pc))
((eq? (car inst) 'inc)
@ -246,6 +274,8 @@
(else (error "Unknown instruction type -- ASSEMBLE"
inst))))
(define (make-label pc)
(lambda () (advance-pc pc)))
(define (make-assign inst machine labels operations pc)
(let ((target