5.5.5 · 컴파일 코드 예제

컴파일된 재귀 코드는 모든 호출과 복귀 이동을 명시한다.

entry와 base-case 레이블, 저장된 continuation과 인자, 공유 after-call 지점, continue를 통한 간접 복귀를 가진 완전한 factorial 컨트롤러를 살펴보고 실행합니다.

생각해 볼 질문

재귀 소스 프로시저의 암묵적인 호출 스택을 어떤 기계 상태가 대신할까요?

재귀 프로시저 하나의 전체 조립 명령 목록 읽기
entry·after-call·base-case·done 레이블 구분하기
재귀 호출 전에 caller continuation과 살아 있는 인자 저장하기
돌아온 값에 곱하기 전에 상태 복원하기
continue 레지스터를 통해 간접 복귀하기
entry 수·명령 수·최대 스택 깊이·마지막 스택 균형 재기

컴파일 목록은 factorial-entry에서 시작합니다. base가 아닌 호출은 continue와 n을 저장하고 n을 줄인 뒤 after-factorial을 새 복귀 주소로 설치하고 같은 entry로 다시 이동합니다. base case는 val에 1을 넣고 continue로 복귀하며 after-factorial은 caller 상태를 복원하고 n과 반환 val을 곱한 뒤 다시 복귀합니다.

계측 실행은 n = 5와 done을 가리키는 continue로 시작합니다. n = 0을 포함해 entry 여섯 번이 관찰되고, 미완료 호출 다섯 개가 값 두 개씩 보존하므로 최대 스택 깊이는 10입니다. halt 전에 열 값이 모두 복원됩니다. 가져온 66개 명령과 정확한 컨트롤러 목록은 이 유한 컴파일 프로시저를 측정합니다.

SICP 코드UTF-8 6,732 / 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 operations
    (list
      (cons 'record-entry (lambda (n) 'ok))
      (cons '= =)
      (cons '- -)
      (cons '* *)))
  (define controller
    '(factorial-entry
       (perform (op record-entry (reg n)))
       (test (op = (reg n) (const 0)))
       (branch base-case)
       (save continue)
       (save n)
       (assign n (op - (reg n) (const 1)))
       (assign continue (label after-factorial))
       (goto (label factorial-entry))
      after-factorial
       (restore n)
       (restore continue)
       (assign val (op * (reg n) (reg val)))
       (goto (reg continue))
      base-case
       (assign val (const 1))
       (goto (reg continue))
      done
       (halt)))
  (define machine
    (make-machine '(n val continue) operations controller))
  (list (machine-labels machine)
        (length (machine-instructions machine))
        (map car (machine-instructions machine)))
)

(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 operations
    (list
      (cons 'record-entry (lambda (n) 'ok))
      (cons '= =)
      (cons '- -)
      (cons '* *)))
  (define controller
    '(factorial-entry
       (perform (op record-entry (reg n)))
       (test (op = (reg n) (const 0)))
       (branch base-case)
       (save continue)
       (save n)
       (assign n (op - (reg n) (const 1)))
       (assign continue (label after-factorial))
       (goto (label factorial-entry))
      after-factorial
       (restore n)
       (restore continue)
       (assign val (op * (reg n) (reg val)))
       (goto (reg continue))
      base-case
       (assign val (const 1))
       (goto (reg continue))
      done
       (halt)))
  (define machine
    (make-machine '(n val continue) operations controller))
  (list (machine-labels machine)
        (length (machine-instructions machine))
        (map car (machine-instructions machine)))
)

예제

결과—

출력: —
값: —
진단: —

실행 추적0 / 0 개 이벤트

예상 결과

목록은 (((factorial-entry . 0) (after-factorial . 8) (base-case . 12) (done . 14)) 15 (perform test branch save save assign assign goto restore restore assign goto assign goto halt))를 반환합니다. 실행은 (15 complete 120 66 10 #t (5 4 3 2 1 0))을 반환합니다.

실행 추적에서 볼 점

재귀 이동 전 continue가 done에서 after-factorial로 바뀌는 과정을 따라가세요. base case 뒤에는 같은 after-call 코드를 통한 간접 복귀 다섯 번이 이어집니다. save 두 개씩을 나중 restore와 맞추고 마지막 goto가 done에 닿기 전에 깊이가 10에서 0으로 돌아오는지 확인하세요.

직접 해보기

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

재귀 Fibonacci나 거듭제곱 프로시저를 같은 명시적인 목록으로 옮기세요. 각 재귀 호출 뒤에도 살아 있어야 할 레지스터를 밝히고 대표 입력의 최대 스택 깊이를 예상하세요.

힌트 보기

재귀 결과가 돌아온 뒤 필요한 continuation과 값만 저장하세요. 재귀 호출이 두 번이면 첫 번째 반환값도 두 번째 호출 동안 보존해야 합니다.

이 수업 완료하기

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