程序代写代做代考 ��

��

� ��
��

� Invariant:��
��
��

� ��

� ��
��

�

��

Reference counting:��
��

�

��

Reference counting:��
��

� ��

� ��
��

�

��

1
1

��

��
��

�

��

1
1

��
��

�

��

1
1

��
��

�

��

1
1

��

�

��

1
1

0
1

��

�

��

1
1

��

�

��

1
1

��
��

��

1
1

��
��

��

1
1

��
��

��

� ��

��

� ��

� ��
��

��

� ��white

� ��gray

� ��

��r

��r��

��r�black

� ��

��

��
��

��

��
��

��

��
��

��

��
��

��

��
��

��

��
��

��

��
��

��do not��
��

��

;; init-allocator : -> void?
(define (init-allocator)
(for ([i (in-range 0 (heap-size))])
(heap-set! i ‘free)))

;; gc:flat? : location? -> boolean?
(define (gc:flat? loc)
(equal? (heap-ref loc) ‘flat))

;; gc:deref : location? -> void?
(define (gc:deref loc)
(cond
[(equal? (heap-ref loc) ‘flat)
(heap-ref (+ loc 1))]
[else
(error ‘gc:deref
“attempted to deref a non flat value, loc ~s”
loc)]))

��

;; gc:cons? : location? -> boolean?
(define (gc:cons? loc)
(equal? (heap-ref loc) ‘pair))

;; gc:first : location? -> location?
(define (gc:first pr-ptr)
(if (equal? (heap-ref pr-ptr) ‘pair)
(heap-ref (+ pr-ptr 1))
(error ‘first “non pair”)))

;; gc:rest : location? -> location?
(define (gc:rest pr-ptr)
(if (equal? (heap-ref pr-ptr) ‘pair)
(heap-ref (+ pr-ptr 2))
(error ‘rest “non pair”)))

��

;; gc:set-first! : location? location? -> void?
(define (gc:set-first! pr-ptr new)
(if (equal? (heap-ref pr-ptr) ‘pair)
(heap-set! (+ pr-ptr 1) new)
(error ‘set-first! “non pair”)))

;; gc:set-rest! : location? location? -> void?
(define (gc:set-rest! pr-ptr new)
(if (equal? (heap-ref pr-ptr) ‘pair)
(heap-set! (+ pr-ptr 2) new)
(error ‘set-first! “non pair”)))

��

;; gc:closure-code-ptr : location? -> heap-value?
(define (gc:closure-code-ptr loc)
(if (gc:closure? loc)
(heap-ref (+ loc 1))
(error ‘gc:closure-code “non closure @ ~a, got ~s”
loc (heap-ref loc))) )

;; gc:closure-env-ref : location? integer? -> location?
(define (gc:closure-env-ref loc i)
(if (gc:closure? loc)
(if (< i (heap-ref (+ loc 2))) (heap-ref (+ loc 3 i)) (error 'closure-env-ref "closure-env-ref out of bounds")) (error 'closure-env-ref "non closure"))) ;; gc:closure? : location? -> boolean?
(define (gc:closure? loc)
(equal? (heap-ref loc) ‘proc))

��

;; gc:alloc-flat : heap-value? -> location?
(define (gc:alloc-flat fv)
(let ([ptr (alloc 2 #f #f)])
(heap-set! ptr ‘flat)
(heap-set! (+ ptr 1) fv)
ptr))

;; gc:cons : root? root? -> location?
(define (gc:cons hd tl)
(define ptr (alloc 3 hd tl))
(heap-set! ptr ‘pair)
(heap-set! (+ ptr 1) (read-root hd))
(heap-set! (+ ptr 2) (read-root tl))
ptr)

��

;; gc:closure : heap-value? (vectorof locaction?) -> location?
(define (gc:closure code-ptr free-vars)
(define free-vars-count (length free-vars))
(define next (alloc (+ free-vars-count 3) free-vars ‘()))
(heap-set! next ‘proc)
(heap-set! (+ next 1) code-ptr)
(heap-set! (+ next 2) free-vars-count)
(for ([x (in-range 0 free-vars-count)]
[r (in-list free-vars)])
(heap-set! (+ next 3 x) (read-root r)))
next)

��

a roots is either:
– root?
– location?
– (listof roots?)

;; alloc : number? roots? roots? -> location?
(define (alloc n some-roots some-more-roots)
(let ([next (find-free-space 0 n)])
(cond
[next
next]
[else
(collect-garbage some-roots some-more-roots)
(let ([next (find-free-space 0 n)])
(unless next
(error ‘alloc “out of space”))
next)])))

��

;; find-free-space : location? number? -> (or/c location? #f)
;; start must be a valid pointer
;; (not to the middle of an object)
(define (find-free-space start size)
(cond
[(= start (heap-size)) #f]
[else
(case (heap-ref start)
[(free)
(if (n-free-blocks? start size)
start
(find-free-space (+ start 1) size))]
[(flat) (find-free-space (+ start 2) size)]
[(pair) (find-free-space (+ start 3) size)]
[(proc)
(find-free-space (+ start 3 (heap-ref (+ start 2)))

size)]
[else
(error ‘find-free-space “ack ~s” start)])]))

��

;; n-free-blocks? : location? integer? -> boolean?
(define (n-free-blocks? start size)
(cond
[(= size 0) #t]
[(= start (heap-size)) #f]
[else
(and (eq? ‘free (heap-ref start))
(n-free-blocks? (+ start 1) (- size 1)))]))

��

;; collect-garbage : roots? roots? -> void?
(define (collect-garbage some-roots some-more-roots)
(validate-heap)
(mark-white! 0)
(traverse/roots (get-root-set))
(traverse/roots some-roots)
(traverse/roots some-more-roots)
(free-white! 0)
(validate-heap))

��

;; validate-heap : -> void?
(define (validate-heap)
(define (valid-pointer? i)
(unless (memq (heap-ref i) ‘(flat pair proc))
(error ‘validate-heap “found bad pointer @ ~a” i)))
(let loop ([i 0])
(when (< i (heap-size)) (case (heap-ref i) [(flat) (loop (+ i 2))] [(pair) (valid-pointer? (heap-ref (+ i 1))) (valid-pointer? (heap-ref (+ i 2))) (loop (+ i 3))] [(proc) (for ([x (in-range 0 (heap-ref (+ i 2)))]) (valid-pointer? (heap-ref (+ i 3 x)))) (loop (+ i 3 (heap-ref (+ i 2))))] [(free) (loop (+ i 1))] [else (error 'validate-heap "corruption! @ ~a" i)])))) �� ;; mark-white! : location? -> void?
(define (mark-white! i)
(when (< i (heap-size)) (case (heap-ref i) [(pair) (heap-set! i 'white-pair) (mark-white! (+ i 3))] [(flat) (heap-set! i 'white-flat) (mark-white! (+ i 2))] [(proc) (heap-set! i 'white-proc) (mark-white! (+ i 3 (heap-ref (+ i 2))))] [(free) (mark-white! (+ i 1))] [else (error 'mark-white! "unknown tag @ ~a" i)]))) �� ;; free-white! : location? -> void?
(define (free-white! i)
(when (< i (heap-size)) (case (heap-ref i) [(pair) (free-white! (+ i 3))] [(flat) (free-white! (+ i 2))] [(proc) (free-white! (+ i 3 (heap-ref (+ i 2))))] [(white-pair) (heap-set! i 'free) (heap-set! (+ i 1) 'free) (heap-set! (+ i 2) 'free) (free-white! (+ i 3))] [(white-flat) (heap-set! i 'free) (heap-set! (+ i 1) 'free) (free-white! (+ i 2))] [(white-proc) (define closure-size (heap-ref (+ i 2))) (for ([dx (in-range 0 (+ closure-size 3))]) (heap-set! (+ i dx) 'free)) (free-white! (+ i 3 closure-size))] [(free) (free-white! (+ i 1))] [else (error 'free-white! "unknown tag ~s" (heap-ref i))]))) �� ;; traverse/roots : roots? -> void?
(define (traverse/roots thing)
(cond
[(list? thing) (for-each traverse/roots thing)]
[(root? thing) (traverse/roots (read-root thing))]
[(number? thing) (traverse/loc thing)]))

��

;; traverse/loc : location? -> void?
(define (traverse/loc loc)
(case (heap-ref loc)
[(white-pair)
(heap-set! loc ‘pair)
(traverse/loc (heap-ref (+ loc 1)))
(traverse/loc (heap-ref (+ loc 2)))]
[(white-flat)
(heap-set! loc ‘flat)]
[(white-proc)
(heap-set! loc ‘proc)
(for ([i (in-range (heap-ref (+ loc 2)))])
(traverse/loc (heap-ref (+ loc 3 i))))]
[(pair) (void)]
[(flat) (void)]
[(proc) (void)]
[else
(error ‘traverse/loc “crash ~s” loc)]))

��

� ��

��

��two-space��
��

Allocator:

� ��to-space��from-space

� ��to-space

Collector:

� ��to-space��from-space

� �� from-space ��
to-space

� ��
to-space��

��

��
��

��

��
��

��

��
��

��

��
��

��

��
��

��

��
��

��

��
��

��

��
��

��

��
��

��

� ��

��

� ��
��
��

��

��
��

��

Invariant:��
��
��

��

� ��
��

��
��
��
��
��

��
��
��

��

� ��to-space��
��

� ��
��
��

��

� ��

��

��7 � ��0

�� 1 75 2 0 3 2 10 3 2 2 3 1 4

��

� ��

��

��7 � ��0

�� 1 75 2 0 3 2 10 3 2 2 3 1 4
�� 00 01 02 03 04 05 06 07 08 09 10 11 12

��

� ��

��

��7 � ��0

�� 1 75 2 0 3 2 10 3 2 2 3 1 4
�� 00 01 02 03 04 05 06 07 08 09 10 11 12

^ ^ ^ ^ ^

��

� ��

��

��7 � ��0

�� 1 75 2 0 3 2 10 3 2 2 3 1 4
�� 00 01 02 03 04 05 06 07 08 09 10 11 12

^ ^ ^ ^ ^
�� 0 0 0 0 0 0 0 0 0 0 0 0 0
�� ^^
�� 13 14 15 16 17 18 19 20 21 22 23 24 25

��

� ��

��

��13� ��0

�� 1 75 2 0 3 2 10 99 13 2 3 1 4
�� 00 01 02 03 04 05 06 07 08 09 10 11 12

^ ^ ^ ^ ^
�� 3 2 2 0 0 0 0 0 0 0 0 0 0
�� ^ ^
�� 13 14 15 16 17 18 19 20 21 22 23 24 25

��

� ��

��

��13� ��16

�� 99 16 2 0 3 2 10 99 13 2 3 1 4
�� 00 01 02 03 04 05 06 07 08 09 10 11 12

^ ^ ^ ^ ^
�� 3 2 2 1 75 0 0 0 0 0 0 0 0
�� ^ ^
�� 13 14 15 16 17 18 19 20 21 22 23 24 25

��

� ��

��

��13� ��16

�� 99 16 99 18 3 2 10 99 13 2 3 1 4
�� 00 01 02 03 04 05 06 07 08 09 10 11 12

^ ^ ^ ^ ^
�� 3 2 18 1 75 2 0 0 0 0 0 0 0
�� ^ ^
�� 13 14 15 16 17 18 19 20 21 22 23 24 25

��

� ��

��

��13� ��16

�� 99 16 99 18 3 2 10 99 13 2 3 1 4
�� 00 01 02 03 04 05 06 07 08 09 10 11 12

^ ^ ^ ^ ^
�� 3 2 18 1 75 2 0 0 0 0 0 0 0
�� ^ ^
�� 13 14 15 16 17 18 19 20 21 22 23 24 25

��

� ��

��

��13� ��16

�� 99 16 99 18 3 2 10 99 13 2 3 1 4
�� 00 01 02 03 04 05 06 07 08 09 10 11 12

^ ^ ^ ^ ^
�� 3 2 18 1 75 2 16 0 0 0 0 0 0
�� ^^
�� 13 14 15 16 17 18 19 20 21 22 23 24 25

��

ftp://ftp.cs.utexas.edu/pub/garbage/gcsurvey.ps

��

Related Posts