From 8a2ce473bed0652313961b6fda23a46017fba00f Mon Sep 17 00:00:00 2001
From: Felix Martin <mail@felixm.de>
Date: Tue, 23 Mar 2021 14:04:36 -0400
Subject: [PATCH] Implement till 5.10

---
 ex-5_07-xx.scm       | 88 ++++++++++++++++++++++++++++++++++++++++++--
 misc/sicp-regsim.scm |  3 +-
 2 files changed, 87 insertions(+), 4 deletions(-)

diff --git a/ex-5_07-xx.scm b/ex-5_07-xx.scm
index e7e8cee..cbac4f8 100644
--- a/ex-5_07-xx.scm
+++ b/ex-5_07-xx.scm
@@ -15,7 +15,7 @@
   (define (warn-if-label-exists label labels)
     (if (assoc label labels)
       (begin
-        (display "WARNING duplicated label -- ")
+        (display "Duplicated labels -- EXTRACT-LABELS ")
         (display label)
         (newline))))
   (if (null? text)
@@ -54,6 +54,88 @@
 ; The register contains 3 because the assembler jumps to the first label in the
 ; list.
 
-(display "\nex-5.9\n")
+(display "\nex-5.9 - strict-op\n")
+
+(display "[done]\n")
+
+(define (make-operation-exp exp machine labels operations)
+  (let ((op (lookup-prim (operation-exp-op exp) operations))
+        (aprocs
+         (map (lambda (e)
+                (if (or (register-exp? e) (constant-exp? e))
+                  (make-primitive-exp e machine labels)
+                  (error "Invalid operation argument -- MAKE-OPERATION-EXP" e)))
+              (operation-exp-operands exp))))
+    (lambda ()
+      (apply op (map (lambda (p) (p)) aprocs)))))
+
+; The following instruction creates an error when analyzing the arguments for
+; op. Previously it created the error during runtime.
+
+; (define invalid-op-arg-machine
+;   (make-machine
+;     '(a)
+;     (list (list '+ +))
+;     '((assign a (op +) (label here) (const 1))
+;       here)))
+
+(display "\nex-5.10 - inc\n")
+
+(define inc-reg-name cadr)
+
+(define (make-inc inst machine labels operations pc)
+  (let ((target (get-register machine (inc-reg-name inst))))
+    (lambda ()
+      (set-contents!
+        target
+        (+ (get-contents target) 1))
+      (advance-pc pc))))
+
+(define triple-inc-machine
+  (make-machine
+    '(a)
+    ()
+    '((inc a)
+      (inc a)
+      (inc a))))
+
+(set-register-contents! triple-inc-machine 'a 8)
+(start triple-inc-machine)
+(assert (get-register-contents triple-inc-machine 'a) 11)
+
+(display "\nex-5.11\n")
+
+;Exercise 5.11.  When we introduced save and restore in section 5.1.4, we
+;didn't specify what would happen if you tried to restore a register that was
+;not the last one saved, as in the sequence
+
+;(save y)
+;(save x)
+;(restore y)
+
+;There are several reasonable possibilities for the meaning of restore:
+
+;a.  (restore y) puts into y the last value saved on the stack, regardless of
+;what register that value came from. This is the way our simulator behaves.
+;Show how to take advantage of this behavior to eliminate one instruction from
+;the Fibonacci machine of section 5.1.4 (figure 5.12).
+
+;b.  (restore y) puts into y the last value saved on the stack, but only if
+;that value was saved from y; otherwise, it signals an error. Modify the
+;simulator to behave this way. You will have to change save to put the register
+;name on the stack along with the value.
+
+;c.  (restore y) puts into y the last value saved from y regardless of what
+;other registers were saved after y and not restored. Modify the simulator to
+;behave this way. You will have to associate a separate stack with each
+;register. You should make the initialize-stack operation initialize all the
+;register stacks.
+
+; Extend the message-passing interface to the machine to provide access to
+; this new information. To test your analyzer, define the Fibonacci machine
+; from figure 5.12 and examine the lists you constructed.
+
+(display "\nex-5.12\n")
+
+; (display "\nex-5.13\n")
 
-(display "\nex-5.10\n")
diff --git a/misc/sicp-regsim.scm b/misc/sicp-regsim.scm
index d174d19..525f67b 100644
--- a/misc/sicp-regsim.scm
+++ b/misc/sicp-regsim.scm
@@ -240,6 +240,8 @@
          (make-restore inst machine stack pc))
         ((eq? (car inst) 'perform)
          (make-perform inst machine labels ops pc))
+        ((eq? (car inst) 'inc)
+         (make-inc inst machine labels ops pc))
         (else (error "Unknown instruction type -- ASSEMBLE"
                      inst))))
 
@@ -281,7 +283,6 @@
 (define (test-condition test-instruction)
   (cdr test-instruction))
 
-
 (define (make-branch inst machine labels flag pc)
   (let ((dest (branch-dest inst)))
     (if (label-exp? dest)