From 284ccb26ad0896ba9d2939af92c84f9f2d864ea7 Mon Sep 17 00:00:00 2001
From: Felix Martin <mail@felixm.de>
Date: Sun, 28 Mar 2021 12:14:57 -0400
Subject: [PATCH] Implement 5.12

---
 ex-5_07-xx.scm => ex-5_07-13.scm | 100 ++++++++++++++++++++++++++++++-
 ex-5_14-xx.scm                   |   6 ++
 2 files changed, 104 insertions(+), 2 deletions(-)
 rename ex-5_07-xx.scm => ex-5_07-13.scm (68%)
 create mode 100644 ex-5_14-xx.scm

diff --git a/ex-5_07-xx.scm b/ex-5_07-13.scm
similarity index 68%
rename from ex-5_07-xx.scm
rename to ex-5_07-13.scm
index a733f1b..c18683c 100644
--- a/ex-5_07-xx.scm
+++ b/ex-5_07-13.scm
@@ -258,9 +258,105 @@
 (assert (get-register-contents stack-test-machine 'b) 5)
 (assert (get-register-contents stack-test-machine 'c) 6)
 
-(display "\nex-5.12\n")
+(display "\nex-5.12 - machine-analyzer\n")
 
+; I don't want to change the assembler. That's why I implement the analyzer
+; seperately.
 
-(display "\nex-5.13\n")
+(define (insert x xs)
+  (cond
+    ((null? xs) (list x))
+    ((eq? (car x) (car (car xs))) (cons x xs))
+    (else (cons (car xs) (insert x (cdr xs))))))
 
+(define (analyze-controller controller-text)
+  (let ((insts (filter pair? controller-text))
+        (unique-insts '())
+        (entry-regs '())
+        (stack-regs '())
+        (sources '()))
 
+    (define (add-unique-inst inst)
+      (if (not (member inst unique-insts))
+        (set! unique-insts (insert inst unique-insts))))
+
+    (define (add-entry-point inst)
+      (if (and (eq? (car inst) 'goto)
+               (register-exp? (goto-dest inst)))
+        (let ((reg-name (register-exp-reg (goto-dest inst))))
+          (if (not (member reg-name entry-regs))
+            (set! entry-regs (insert reg-name entry-regs))))))
+
+    (define (add-stack-reg inst)
+      (if (or (eq? (car inst) 'save) (eq? (car inst) 'restore))
+        (let ((reg-name (stack-inst-reg-name inst)))
+          (if (not (member reg-name stack-regs))
+            (set! stack-regs (cons reg-name stack-regs))))))
+
+    (define (add-source inst)
+      (if (eq? (car inst) 'assign)
+        (let ((source (list (assign-reg-name inst)
+                            (assign-value-exp inst))))
+          (if (not (member source sources))
+            (set! sources (insert source sources))))))
+
+    (map add-unique-inst insts)
+    (map add-entry-point insts)
+    (map add-stack-reg insts)
+    (map add-source insts)
+
+    ;; Code to display the analyzer-results
+    ; (define (display-bullet b)
+    ;   (display "- ") (display b) (newline))
+    ; (display "unique-insts:\n")
+    ; (map display-bullet unique-insts)
+    ; (newline)
+    ; (display "entry-regs:\n")
+    ; (map display-bullet entry-regs)
+    ; (newline)
+    ; (display "stack-regs:\n")
+    ; (map display-bullet stack-regs)
+    ; (newline)
+    ; (display "sources:\n")
+    ; (map display-bullet sources)
+    ; (newline)
+
+    (list unique-insts entry-regs stack-regs sources)))
+
+(analyze-controller
+  '((assign continue (label fib-done))
+    fib-loop
+      (test (op <) (reg n) (const 2))
+      (branch (label immediate-answer))
+      ;; set up to compute Fib(n - 1)
+      (save continue)
+      (assign continue (label afterfib-n-1))
+      (save n)                           ; save old value of n
+      (assign n (op -) (reg n) (const 1)); clobber n to n - 1
+      (goto (label fib-loop))            ; perform recursive call
+    afterfib-n-1                         ; upon return, val contains Fib(n - 1)
+      (restore n)
+      ;; set up to compute Fib(n - 2)
+      (assign n (op -) (reg n) (const 2))
+      (assign continue (label afterfib-n-2))
+      (save val)                         ; save Fib(n - 1)
+      (goto (label fib-loop))
+    afterfib-n-2                         ; upon return, val contains Fib(n - 2)
+      ; (assign n (reg val))             ; n now contains Fib(n - 2)
+      ; (restore val)                    ; val now contains Fib(n - 1)
+      (restore n)                        ; ex-5.11 - save one instruction
+      (assign val                        ;  Fib(n - 1) +  Fib(n - 2)
+              (op +) (reg val) (reg n))
+      (restore continue)
+      (goto (reg continue))              ; return to caller, answer is in val
+    immediate-answer
+      (assign val (reg n))               ; base case:  Fib(n) = n
+      (goto (reg continue))
+    fib-done))
+
+(display "[ok]\n")
+
+(display "\nex-5.13 - dynamic-registers\n")
+;; (load "misc/sicp-regsim.scm")
+
+(display "TBD!\n")
diff --git a/ex-5_14-xx.scm b/ex-5_14-xx.scm
new file mode 100644
index 0000000..aeb2cdb
--- /dev/null
+++ b/ex-5_14-xx.scm
@@ -0,0 +1,6 @@
+(load "util.scm")
+(load "misc/sicp-regsim.scm")
+
+(display "\nex-5.14\n")
+
+(display "\nex-5.15\n")