5.1.1 · 레지스터 기계를 기술하는 언어

컨트롤러 텍스트는 데이터 경로와 연산과 제어 이동을 이름 붙인다.

레이블을 조립하고 하나의 명시적인 레지스터 파일과 스택과 연산 표와 flag와 pc 위에서 assign, test, branch, goto, save, restore, perform, halt를 실행합니다.

생각해 볼 질문

서로 다른 기계의 컨트롤러를 한 시뮬레이터가 실행하게 하는 공통 규약은 무엇일까요?

컨트롤러 레이블과 실행 명령을 별도로 표현하기
상수·레지스터·레이블·연산 소스 평가하기
assign, test, branch, goto, save, restore, perform, halt 실행하기
레지스터와 스택과 flag와 pc와 연산 표와 명령 수를 명시하기
컨트롤러를 바꾸지 않고 실행 단계에 한도 두기

조립 단계는 명령 리스트만 세고 각 레이블을 다음 명령의 위치에 연결합니다. 기계는 레이블을 뺀 명령열과 레이블 표, 가변 레지스터 셀, 스택, 연산 표, pc, flag, halt 상태, 가져온 명령 수를 모두 데이터로 저장합니다.

evaluate-source는 const와 reg와 label과 op에 하나씩 의미를 줍니다. execute-one!은 조립된 명령 하나를 가져와 태그에 맞는 규칙을 적용합니다. 유클리드 컨트롤러는 대입과 검사와 분기와 레이블 이동과 perform을 사용하고, 서브루틴 컨트롤러는 continuation을 저장·복원한 뒤 레지스터에 든 주소로 돌아갑니다. 수업용 레지스터 기계 시뮬레이터는 지정된 명령어 집합을 명시적인 기계 상태 위에서 실행합니다.

SICP 코드UTF-8 6,716 / 1,048,576바이트

(begin
  (define (tagged-list? value tag)
    (and (pair? value) (eq? (car value) tag)))

  (define (extract-labels controller position)
    (cond ((null? controller) '())
          ((symbol? (car controller))
           (cons (cons (car controller) position)
                 (extract-labels (cdr controller) position)))
          (else
           (extract-labels (cdr controller) (+ position 1)))))
  (define (extract-instructions controller)
    (cond ((null? controller) '())
          ((symbol? (car controller))
           (extract-instructions (cdr controller)))
          (else
           (cons (car controller)
                 (extract-instructions (cdr controller))))))

  (define (make-registers names)
    (map (lambda (name) (cons name '*unassigned*)) names))
  (define (make-machine register-names operations controller)
    (list '*machine*
          (make-registers register-names)
          (cons '*stack* '())
          operations
          (extract-instructions controller)
          (extract-labels controller 0)
          (cons 'pc 0)
          (cons 'flag #f)
          (cons 'halted #f)
          (cons 'steps 0)))

  (define (machine-registers machine) (list-ref machine 1))
  (define (machine-stack machine) (list-ref machine 2))
  (define (machine-operations machine) (list-ref machine 3))
  (define (machine-instructions machine) (list-ref machine 4))
  (define (machine-labels machine) (list-ref machine 5))
  (define (machine-pc-cell machine) (list-ref machine 6))
  (define (machine-flag-cell machine) (list-ref machine 7))
  (define (machine-halted-cell machine) (list-ref machine 8))
  (define (machine-steps-cell machine) (list-ref machine 9))

  (define (machine-pc machine) (cdr (machine-pc-cell machine)))
  (define (set-machine-pc! machine value)
    (set-cdr! (machine-pc-cell machine) value))
  (define (machine-flag machine) (cdr (machine-flag-cell machine)))
  (define (set-machine-flag! machine value)
    (set-cdr! (machine-flag-cell machine) value))
  (define (machine-halted? machine) (cdr (machine-halted-cell machine)))
  (define (halt-machine! machine)
    (set-cdr! (machine-halted-cell machine) #t))
  (define (machine-steps machine) (cdr (machine-steps-cell machine)))
  (define (increment-machine-steps! machine)
    (set-cdr! (machine-steps-cell machine)
              (+ (machine-steps machine) 1)))

  (define (register-cell machine name)
    (let ((cell (assoc name (machine-registers machine))))
      (if cell cell (error "unknown register" name))))
  (define (get-register machine name)
    (cdr (register-cell machine name)))
  (define (set-register! machine name value)
    (set-cdr! (register-cell machine name) value))

  (define (push! machine value)
    (set-cdr! (machine-stack machine)
              (cons value (cdr (machine-stack machine)))))
  (define (pop! machine)
    (let ((values (cdr (machine-stack machine))))
      (if (null? values)
          (error "empty machine stack")
          (let ((value (car values)))
            (set-cdr! (machine-stack machine) (cdr values))
            value))))
  (define (stack-empty? machine)
    (null? (cdr (machine-stack machine))))

  (define (operation machine name)
    (let ((binding (assoc name (machine-operations machine))))
      (if binding (cdr binding) (error "unknown operation" name))))
  (define (label-position machine name)
    (let ((binding (assoc name (machine-labels machine))))
      (if binding (cdr binding) (error "unknown label" name))))

  (define (evaluate-source machine source)
    (cond ((tagged-list? source 'const) (cadr source))
          ((tagged-list? source 'reg)
           (get-register machine (cadr source)))
          ((tagged-list? source 'label)
           (label-position machine (cadr source)))
          ((tagged-list? source 'op)
           (apply (operation machine (cadr source))
                  (map (lambda (operand)
                         (evaluate-source machine operand))
                       (cddr source))))
          (else
           (error "unknown machine source" source))))

  (define (advance! machine)
    (set-machine-pc! machine (+ (machine-pc machine) 1)))
  (define (execute-one! machine)
    (let* ((instruction
             (list-ref (machine-instructions machine)
                       (machine-pc machine)))
           (tag (car instruction)))
      (increment-machine-steps! machine)
      (cond
        ((eq? tag 'assign)
         (set-register! machine
                        (cadr instruction)
                        (evaluate-source machine (caddr instruction)))
         (advance! machine))
        ((eq? tag 'test)
         (set-machine-flag! machine
                            (evaluate-source machine (cadr instruction)))
         (advance! machine))
        ((eq? tag 'branch)
         (if (machine-flag machine)
             (set-machine-pc!
               machine
               (label-position machine (cadr instruction)))
             (advance! machine)))
        ((eq? tag 'goto)
         (set-machine-pc! machine
                          (evaluate-source machine (cadr instruction))))
        ((eq? tag 'save)
         (push! machine (get-register machine (cadr instruction)))
         (advance! machine))
        ((eq? tag 'restore)
         (set-register! machine (cadr instruction) (pop! machine))
         (advance! machine))
        ((eq? tag 'perform)
         (evaluate-source machine (cadr instruction))
         (advance! machine))
        ((eq? tag 'halt)
         (halt-machine! machine))
        (else
         (error "unknown machine instruction" instruction)))))

  (define (run-machine! machine step-limit)
    (cond ((machine-halted? machine) 'complete)
          ((= step-limit 0) 'step-limit)
          (else
           (execute-one! machine)
           (run-machine! machine (- step-limit 1)))))
  (define observations '())
  (define operations
    (list
      (cons '= =)
      (cons 'remainder remainder)
      (cons 'record
            (lambda (a b)
              (set! observations
                    (append observations (list (list a b))))
              'ok))))
  (define controller
    '(start
       (assign a (const 206))
       (assign b (const 40))
      loop
       (test (op = (reg b) (const 0)))
       (branch done)
       (assign t (op remainder (reg a) (reg b)))
       (assign a (reg b))
       (assign b (reg t))
       (perform (op record (reg a) (reg b)))
       (goto (label loop))
      done
       (halt)))
  (define machine
    (make-machine '(a b t) operations controller))
  (define status (run-machine! machine 100))
  (list status
        (get-register machine 'a)
        (get-register machine 'b)
        (machine-steps machine)
        observations)
)

(begin
  (define (tagged-list? value tag)
    (and (pair? value) (eq? (car value) tag)))

(define (extract-labels controller position)
    (cond ((null? controller) '())
          ((symbol? (car controller))
           (cons (cons (car controller) position)
                 (extract-labels (cdr controller) position)))
          (else
           (extract-labels (cdr controller) (+ position 1)))))
  (define (extract-instructions controller)
    (cond ((null? controller) '())
          ((symbol? (car controller))
           (extract-instructions (cdr controller)))
          (else
           (cons (car controller)
                 (extract-instructions (cdr controller))))))

(define (make-registers names)
    (map (lambda (name) (cons name '*unassigned*)) names))
  (define (make-machine register-names operations controller)
    (list '*machine*
          (make-registers register-names)
          (cons '*stack* '())
          operations
          (extract-instructions controller)
          (extract-labels controller 0)
          (cons 'pc 0)
          (cons 'flag #f)
          (cons 'halted #f)
          (cons 'steps 0)))

(define (machine-registers machine) (list-ref machine 1))
  (define (machine-stack machine) (list-ref machine 2))
  (define (machine-operations machine) (list-ref machine 3))
  (define (machine-instructions machine) (list-ref machine 4))
  (define (machine-labels machine) (list-ref machine 5))
  (define (machine-pc-cell machine) (list-ref machine 6))
  (define (machine-flag-cell machine) (list-ref machine 7))
  (define (machine-halted-cell machine) (list-ref machine 8))
  (define (machine-steps-cell machine) (list-ref machine 9))

(define (machine-pc machine) (cdr (machine-pc-cell machine)))
  (define (set-machine-pc! machine value)
    (set-cdr! (machine-pc-cell machine) value))
  (define (machine-flag machine) (cdr (machine-flag-cell machine)))
  (define (set-machine-flag! machine value)
    (set-cdr! (machine-flag-cell machine) value))
  (define (machine-halted? machine) (cdr (machine-halted-cell machine)))
  (define (halt-machine! machine)
    (set-cdr! (machine-halted-cell machine) #t))
  (define (machine-steps machine) (cdr (machine-steps-cell machine)))
  (define (increment-machine-steps! machine)
    (set-cdr! (machine-steps-cell machine)
              (+ (machine-steps machine) 1)))

(define (register-cell machine name)
    (let ((cell (assoc name (machine-registers machine))))
      (if cell cell (error "unknown register" name))))
  (define (get-register machine name)
    (cdr (register-cell machine name)))
  (define (set-register! machine name value)
    (set-cdr! (register-cell machine name) value))

(define (push! machine value)
    (set-cdr! (machine-stack machine)
              (cons value (cdr (machine-stack machine)))))
  (define (pop! machine)
    (let ((values (cdr (machine-stack machine))))
      (if (null? values)
          (error "empty machine stack")
          (let ((value (car values)))
            (set-cdr! (machine-stack machine) (cdr values))
            value))))
  (define (stack-empty? machine)
    (null? (cdr (machine-stack machine))))

(define (operation machine name)
    (let ((binding (assoc name (machine-operations machine))))
      (if binding (cdr binding) (error "unknown operation" name))))
  (define (label-position machine name)
    (let ((binding (assoc name (machine-labels machine))))
      (if binding (cdr binding) (error "unknown label" name))))

(define (evaluate-source machine source)
    (cond ((tagged-list? source 'const) (cadr source))
          ((tagged-list? source 'reg)
           (get-register machine (cadr source)))
          ((tagged-list? source 'label)
           (label-position machine (cadr source)))
          ((tagged-list? source 'op)
           (apply (operation machine (cadr source))
                  (map (lambda (operand)
                         (evaluate-source machine operand))
                       (cddr source))))
          (else
           (error "unknown machine source" source))))

(define (advance! machine)
    (set-machine-pc! machine (+ (machine-pc machine) 1)))
  (define (execute-one! machine)
    (let* ((instruction
             (list-ref (machine-instructions machine)
                       (machine-pc machine)))
           (tag (car instruction)))
      (increment-machine-steps! machine)
      (cond
        ((eq? tag 'assign)
         (set-register! machine
                        (cadr instruction)
                        (evaluate-source machine (caddr instruction)))
         (advance! machine))
        ((eq? tag 'test)
         (set-machine-flag! machine
                            (evaluate-source machine (cadr instruction)))
         (advance! machine))
        ((eq? tag 'branch)
         (if (machine-flag machine)
             (set-machine-pc!
               machine
               (label-position machine (cadr instruction)))
             (advance! machine)))
        ((eq? tag 'goto)
         (set-machine-pc! machine
                          (evaluate-source machine (cadr instruction))))
        ((eq? tag 'save)
         (push! machine (get-register machine (cadr instruction)))
         (advance! machine))
        ((eq? tag 'restore)
         (set-register! machine (cadr instruction) (pop! machine))
         (advance! machine))
        ((eq? tag 'perform)
         (evaluate-source machine (cadr instruction))
         (advance! machine))
        ((eq? tag 'halt)
         (halt-machine! machine))
        (else
         (error "unknown machine instruction" instruction)))))

(define (run-machine! machine step-limit)
    (cond ((machine-halted? machine) 'complete)
          ((= step-limit 0) 'step-limit)
          (else
           (execute-one! machine)
           (run-machine! machine (- step-limit 1)))))
  (define observations '())
  (define operations
    (list
      (cons '= =)
      (cons 'remainder remainder)
      (cons 'record
            (lambda (a b)
              (set! observations
                    (append observations (list (list a b))))
              'ok))))
  (define controller
    '(start
       (assign a (const 206))
       (assign b (const 40))
      loop
       (test (op = (reg b) (const 0)))
       (branch done)
       (assign t (op remainder (reg a) (reg b)))
       (assign a (reg b))
       (assign b (reg t))
       (perform (op record (reg a) (reg b)))
       (goto (label loop))
      done
       (halt)))
  (define machine
    (make-machine '(a b t) operations controller))
  (define status (run-machine! machine 100))
  (list status
        (get-register machine 'a)
        (get-register machine 'b)
        (machine-steps machine)
        observations)
)

예제

결과—

출력: —
값: —
진단: —

실행 추적0 / 0 개 이벤트

예상 결과

유클리드 기계는 (complete 2 0 33 ((40 6) (6 4) (4 2) (2 0)))을 반환합니다. continuation 기계는 (complete 10 #t 10)을 반환합니다.

실행 추적에서 볼 점

실행 전에 레이블이 수치 위치가 되는 과정을 따라가세요. 유클리드 실행에서는 test와 branch를 일곱 명령짜리 축소 주기와 구분하고, 서브루틴 실행에서는 바깥 continuation 저장, 임시 복귀 주소, restore, 두 번의 레지스터 goto를 찾으세요.

직접 해보기

프로그램을 수정하고 결과를 비교해 보세요.

매 fetch 직전에 pc를 기록하는 계측을 추가하고 1071과 462로 유클리드 컨트롤러를 실행하세요. 반복되는 loop 구간과 마지막 레지스터 값을 먼저 예상하세요.

힌트 보기

계측은 각 컨트롤러 명령에 넣지 않고 시뮬레이터 루프에 둘 수 있습니다. 컨트롤러 자체는 바꾸지 않아도 됩니다.

이 수업 완료하기

이 장의 총 23개 수업 중 0개 완료0%