Serendip

Web Studio

問題5.19

ブレークポイントを label と label からの距離（整数）のペアのリスト(breakpoints)とする。
label からの距離を count-from-label に保持し、次の label に移動する毎にカウンタをリセットする。
現在の label と label からの距離(count-from-label)のペアがブレークポイントのリスト breakpoints に存在する場合は execute を実行せずに一時停止する。
proceed-machine で実行を再開するにはそのまま execute を実行する。

(define (make-new-machine)
  (let ((pc (make-register 'pc))
        ;; 省略
        (breakpoints '())
        (count-from-label 0)
        ;; 省略
            (define (execute)
              ;; 省略
                         (if (not (eq? (caaar insts) 'label)) ;; ex5.17
                             (begin
                               (set! count-from-label (+ 1 count-from-label)) ;; ex5.19
                               (set! instruction-count (+ 1 instruction-count))) ;; ex5.15
                             (begin
                               (set! count-from-label 0) ;; ex5.19
                               (set! label (cadr (caar insts)))))
                         (if instruction-trace-flag
                             (print "label: " label ", instruction: " (caar insts) ", count-from-label: " count-from-label ", breakpoints: " breakpoints))
                         (if (member (cons label count-from-label) breakpoints) ;; ex5.19
                             (print "***** BREAK! *****")
                             (execute))))))
              ;; 省略
            (define (set-bpoint label n)
              (if (not (memq (cons label n) (map car breakpoints)))
                  (set! breakpoints (cons (cons label n) breakpoints))))
            (define (del-bpoint label n)
              (if (member (cons label n) breakpoints)
                  (set! breakpoints (delete (cons label n) breakpoints))
                  (error "DEL BREAKPOINT")))
            (define (del-all-bpoint)
              (set! breakpoints '()))
            (define (dispatch message)
              ;; 省略
                    ((eq? message 'set-bpoint) set-bpoint)
                    ((eq? message 'del-bpoint) del-bpoint)
                    ((eq? message 'del-all-bpoint) del-all-bpoint)
                    ((eq? message 'proceed) execute)
                    (else (error "Unknown request -- MACHINE" message))))
            dispatch)))

;; ブレークポイントの設定
(define (set-breakpoint machine label n)
  ((machine 'set-bpoint) label n)
  'set-breakpoint-done)

;; 指定ブレークポイントの削除
(define (cancel-breakpoint machine label n)
  ((machine 'del-bpoint) label n)
  'delete-breakpoint-done)

;; 全ブレークポイントの削除
(define (cancel-all-breakpoint machine)
  ((machine 'del-all-bpoint))
  'delete-all-breakpoint-done)

;; 命令の続行
(define (proceed-machine machine)
  ((machine 'proceed)))

p307 の gcd-machine を使ってテストする。

(define gcd-machine
  (make-machine
    '(a b t)
    (list (list 'rem remainder) (list '= =))
    '(test-b
       (test (op =) (reg b) (const 0))
       (branch (label gcd-done))
       (assign t (op rem) (reg a) (reg b))
       (assign a (reg b))
       (assign b (reg t))
       (goto (label test-b))
    gcd-done)))

(gcd-machine 'trace-on)
(set-breakpoint gcd-machine 'test-b 4)
(set-breakpoint gcd-machine 'test-b 6)
(set-register-contents! gcd-machine 'a 206)
(set-register-contents! gcd-machine 'b 40)
(start gcd-machine)
(get-register-contents gcd-machine 'a)
(proceed-machine gcd-machine)
(get-register-contents gcd-machine 'a)
(proceed-machine gcd-machine)
(get-register-contents gcd-machine 'a)
(cancel-breakpoint gcd-machine 'test-b 6)
(proceed-machine gcd-machine)
(get-register-contents gcd-machine 'a)
(cancel-all-breakpoint gcd-machine)
(proceed-machine gcd-machine)
(get-register-contents gcd-machine 'a)

実行結果

gosh> gcd-machine
gosh> #t
gosh> set-breakpoint-done
gosh> set-breakpoint-done
gosh> done
gosh> done
gosh> label: test-b, instruction: (label test-b), count-from-label: 0, breakpoints: ((test-b . 6) (test-b . 4))
label: test-b, instruction: (test (op =) (reg b) (const 0)), count-from-label: 1, breakpoints: ((test-b . 6) (test-b . 4))
label: test-b, instruction: (branch (label gcd-done)), count-from-label: 2, breakpoints: ((test-b . 6) (test-b . 4))
label: test-b, instruction: (assign t (op rem) (reg a) (reg b)), count-from-label: 3, breakpoints: ((test-b . 6) (test-b . 4))
label: test-b, instruction: (assign a (reg b)), count-from-label: 4, breakpoints: ((test-b . 6) (test-b . 4))
***** BREAK! *****
#<undef>
gosh> 40
gosh> label: test-b, instruction: (assign b (reg t)), count-from-label: 5, breakpoints: ((test-b . 6) (test-b . 4))
label: test-b, instruction: (goto (label test-b)), count-from-label: 6, breakpoints: ((test-b . 6) (test-b . 4))
***** BREAK! *****
#<undef>
gosh> 40
gosh> label: test-b, instruction: (label test-b), count-from-label: 0, breakpoints: ((test-b . 6) (test-b . 4))
label: test-b, instruction: (test (op =) (reg b) (const 0)), count-from-label: 1, breakpoints: ((test-b . 6) (test-b . 4))
label: test-b, instruction: (branch (label gcd-done)), count-from-label: 2, breakpoints: ((test-b . 6) (test-b . 4))
label: test-b, instruction: (assign t (op rem) (reg a) (reg b)), count-from-label: 3, breakpoints: ((test-b . 6) (test-b . 4))
label: test-b, instruction: (assign a (reg b)), count-from-label: 4, breakpoints: ((test-b . 6) (test-b . 4))
***** BREAK! *****
#<undef>
gosh> 6
gosh> delete-breakpoint-done
gosh> label: test-b, instruction: (assign b (reg t)), count-from-label: 5, breakpoints: ((test-b . 4))
label: test-b, instruction: (goto (label test-b)), count-from-label: 6, breakpoints: ((test-b . 4))
label: test-b, instruction: (label test-b), count-from-label: 0, breakpoints: ((test-b . 4))
label: test-b, instruction: (test (op =) (reg b) (const 0)), count-from-label: 1, breakpoints: ((test-b . 4))
label: test-b, instruction: (branch (label gcd-done)), count-from-label: 2, breakpoints: ((test-b . 4))
label: test-b, instruction: (assign t (op rem) (reg a) (reg b)), count-from-label: 3, breakpoints: ((test-b . 4))
label: test-b, instruction: (assign a (reg b)), count-from-label: 4, breakpoints: ((test-b . 4))
***** BREAK! *****
#<undef>
gosh> 4
gosh> delete-all-breakpoint-done
gosh> label: test-b, instruction: (assign b (reg t)), count-from-label: 5, breakpoints: ()
label: test-b, instruction: (goto (label test-b)), count-from-label: 6, breakpoints: ()
label: test-b, instruction: (label test-b), count-from-label: 0, breakpoints: ()
label: test-b, instruction: (test (op =) (reg b) (const 0)), count-from-label: 1, breakpoints: ()
label: test-b, instruction: (branch (label gcd-done)), count-from-label: 2, breakpoints: ()
label: test-b, instruction: (assign t (op rem) (reg a) (reg b)), count-from-label: 3, breakpoints: ()
label: test-b, instruction: (assign a (reg b)), count-from-label: 4, breakpoints: ()
label: test-b, instruction: (assign b (reg t)), count-from-label: 5, breakpoints: ()
label: test-b, instruction: (goto (label test-b)), count-from-label: 6, breakpoints: ()
label: test-b, instruction: (label test-b), count-from-label: 0, breakpoints: ()
label: test-b, instruction: (test (op =) (reg b) (const 0)), count-from-label: 1, breakpoints: ()
label: test-b, instruction: (branch (label gcd-done)), count-from-label: 2, breakpoints: ()
label: gcd-done, instruction: (label gcd-done), count-from-label: 0, breakpoints: ()
done
gosh> 2

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る