- Stop and Copy Speicherbereinigung (Entwurf)
; Stop and Copy Speicherbereinigung, Entwurf
; "ahnlich zu Abelson/Sussman, Kapitel 5.4
; Autor: Gert Smolka
; Old, New zeigen auf Vektoren 0..max (Alte und neue Halde)
(define max 100)
(define Old (make-vector max))
(define New (make-vector max))
; next zeigt auf die n"achste freie Zelle
; - in Old, wenn nicht bereinigt wird
; - in New, wenn bereinigt wird
; scan zeigt auf die erste, noch nicht bearbeitete
; typisierte Zelle in New (wenn bereinigt wird)
(define next 0)
(define scan 0)
(define Paar 0) ; Typcode f"ur Paare
(define Kopiert 5) ; Typcode f"ur bereits kopierte Paare in Old.
; Der Verweis auf die Kopie ist in der n"achsten Zelle.
(define (bereinige)
; kopiere 1. Paar von Old nach New
(set! next 0)
(kopiere 0)
; Kopiere alles andere, ausgehend von dem ersten Paar in New
(set! scan 0)
(bereinige-iter)
; vertausche Old und New
(set! scan Old)
(set! Old New)
(set! New Old))
(define (bereinige-iter)
(cond ((eq? scan next))
(else (cond ((eq? (vector-ref New scan) Paar)
(kopiere (vector-ref New (+ 1 scan)))))
(set! scan (+ scan 2))
(bereinige-iter))))
(define (kopiere AlteAddr)
(cond ((eq? (vector-ref Old AlteAdr) Kopiert)
(vector-set New (+ 1 scan) (vector-ref Old (+ 1 AlteAdr))))
(else
; kopiere Paar von Old nach New
(vector-set New next (vector-ref Old AlteAdr))
(vector-set New (+ 1 next) (vector-ref Old (+ 1 AlteAdr)))
(vector-set New (+ 2 next) (vector-ref Old (+ 2 AlteAdr)))
(vector-set New (+ 3 next) (vector-ref Old (+ 3 AlteAdr)))
; markiere und aktualisiere Paar in Old
(vector-set Old AlteAdr Kopiert)
(vector-set Old (+ 1 AlteAdr) next)
;
(set! next (+ 4 next)))))
- Die Berechnung der Fakultät in der Assemblersprache A unter
Verwendung von des Stacks (als Eingabe für den A nach M Übersetzer
geeignet):
((a 'load) '((register n r e)
(marken anfang weiter basis halt)
(assign r halt)
anfang
(branch (< (fetch n) 2) basis)
(push (fetch r))
(push (fetch n))
(assign n (- (fetch n) 1))
(assign r weiter)
(goto anfang)
basis
(assign e 1)
(goto (fetch r))
weiter
(pop n)
(pop r)
(assign e (* (fetch n) (fetch e)))
(goto (fetch r))
halt))
- Die Berechnung der Fakultät als M-Programm (als Eingabe
für den M-Interpretierer geeignet):
((m 'load) '( 4 1 27 ; 0: store 1 a
4 2 29 ; 3: store 2 akku
10 28 29 29 ; 6: sub n akku akku
8 29 26 ; 10: branch<0? akku 26
11 27 28 27 ; 13: mul a n a
4 1 29 ; 17: store 1 akku
10 28 29 28 ; 20: sub n akku n
5 3 ; 24: jump-d 3
12 ; 26: halt
0 ; 27: a (Ausgabe)
10 ; 28: n (Eingabe)
0 ; 29: akku
))
- Der Interpretierer für Scheme 2 und 3 aus der Vorlesung vom 26. Januar ist hier.
- Der Interpretierer für Scheme 2 aus der Vorlesung vom 19. Januar ist hier.
- Die Prozeduren
force und memo-proc aus der Vorlesung vom 17. Januar:
(define (force p)
(p))
(define (memo-proc p)
(let ((ergebnis ())
(angewendet #f))
(lambda ()
(if angewendet
ergebnis
(begin (set! ergebnis (p))
(set! angewendet #t)
ergebnis)))))
- Die Berechnung von allen Teilströmen eines Stroms aus der Vorlesung vom 17. Januar:
; MIT-Scheme bietet die folgende Unterst"utzung f"ur Str"ome an:
; cons-stream (wie in der Vorlesung)
; stream-car (in der Vorlesung: head)
; stream-cdr (in der Vorlesung: tail)
; stream-null? (in der Vorlesung: empty-stream?)
; (stream) (erzeugt den leeren Strom)
; Die Prozedur stream funktioniert genauso wie list, z.B:
; (stream 1 2 3) erzeugt einen Strom mit den Elementen 1,2,3
(define the-empty-stream
(stream))
(define (teile s)
(if (stream-null? s)
(cons-stream s the-empty-stream)
(accumulate
(lambda (t tr)
(cons-stream
t
(cons-stream
(cons-stream (stream-car s) t)
tr)))
the-empty-stream
(teile (stream-cdr s)))))
- Der Schaltkreis-Simulator aus der Vorlesung vom 12. Januar ist hier.
- Die Queue-Klasse aus der Vorlesung vom 20. Dezember.
(define (queue)
(define first ())
(define last ())
(define (empty?) (null? first))
(define (front)
(cond ((empty?)
(error "queue is empty"))
(else
(car first))))
(define (enqueue X)
(cond ((empty?)
(set! first (list X))
(set! last first)
first)
(else
(set-cdr! last (list X))
(set! last (cdr last))
first)))
(define (dequeue)
(cond ((empty?)
(error "queue is empty"))
(else
(let ((x (car first)))
(set! first (cdr first))
x))))
(lambda (message)
(cond ((eq? message 'empty) empty?)
((eq? message 'front) front)
((eq? message 'enqueue) enqueue)
((eq? message 'dequeue) dequeue)
(else (error "message not understood"))))
)
- Die Counter-Stack Klasse aus der Vorlesung vom 15. Dezember.
(define (counter value)
(define stack ())
(define inc (lambda ()
(set! value (+ value 1))
()))
(define (ask) value)
(define (push)
(set! stack (cons value stack))
())
(define (pop)
(cond ((null? stack)
(write value) ())
(else
(set! value (car stack))
(set! stack (cdr stack))
())))
(lambda (message)
(cond ((eq? message 'inc) inc)
((eq? message 'ask) ask)
((eq? message 'push) push)
((eq? message 'pop) pop)
(else
(write "message not understood") (abort))))
)
