数字电路的模拟

;基本功能块;延时:(define inverter-delay 2)(define and-gate-delay 3)(define or-gate-delay 5);inverter(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 x) (- 1 x));and-gate(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 (logical-and a b)  (* a b));3.28;or-gate(define (or-gate a1 a2 output)  (define (or-gate-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-gate-procedure)  (add-action! a2 or-gate-procedure)  'ok)(define (logical-or a b)  (if (>= (+ a b) 1)      1      0));3.29;or-gate-delay = and-gate-delay + 2 * inverter-delay(define (or-gate-2 a1 a2 output)  (let ((a (make-wire))        (b (make-wire))        (c (make-wire)))    (inverter a1 a)    (inverter a2 b)    (and-gate a b c)    (inverter c output)    'ok));3.30(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 c2 c1 c-out)    'ok))(define (ripple-carry-adder a b s c)  (if (null? a)      (set-signal! c 0)      (let ((c1 (make-wire)))        (full-adder (car a) (car b) c1 (car s) c)        (ripple-carry-adder (cdr a) (cdr b) (cdr s) c1)))  'ok);线路的表示(define (make-wire)  (let ((signal-value 0)        (action-procedures '()))    (define (set-my-signal! new-value)      (if (not (= new-value signal-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 "wrong operation type"))))    dispatch))(define (call-each action-procedures)  (if (null? action-procedures)      'done      (begin        ((car action-procedures))        (call-each (cdr action-procedures)))))(define (get-signal wire)  (wire 'get-signal))(define (set-signal! wire new-value)    ((wire 'set-signal!) new-value))(define (add-action! wire proc)  ((wire 'add-action!) proc));待处理表的实现(define (empty-agenda? agenda)  (null? (segments agenda)))(define (make-time-segment time queue)     (cons time queue))(define (segment-time s) (car s))(define (segment-queue s) (cdr s))(define (make-agenda)  (list 0))(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)  (let ((segments (segments agenda)))    (if (null? segments)        (error "first-segment: no segment")        (car segments))))(define (rest-segment agenda)  (let ((segments (segments agenda)))    (if (null? segments)        (error "rest-segment: no segment")        (cdr segments))))(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)      (cons time q)))  (define (add-to-segments! segments)    (if (= time (segment-time (car segments)))        (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)                              rest))              (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-segment agenda)))))(define (first-agenda-item agenda)  (if (empty-agenda? agenda)      (error "first-agenda-item: agenda empty")      (let ((first-seg (first-segment agenda)))        (set-current-time! agenda (segment-time first-seg))        (front-queue (segment-queue first-seg)))));队列操作(define (make-queue)  (cons '() '()))(define (front-ptr queue)  (car queue))(define (rear-ptr queue)  (cdr queue))(define (empty-queue? queue)  (null? (front-ptr queue)))(define (set-front-ptr! queue item)  (set-car! queue item))(define (set-rear-ptr! queue item)  (set-cdr! queue item))(define (front-queue queue)  (if (empty-queue? queue)      (error "front-queue:queue empty")      (car (front-ptr queue))))(define (insert-queue! queue item)  (let ((new-pair (list item)))    (cond ((empty-queue? queue)           (set-front-ptr! queue new-pair)           (set-rear-ptr! queue new-pair)           queue)          (else (set-cdr! (rear-ptr queue) new-pair)                (set-rear-ptr! queue new-pair)                queue))))(define (delete-queue! queue)  (cond ((empty-queue? queue)         (error "delete-queue!:queue empty"))        (else (set-front-ptr! queue (cdr (front-ptr queue)))              queue)));待处理表(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)))));检测部分(define the-agenda (make-agenda))(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);级联进位全加器检查;注意结果可能会发生多次变化，因为不同的线路时延不同(define the-agenda (make-agenda))(define (generate-operand n)  (if (= n 0)      '()      (let ((wire (make-wire)))        (cons wire (generate-operand (- n 1))))))(define (set-operand! wires operand)  (if (null? wires)      'done      (begin        (set-signal! (car wires) (car operand))        (set-operand! (cdr wires) (cdr operand)))))(define (add-probe s)  (if (null? s)      'done      (begin        (probe 'sum (car s))        (add-probe (cdr s)))))(define a (generate-operand 4))(define b (generate-operand 4))(define s (generate-operand 4))(probe 'sum4 (car s))(probe 'sum3 (cadr s))(probe 'sum2 (caddr s))(probe 'sum1 (cadddr s))(define c (make-wire))(probe 'carry c)(ripple-carry-adder a b s c)(set-operand! a '(0 0 1 1))(set-operand! b '(0 1 0 1))(propagate)