451 lines
12 KiB
Racket
451 lines
12 KiB
Racket
#lang sicp
|
|
|
|
(#%require "3_21.rkt") ;; for queue
|
|
(#%require racket/trace)
|
|
|
|
(define (make-agenda) (list 0))
|
|
|
|
(define the-agenda (make-agenda))
|
|
(define inverter-delay 1)
|
|
(define and-gate-delay 10)
|
|
(define or-gate-delay 100)
|
|
|
|
|
|
;;;SECTION 3.3.4
|
|
|
|
;: (define a (make-wire))
|
|
;: (define b (make-wire))
|
|
;: (define c (make-wire))
|
|
;: (define d (make-wire))
|
|
;: (define e (make-wire))
|
|
;: (define s (make-wire))
|
|
;:
|
|
;: (or-gate a b d)
|
|
;: (and-gate a b c)
|
|
;: (inverter c e)
|
|
;: (and-gate d e s)
|
|
|
|
|
|
;;NB. To use half-adder, need or-gate from exercise 3.28
|
|
(define (half-adder a b s c)
|
|
(let ((d (make-wire)) (e (make-wire)))
|
|
(or-gate a b d)
|
|
(and-gate a b c)
|
|
(inverter c e)
|
|
(and-gate d e s)
|
|
'ok))
|
|
|
|
(define (full-adder a b c-in sum c-out)
|
|
(let ((s (make-wire))
|
|
(c1 (make-wire))
|
|
(c2 (make-wire)))
|
|
(half-adder b c-in s c1)
|
|
(half-adder a s sum c2)
|
|
(or-gate c1 c2 c-out)
|
|
'ok))
|
|
|
|
(define (inverter input output)
|
|
(define (invert-input)
|
|
(let ((new-value (logical-not (get-signal input))))
|
|
(after-delay inverter-delay
|
|
(lambda ()
|
|
(set-signal! output new-value)))))
|
|
(add-action! input invert-input)
|
|
'ok)
|
|
|
|
(define (logical-not s)
|
|
(cond ((= s 0) 1)
|
|
((= s 1) 0)
|
|
(else (error "Invalid signal" s))))
|
|
|
|
;; *following uses logical-and -- see ch3support.scm
|
|
(define (logical-and x y)
|
|
(cond ((and (= x 1) (= y 1)) 1)
|
|
((or
|
|
(and (= x 0) (= y 0))
|
|
(and (= x 0) (= y 1))
|
|
(and (= x 1) (= y 0)))
|
|
0)
|
|
(else
|
|
(error "Invalid signal" x y))))
|
|
|
|
(define (and-gate a1 a2 output)
|
|
(define (and-action-procedure)
|
|
(let ((new-value
|
|
(logical-and (get-signal a1) (get-signal a2))))
|
|
(after-delay and-gate-delay
|
|
(lambda ()
|
|
(set-signal! output new-value)))))
|
|
(add-action! a1 and-action-procedure)
|
|
(add-action! a2 and-action-procedure)
|
|
'ok)
|
|
|
|
|
|
(define (make-wire)
|
|
(let ((signal-value 0) (action-procedures '()))
|
|
(define (set-my-signal! new-value)
|
|
(if (not (= signal-value new-value))
|
|
(begin (set! signal-value new-value)
|
|
(call-each action-procedures))
|
|
'done))
|
|
(define (accept-action-procedure! proc)
|
|
(set! action-procedures (cons proc action-procedures))
|
|
(proc))
|
|
(define (dispatch m)
|
|
(cond ((eq? m 'get-signal) signal-value)
|
|
((eq? m 'set-signal!) set-my-signal!)
|
|
((eq? m 'add-action!) accept-action-procedure!)
|
|
(else (error "Unknown operation -- WIRE" m))))
|
|
dispatch))
|
|
|
|
(define (call-each procedures)
|
|
(if (null? procedures)
|
|
'done
|
|
(begin
|
|
((car procedures))
|
|
(call-each (cdr procedures)))))
|
|
|
|
(define (get-signal wire)
|
|
(wire 'get-signal))
|
|
|
|
(define (set-signal! wire new-value)
|
|
((wire 'set-signal!) new-value))
|
|
|
|
(define (add-action! wire action-procedure)
|
|
((wire 'add-action!) action-procedure))
|
|
|
|
(define (after-delay delay action)
|
|
(add-to-agenda! (+ delay (current-time the-agenda))
|
|
action
|
|
the-agenda))
|
|
|
|
(define (propagate)
|
|
(if (empty-agenda? the-agenda)
|
|
'done
|
|
(let ((first-item (first-agenda-item the-agenda)))
|
|
(first-item)
|
|
(remove-first-agenda-item! the-agenda)
|
|
(propagate))))
|
|
|
|
(define (probe name wire)
|
|
(add-action! wire
|
|
(lambda ()
|
|
(newline)
|
|
(display name)
|
|
(display " ")
|
|
(display (current-time the-agenda))
|
|
(display " New-value = ")
|
|
(display (get-signal wire))
|
|
(newline))))
|
|
|
|
|
|
;;;Implementing agenda
|
|
|
|
(define (make-time-segment time queue)
|
|
(cons time queue))
|
|
(define (segment-time s) (car s))
|
|
(define (segment-queue s) (cdr s))
|
|
|
|
(define (current-time agenda) (car agenda))
|
|
(define (set-current-time! agenda time)
|
|
(set-car! agenda time))
|
|
|
|
(define (segments agenda) (cdr agenda))
|
|
(define (set-segments! agenda segments)
|
|
(set-cdr! agenda segments))
|
|
(define (first-segment agenda) (car (segments agenda)))
|
|
(define (rest-segments agenda) (cdr (segments agenda)))
|
|
|
|
(define (empty-agenda? agenda)
|
|
(null? (segments agenda)))
|
|
|
|
(define (add-to-agenda! time action agenda)
|
|
(define (belongs-before? segments)
|
|
(or (null? segments)
|
|
(< time (segment-time (car segments)))))
|
|
(define (make-new-time-segment time action)
|
|
(let ((q (make-queue)))
|
|
(insert-queue! q action)
|
|
(make-time-segment time q)))
|
|
(define (add-to-segments! segments)
|
|
(if (= (segment-time (car segments)) time)
|
|
(insert-queue! (segment-queue (car segments))
|
|
action)
|
|
(let ((rest (cdr segments)))
|
|
(if (belongs-before? rest)
|
|
(set-cdr!
|
|
segments
|
|
(cons (make-new-time-segment time action)
|
|
(cdr segments)))
|
|
(add-to-segments! rest)))))
|
|
(let ((segments (segments agenda)))
|
|
(if (belongs-before? segments)
|
|
(set-segments!
|
|
agenda
|
|
(cons (make-new-time-segment time action)
|
|
segments))
|
|
(add-to-segments! segments))))
|
|
|
|
(define (remove-first-agenda-item! agenda)
|
|
(let ((q (segment-queue (first-segment agenda))))
|
|
(delete-queue! q)
|
|
(if (empty-queue? q)
|
|
(set-segments! agenda (rest-segments agenda)))))
|
|
|
|
(define (first-agenda-item agenda)
|
|
(if (empty-agenda? agenda)
|
|
(error "Agenda is empty -- FIRST-AGENDA-ITEM")
|
|
(let ((first-seg (first-segment agenda)))
|
|
(set-current-time! agenda (segment-time first-seg))
|
|
(front-queue (segment-queue first-seg)))))
|
|
|
|
;; 3.28
|
|
|
|
(define (logical-or x y)
|
|
(cond ((and (= x 0) (= y 0)) 0)
|
|
((or
|
|
(and (= x 0) (= y 1))
|
|
(and (= x 1) (= y 0))
|
|
(and (= x 1) (= y 1)))
|
|
1)
|
|
(else
|
|
(error "Invalid signals" x y))))
|
|
|
|
(define (or-gate a1 a2 output)
|
|
(define (or-action-procedure)
|
|
(let ((new-value
|
|
(logical-or (get-signal a1) (get-signal a2))))
|
|
(after-delay or-gate-delay
|
|
(lambda ()
|
|
(set-signal! output new-value)))))
|
|
(add-action! a1 or-action-procedure)
|
|
(add-action! a2 or-action-procedure)
|
|
'ok)
|
|
|
|
;;; Sample simulation
|
|
|
|
(#%require (only racket/base module+))
|
|
|
|
(module+ sample-simulation
|
|
|
|
(define input-1 (make-wire))
|
|
(define input-2 (make-wire))
|
|
(define sum (make-wire))
|
|
(define carry (make-wire))
|
|
|
|
(probe 'sum sum)
|
|
(probe 'carry carry)
|
|
|
|
(half-adder input-1 input-2 sum carry)
|
|
(set-signal! input-1 1)
|
|
(propagate)
|
|
|
|
(set-signal! input-2 1)
|
|
(propagate))
|
|
|
|
(module+ test
|
|
(#%require rackunit)
|
|
|
|
(define (or-test or-gate probe? or-min-delay or-max-delay)
|
|
(let ((input-1 (make-wire))
|
|
(input-2 (make-wire))
|
|
(output (make-wire))
|
|
(start-time (current-time the-agenda)))
|
|
(or-gate input-1 input-2 output)
|
|
(if probe?
|
|
(begin
|
|
(probe 'input-1 input-1)
|
|
(probe 'input-2 input-2)
|
|
(probe 'output output)))
|
|
|
|
(set-signal! input-1 1)
|
|
(set-signal! input-2 1)
|
|
(propagate)
|
|
(check-equal? (get-signal output) 1)
|
|
|
|
(set-signal! input-1 1)
|
|
(set-signal! input-2 0)
|
|
(propagate)
|
|
(check-equal? (get-signal output) 1)
|
|
|
|
(set-signal! input-1 0)
|
|
(set-signal! input-2 1)
|
|
(propagate)
|
|
(check-equal? (get-signal output) 1)
|
|
|
|
(set-signal! input-1 0)
|
|
(set-signal! input-2 0)
|
|
(propagate)
|
|
(check-equal? (get-signal output) 0)
|
|
|
|
(let* ((end-time (current-time the-agenda))
|
|
(elapsed-time (- end-time start-time)))
|
|
(check <= elapsed-time (* 4 or-max-delay))
|
|
(check >= elapsed-time (* 4 or-min-delay)))))
|
|
|
|
(test-case "Or gate 3.28"
|
|
(or-test or-gate #f or-gate-delay or-gate-delay)))
|
|
|
|
;; 3.29 Or gate from and gates
|
|
|
|
;; a or b
|
|
;; (not (not (a or b)))
|
|
;; (not ((not a) and (not b)))
|
|
|
|
;; Delay is 2*inverter-delay + and-gate-delay
|
|
|
|
(define (or-from-and-gates a b output)
|
|
(let ((c (make-wire))
|
|
(d (make-wire))
|
|
(e (make-wire)))
|
|
(inverter a c)
|
|
(inverter b d)
|
|
(and-gate c d e)
|
|
(inverter e output)
|
|
'ok))
|
|
|
|
(module+ test
|
|
;; The final inverter will not be activated if the and gate's output
|
|
;; doesn't change, so the minimum time is 1 less than the maximum.
|
|
(test-case "Or gate from and gates 3.29"
|
|
(or-test or-from-and-gates #f (+ inverter-delay and-gate-delay)
|
|
(+ (* 2 inverter-delay) and-gate-delay))))
|
|
|
|
|
|
;; 3.30 Ripple adder
|
|
;;
|
|
;; Half-adder delay: max: (+ (max (+ and not) or) and)
|
|
;; min (either or or and could not trigger the following component):
|
|
;; (min (min or (+ and not and)) (+ or and))
|
|
;; Full-adder delay: 2 * half-adder + or
|
|
;; Ripple adder delay: n * full-adder = n * (2 * (max((and + not), or) + and) + or)
|
|
(define (ripple-carry-adder a b s c)
|
|
(define (add-full-adder a b s c)
|
|
(if (and (pair? a)
|
|
(pair? b)
|
|
(pair? s))
|
|
(let ((ci (make-wire)))
|
|
(full-adder (car a)
|
|
(car b)
|
|
ci
|
|
(car s)
|
|
c)
|
|
(add-full-adder (cdr a)
|
|
(cdr b)
|
|
(cdr s)
|
|
ci))))
|
|
(if (= (length a)
|
|
(length b)
|
|
(length s))
|
|
(add-full-adder a b s c)))
|
|
|
|
(define half-adder-max-delay
|
|
(+ (max (+ and-gate-delay inverter-delay) or-gate-delay)
|
|
and-gate-delay))
|
|
|
|
(define half-adder-min-delay
|
|
(min (min or-gate-delay
|
|
(+ (* 2 and-gate-delay) inverter-delay))
|
|
(+ or-gate-delay and-gate-delay)))
|
|
|
|
(define full-adder-max-delay
|
|
(+ (* 2 half-adder-max-delay)
|
|
or-gate-delay))
|
|
|
|
(define full-adder-min-delay
|
|
(* 2 half-adder-min-delay))
|
|
|
|
(define (ripple-adder-max-delay n)
|
|
(* n full-adder-max-delay))
|
|
|
|
;; If the first full adder doesn't change its outputs, none of the
|
|
;; rest are activated.
|
|
(define ripple-adder-min-delay full-adder-min-delay)
|
|
|
|
(module+ test
|
|
|
|
(define (make-wire-list values)
|
|
(cond ((null? values) '())
|
|
(else
|
|
(let ((w (make-wire)))
|
|
(set-signal! w (car values))
|
|
(cons w (make-wire-list (cdr values)))))))
|
|
|
|
(define (make-empty-wire-list length)
|
|
(define (make-zeroes length)
|
|
(if (= length 0)
|
|
'()
|
|
(cons 0 (make-zeroes (- length 1)))))
|
|
(make-wire-list (make-zeroes length)))
|
|
|
|
(define (get-wire-signals wire-list)
|
|
(map get-signal wire-list))
|
|
|
|
(define (test-ripple-adder a1 a2 sum carry)
|
|
(let ((a (make-wire-list a1))
|
|
(b (make-wire-list a2))
|
|
(s (make-empty-wire-list (length a1)))
|
|
(c (make-wire))
|
|
(before (current-time the-agenda))
|
|
(ripple-adder-time
|
|
(* (length a1)
|
|
(+
|
|
(* 2
|
|
(+ (max (+ and-gate-delay inverter-delay)
|
|
or-gate-delay)
|
|
and-gate-delay))
|
|
or-gate-delay))))
|
|
(ripple-carry-adder a b s c)
|
|
(propagate)
|
|
(check-equal? (get-wire-signals s) sum)
|
|
(check-equal? (get-signal c) carry)
|
|
(let* ((after (current-time the-agenda))
|
|
(elapsed-time (- after before)))
|
|
(check <= elapsed-time (ripple-adder-max-delay (length a1)))
|
|
(check >= elapsed-time ripple-adder-min-delay))))
|
|
|
|
(test-case "Ripple carry adder 3.30 (15+0)"
|
|
(test-ripple-adder
|
|
'(1 1 1 1)
|
|
'(0 0 0 0)
|
|
'(1 1 1 1)
|
|
0))
|
|
|
|
(test-case "Ripple carry adder 3.30 (1+1)"
|
|
(test-ripple-adder
|
|
'(1)
|
|
'(1)
|
|
'(0)
|
|
1))
|
|
|
|
(test-case "Ripple carry adder 3.30 (3+1)"
|
|
(test-ripple-adder
|
|
'(1 1)
|
|
'(0 1)
|
|
'(0 0)
|
|
1))
|
|
|
|
(test-case "Ripple carry adder 3.30 (15+1)"
|
|
(test-ripple-adder
|
|
'(1 1 1 1)
|
|
'(0 0 0 1)
|
|
'(0 0 0 0)
|
|
1)))
|
|
|
|
;; EXERCISE 3.31
|
|
;: (define (accept-action-procedure! proc)
|
|
;: (set! action-procedures (cons proc action-procedures)))
|
|
;; If the definition above is used, all wires are left at their starting values.
|
|
;; In particular, for the half adder, the wire after the inverter remains at
|
|
;; 0 despite its input being 0. As a result, the sum is not set correctly.
|
|
|
|
;; Exercise 3.32
|
|
;; If we use a stack instead of a queue for the agenda segments, then for each segment
|
|
;; the tasks will be removed in the reverse order to that which they were added. In
|
|
;; the case of the and gate, the output value is calculated at the time of the signal change
|
|
;; (i.e. before the delay) and held in the closure. While the values of the input signals
|
|
;; will be played back in the correct order, the value of the output will be played back
|
|
;; in reverse. If the order of the inputs is: (0,0), (1,0), (1,1), (0,1), then the output
|
|
;; will be set to 0 by the last change and then 1 by the penultimate change, which is not
|
|
;; the correct answer.
|