Monday, March 23, 2009

Quick and dirty serial numbers across pages in Django templates

Update:

Scratch that. I just learned that this can be done in a much simpler way:
  1. {% for object in object_list %}  
  2.     {{ page_obj.start_index|add:forloop.counter0 }}  
  3. {% endfor %}  

I recently had to write a template for a paginated view which displayed a serial number for each object in the object_list. I normally use forloop.counter for general purpose serial numbers. However this did not work with paginated views as the counter gets reset in each page. This caused the serial numbers to go from 1 to #-of-results-in-the-page and then repeat. I wrote a filter to tackle this problem.

The code (add to your filters file under ./templatetags/):
view plainprint?
  1. from django import template  
  2. from django.conf import settings  
  3.   
  4. register = template.Library()  
  5.   
  6. @register.filter  
  7. def adjust_for_pagination(value, page):  
  8.     value, page = int(value), int(page)  
  9.     adjusted_value = value + ((page - 1) * settings.RESULTS_PER_PAGE)  
  10.     return adjusted_value  

And the template snippet:
view plainprint?
  1. {% for object in object_list %}  
  2. <div class="serial-no">  
  3.     {% if is_paginated %}  
  4.         {{ forloop.counter|adjust_for_pagination:page }}  
  5.     {% else %}  
  6.        {{ forloop.counter }}  
  7.     {% endif %}  
  8. </div>  
  9. ...  
  10. {% endfor %}  

The adjust_for_pagination filter adjusts the value of forloop.counter based on the current page. Page and is_paginated variables are expected to be present in the context. These should respectively denote the current page number (1 based) and if the results are paginated. RESULTS_PER_PAGE is currently taken from the settings file. I couldn't think of a way to pass this value also from the template.

Posted by Manoj Govindan at 4:55 PM 0 comments
Labels: ,

Sunday, March 08, 2009

SICP Section 5.2 A Register-Machine Simulator

Exercise 5.7. Use the simulator to test the machines you designed in exercise 5.4.

Answer:
1. Recursive Version
view plainprint?
  1. (define expt-machine  
  2.   (make-machine  
  3.    '(n b val continue)  
  4.    (list (list '= =) (list '- -) (list '* *))  
  5.    '(controller  
  6.      (assign continue (label expt-done))  
  7.      expt-loop  
  8.      (test (op =) (reg n) (const 0)) ;; Test for (= n 0)  
  9.      (branch (label base-case))  
  10.      ;; We only need to save continue as b is constant throughout   
  11.      ;; and the successive values of n are not used for calculation.  
  12.      (save continue)  
  13.      (assign n (op -) (reg n) (const 1))  
  14.      (assign continue (label after-expt))  
  15.      (goto (label expt-loop))  
  16.      after-expt  
  17.      (restore continue)  
  18.      (assign val (op *) (reg b) (reg val))  
  19.      (goto (reg continue))  
  20.      base-case  
  21.      (assign val (const 1))  
  22.      (goto (reg continue))  
  23.      expt-done)))  
  24.   
  25. (set-register-contents! expt-machine 'n 2)  
  26. done  
  27. (set-register-contents! expt-machine 'b 4)  
  28. done  
  29. (start expt-machine)  
  30. done  
  31. (get-register-contents expt-machine 'val)  
  32. 16  

2. Iterative Version
view plainprint?
  1. (define expt-machine  
  2.   (make-machine  
  3.    '(n b counter product)  
  4.    (list (list '= =) (list '- -) (list '* *))  
  5.    '(controller   
  6.      (assign counter (reg n))  
  7.      (assign product (const 1))  
  8.      expt-loop  
  9.      (test (op =) (reg counter) (const 0))  
  10.      (branch (label expt-done))  
  11.      ;; We don't have to save any value in the stack.  
  12.      ;; The result of exponentiation will be available in register product at the end of calculation.  
  13.      (assign counter (op -) (reg counter) (const 1))  
  14.      (assign product (op *) (reg b) (reg product))  
  15.      (goto (label expt-loop))  
  16.      expt-done)))  
  17.      
  18. (set-register-contents! expt-machine 'n 2)  
  19. done  
  20. (set-register-contents! expt-machine 'b 4)  
  21. done  
  22. (start expt-machine)  
  23. done  
  24. (get-register-contents expt-machine 'product)  
  25. 16  

Exercise 5.8. The following register-machine code is ambiguous, because the label here is defined more than once:
  1. start  
  2.   (goto (label here))  
  3. here  
  4.   (assign a (const 3))  
  5.   (goto (label there))  
  6. here  
  7.   (assign a (const 4))  
  8.   (goto (label there))  
  9. there  

With the simulator as written, what will the contents of register a be when control reaches there? Modify the extract-labels procedure so that the assembler will signal an error if the same label name is used to indicate two different locations.

Answer: Using the current implementation goto will direct control to the first occurrence of the label here in the sequence of instructions. This means that (assign a (const 3)) will get executed before control proceeds to the label there. Therefore register a will contain the value 3 at the end of execution.

This version of extract-labels checks if a given label is already present in the labels processed so far. If so it raises an error.
view plainprint?
  1. (define (extract-labels text receive)  
  2.   (if (null? text)  
  3.       (receive '() '())  
  4.       (extract-labels (cdr text)  
  5.        (lambda (insts labels)  
  6.          (let ((next-inst (car text)))  
  7.            (if (symbol? next-inst)  
  8.                (begin  
  9.                  (if (assoc next-inst labels)  
  10.                      (error "Multiple declarations of label -- EXTRACT-LABELS" next-inst))  
  11.                  (receive insts  
  12.                           (cons (make-label-entry next-inst  
  13.                                                 insts)  
  14.                                 labels)))  
  15.                (receive (cons (make-instruction next-inst)  
  16.                               insts)  
  17.                         labels)))))))  

Exercise 5.9. The treatment of machine operations above permits them to operate on labels as well as on constants and the contents of registers. Modify the expression-processing procedures to enforce the condition that operations can be used only with registers and constants.

Answer: I have moved the code that generates aprocs for an operation expression to a helper procedure. This procedure will raise and error if any of the operands of the expression is not a register or a constant.
view plainprint?
  1. (define (generate-operation-aprocs exp machine labels)  
  2.   (map (lambda (e)  
  3.          (if (or (register-exp? e) (constant-exp? e))  
  4.              (make-primitive-exp e machine labels)  
  5.              (error "Operations can only be used with registers and constants -- ASSEMBLE" e)))  
  6.        (operation-exp-operands exp)))  
  7.   
  8. (define (make-operation-exp exp machine labels operations)  
  9.   (let ((op (lookup-prim (operation-exp-op exp) operations))  
  10.         (aprocs (generate-operation-aprocs exp machine labels)))  
  11.     (lambda ()  
  12.       (apply op (map (lambda (p) (p)) aprocs)))))  

Exercise 5.10. Design a new syntax for register-machine instructions and modify the simulator to use your new syntax. Can you implement your new syntax without changing any part of the simulator except the syntax procedures in this section?

Skipping.

Exercise 5.11. When we introduced save and restore in section 5.1.4, we didn't specify what would happen if you tried to restore a register that was not the last one saved, as in the sequence
  1. (save y)  
  2. (save x)  
  3. (restore y)  

There are several reasonable possibilities for the meaning of restore:

a. (restore y) puts into y the last value saved on the stack, regardless of what register that value came from. This is the way our simulator behaves. Show how to take advantage of this behavior to eliminate one instruction from the Fibonacci machine of section 5.1.4 (figure 5.12).

b. (restore y) puts into y the last value saved on the stack, but only if that value was saved from y; otherwise, it signals an error. Modify the simulator to behave this way. You will have to change save to put the register name on the stack along with the value.

c. (restore y) puts into y the last value saved from y regardless of what other registers were saved after y and not restored. Modify the simulator to behave this way. You will have to associate a separate stack with each register. You should make the initialize-stack operation initialize all the register stacks.

Answer:
a. The first two statements under the label afterfib-n-2 perform the following actions:
1) Transfer the value of val to n. This means copying fib(n - 2) to n.
2) Restore previously saved fib(n - 1) to val.
N and val are subsequently added to yield fib(n).

These two statements can be replaced with a single restore statement. Consider executing (restore n) instead of these two statements. As fib(n - 1) was the last value restored on the stack n will be assigned the value fib(n - 1). Val already contains fib(n - 2). We can proceed to add them together and still get fib(n).

b. Save instruction has been changed to pass the register name to the stack along with its value. The stack will maintain a list of register-name/value tuples. Pop has been changed to pass the target register name as a parameter. Stack will raise an error if the target register name is not the same as the name associated with the top value in the stack.
view plainprint?
  1. (define (make-save inst machine stack pc)  
  2.   (let ((reg (get-register machine  
  3.                            (stack-inst-reg-name inst)))  
  4.         (reg-name (stack-inst-reg-name inst)))  
  5.     (lambda ()  
  6.       (push stack reg-name (get-contents reg))  
  7.       (advance-pc pc))))  
  8.   
  9. (define (push stack reg-name value)  
  10.   ((stack 'push) reg-name value))  
  11.   
  12. (define (make-restore inst machine stack pc)  
  13.   (let ((reg (get-register machine  
  14.                            (stack-inst-reg-name inst)))  
  15.         (reg-name (stack-inst-reg-name inst)))  
  16.     (lambda ()  
  17.       (set-contents! reg (pop stack reg-name))  
  18.       (advance-pc pc))))  
  19.   
  20. (define (pop stack reg-name)  
  21.   ((stack 'pop) reg-name))  
  22.   
  23. (define (make-stack)  
  24.   (let ((s '()))  
  25.     (define (push reg x)  
  26.       (set! s (cons (list reg x) s)))  
  27.     (define (pop reg)  
  28.       (if (null? s)  
  29.           (error "Empty stack -- POP")  
  30.           (let ((top (car s)))  
  31.             (cond ((eq? (car top) reg)  
  32.                    (set! s (cdr s))  
  33.                    (cadr top))  
  34.                   (else   
  35.                    (error "Register mismatch -- POP" reg (car top)))))))  
  36.     (define (initialize)  
  37.       (set! s '())  
  38.       'done)  
  39.     (define (dispatch message)  
  40.       (cond ((eq? message 'push) push)  
  41.             ((eq? message 'pop) pop)  
  42.             ((eq? message 'initialize) (initialize))  
  43.             (else (error "Unknown request -- STACK"  
  44.                          message))))  
  45.     dispatch))  

c. A new table named stack-table will maintain a list of register names and associated stacks. Allocate-register will create a new entry in this table each time a new register is allocated. Make-save will first get the appropriate stack from the machine before pushing the value in. Similarly make-restore will first retrieve the appropriate stack before popping the value.
view plainprint?
  1. (define (make-new-machine)  
  2.   (let ((pc (make-register 'pc))  
  3.         (flag (make-register 'flag))  
  4.         (stack (make-stack))  
  5.         (the-instruction-sequence '())  
  6.         (stack-table '()))  
  7.     (define (initialize-stack-table)  
  8.       (for-each (lambda (stack)  
  9.                   (stack 'initialize))  
  10.                 (map cadr stack-table)))  
  11.     (let ((the-ops  
  12.            (list (list 'initialize-stack initialize-stack-table)))  
  13.           (register-table  
  14.            (list (list 'pc pc) (list 'flag flag))))  
  15.       (define (allocate-register name)  
  16.         (if (assoc name register-table)  
  17.             (error "Multiply defined register: " name)  
  18.             (begin                
  19.               (set! register-table  
  20.                     (cons (list name (make-register name))  
  21.                           register-table))  
  22.               (allocate-stack-for-register name)))  
  23.         'register-allocated)  
  24.       (define (allocate-stack-for-register name)  
  25.         (set! stack-table  
  26.               (cons (list name (make-stack)) stack-table)))  
  27.       (define (get-register-stack name)  
  28.         (let ((record (assoc name stack-table)))  
  29.           (if record  
  30.               (cadr record)  
  31.               (error "No stack found for register" name))))  
  32.       (define (lookup-register name)  
  33.         (let ((val (assoc name register-table)))  
  34.           (if val  
  35.               (cadr val)  
  36.               (error "Unknown register:" name))))  
  37.       (define (execute)  
  38.         (let ((insts (get-contents pc)))  
  39.           (if (null? insts)  
  40.               'done  
  41.               (begin  
  42.                 ((instruction-execution-proc (car insts)))  
  43.                 (execute)))))  
  44.       (define (dispatch message)  
  45.         (cond ((eq? message 'start)  
  46.                (set-contents! pc the-instruction-sequence)  
  47.                (execute))  
  48.               ((eq? message 'install-instruction-sequence)  
  49.                (lambda (seq) (set! the-instruction-sequence seq)))  
  50.               ((eq? message 'allocate-register) allocate-register)  
  51.               ((eq? message 'get-register) lookup-register)  
  52.               ((eq? message 'install-operations)  
  53.                (lambda (ops) (set! the-ops (append the-ops ops))))  
  54.               ((eq? message 'stack) stack)  
  55.               ((eq? message 'operations) the-ops)  
  56.               ((eq? message 'get-register-stack) get-register-stack)  
  57.               (else (error "Unknown request -- MACHINE" message))))  
  58.       dispatch)))  
  59.   
  60. (define (get-register-stack machine register-name)  
  61.   ((machine 'get-register-stack) register-name))  
  62.   
  63. (define (make-save inst machine stack pc)  
  64.   (let ((reg (get-register machine (stack-inst-reg-name inst)))  
  65.         (stack (get-register-stack machine (stack-inst-reg-name inst))))  
  66.     (lambda ()  
  67.       (push stack (get-contents reg))  
  68.       (advance-pc pc))))  
  69.   
  70. (define (make-restore inst machine stack pc)  
  71.   (let ((reg (get-register machine (stack-inst-reg-name inst)))  
  72.         (stack (get-register-stack machine (stack-inst-reg-name inst))))  
  73.     (lambda ()  
  74.       (set-contents! reg (pop stack))  
  75.       (advance-pc pc))))  

Exercise 5.12. The simulator can be used to help determine the data paths required for implementing a machine with a given controller. Extend the assembler to store the following information in the machine model:

* a list of all instructions, with duplicates removed, sorted by instruction type (assign, goto, and so on);

* a list (without duplicates) of the registers used to hold entry points (these are the registers referenced by goto instructions);

* a list (without duplicates) of the registers that are saved or restored;

* for each register, a list (without duplicates) of the sources from which it is assigned (for example, the sources for register val in the factorial machine of figure 5.11 are (const 1) and ((op *) (reg n) (reg val))).

Extend the message-passing interface to the machine to provide access to this new information. To test your analyzer, define the Fibonacci machine from figure 5.12 and examine the lists you constructed.

Answer: I am not quite satisfied with the way I have answered this question. The solution looks flaky and involved too many set! operations in my opinion. If you have any suggestions about how to improve the answer let me know.
view plainprint?
  1. (define (contains? x items)  
  2.   (if (null? items)  
  3.       false  
  4.       (if (equal? x (car items))  
  5.           true  
  6.           (contains? x (cdr items)))))  
  7.   
  8. ;; Machine will store   
  9. ;; 1. A list of instructions sorted by type.  
  10. ;; 2. A list of registers used to hold entry points.  
  11. ;; 3. A list of registers that are saved or restored.  
  12. (define (make-new-machine)  
  13.   (let ((pc (make-register 'pc))  
  14.         (flag (make-register 'flag))  
  15.         (stack (make-stack))  
  16.         (the-instruction-sequence '())  
  17.         (all-instructions '())  
  18.         (entry-points '())  
  19.         (saved-or-restored '())  
  20.         (register-sources '()))          
  21.     (let ((the-ops  
  22.            (list (list 'initialize-stack  
  23.                        (lambda () (stack 'initialize)))))  
  24.           (register-table  
  25.            (list (list 'pc pc) (list 'flag flag))))  
  26.       (define (allocate-register name)  
  27.         (if (assoc name register-table)  
  28.             (error "Multiply defined register: " name)  
  29.             (set! register-table  
  30.                   (cons (list name (make-register name))  
  31.                         register-table)))  
  32.         'register-allocated)  
  33.       (define (lookup-register name)  
  34.         (let ((val (assoc name register-table)))  
  35.           (if val  
  36.               (cadr val)  
  37.               (error "Unknown register:" name))))  
  38.       (define (execute)  
  39.         (let ((insts (get-contents pc)))  
  40.           (if (null? insts)  
  41.               'done  
  42.               (begin  
  43.                 ((instruction-execution-proc (car insts)))  
  44.                 (execute)))))  
  45.       (define (dispatch message)  
  46.         (cond ((eq? message 'start)  
  47.                (set-contents! pc the-instruction-sequence)  
  48.                (execute))  
  49.               ((eq? message 'install-instruction-sequence)  
  50.                (lambda (seq) (set! the-instruction-sequence seq)))  
  51.               ((eq? message 'allocate-register) allocate-register)  
  52.               ((eq? message 'get-register) lookup-register)  
  53.               ((eq? message 'install-operations)  
  54.                (lambda (ops) (set! the-ops (append the-ops ops))))  
  55.               ((eq? message 'stack) stack)  
  56.               ((eq? message 'operations) the-ops)  
  57.               ((eq? message 'get-all-instructions)  
  58.                (for-each (lambda (record)  
  59.                            (printf "~a\n" (car record))  
  60.                            (for-each (lambda (item)  
  61.                                        (printf "\t~a\n" item))  
  62.                                      (cdr record)))  
  63.                          all-instructions))  
  64.               ((eq? message 'store-all-instructions)  
  65.                (lambda (instructions) (set! all-instructions instructions)))  
  66.               ((eq? message 'get-entry-points)   
  67.                (printf "Entry point registers:\n")  
  68.                (for-each (lambda (e) (printf "\t~a\n" e)) entry-points))  
  69.               ((eq? message 'store-entry-points)  
  70.                (lambda (items) (set! entry-points items)))  
  71.               ((eq? message 'get-saved-or-restored-registers)   
  72.                (printf "Saved or restored registers:\n")  
  73.                (for-each (lambda (r) (printf "\t~a\n" r)) saved-or-restored))  
  74.               ((eq? message 'store-saved-or-restored-registers)  
  75.                (lambda (items) (set! saved-or-restored items)))  
  76.               ((eq? message 'get-register-sources)  
  77.                (for-each (lambda (record)  
  78.                            (printf "Register: ~a\n" (car record))  
  79.                            (for-each (lambda (item)  
  80.                                        (printf "\t~a\n" item))  
  81.                                      (cdr record)))  
  82.                          register-sources))  
  83.               ((eq? message 'store-register-sources)  
  84.                (lambda (sources) (set! register-sources sources)))  
  85.               (else (error "Unknown request -- MACHINE" message))))  
  86.       dispatch)))  
  87.   
  88. (define (store-unique-instructions machine insts)  
  89.   ((machine 'store-all-instructions) insts))  
  90.   
  91. (define (get-unique-instructions machine)  
  92.   (machine 'get-all-instructions))  
  93.   
  94. (define (store-entry-points machine items)  
  95.   ((machine 'store-entry-points) items))  
  96.   
  97. (define (get-entry-points machine)  
  98.   (machine 'get-entry-points))  
  99.   
  100. (define (store-saved-or-restored-registers machine items)  
  101.   ((machine 'store-saved-or-restored-registers) items))  
  102.   
  103. (define (get-saved-or-restored-registers machine)  
  104.   (machine 'get-saved-or-restored-registers))  
  105.   
  106. (define (store-register-sources machine items)  
  107.   ((machine 'store-register-sources) items))  
  108.   
  109. (define (get-register-sources machine)  
  110.   (machine 'get-register-sources))  
  111.   
  112. ;; Assemble will call a procedure to return a unique set of instructions sorted by type.  
  113. (define (assemble controller-text machine)  
  114.   (extract-labels controller-text  
  115.     (lambda (insts labels)  
  116.       (update-insts! insts labels machine)  
  117.       (store-useful-information machine insts)  
  118.       insts)))  
  119.   
  120. (define (store-useful-information machine insts)  
  121.   (let ((unique-instructions '((assign) (branch) (goto) (perform) (restore) (save) (test)))  
  122.         (entry-points '())  
  123.         (saved-or-restored-registers '())  
  124.         (register-sources '())  
  125.         (inst-text (map instruction-text insts)))  
  126.     (define (gather-unique-instructions inst)  
  127.       (let ((record (assoc (car inst) unique-instructions)))  
  128.         (let ((items (cdr record)))  
  129.           (cond ((not (contains? inst items))  
  130.                  (set-cdr! record (cons inst items)))))))      
  131.     (define (gather-entry-points inst)  
  132.       (let ((inst-type (car inst))  
  133.             (inst-target (cadr inst)))  
  134.         (if (and (eq? inst-type 'goto)           ; GOTO instruction.  
  135.                  (register-exp? inst-target)     ; Target is a register.  
  136.                  (not (memq (register-exp-reg inst-target) entry-points)))  
  137.             (set! entry-points (cons (register-exp-reg inst-target) entry-points)))))  
  138.     (define (gather-saved-or-restored-registers inst)  
  139.       (let ((inst-type (car inst))  
  140.             (inst-target (cadr inst)))  
  141.         (if (and (or (eq? inst-type 'save)       ; Save or Restore instruction.  
  142.                      (eq? inst-type 'restore))  
  143.                  (not (memq inst-target saved-or-restored-registers)))  
  144.             (set! saved-or-restored-registers (cons inst-target saved-or-restored-registers)))))      
  145.     (define (gather-regigster-sources inst)  
  146.       (if (eq? (car inst) 'assign)               ; Assign instruction.  
  147.           (let ((register (assign-reg-name inst))  
  148.                 (source (assign-value-exp inst)))  
  149.             (let ((record (assoc register register-sources)))  
  150.               (if (and record (not (contains? source (cdr record))))  
  151.                   (let ((items (cdr record)))  
  152.                     (set-cdr! record (cons source items)))  
  153.                   (set! register-sources (cons (list register source) register-sources)))))))        
  154.     (for-each (lambda (inst)  
  155.                 (gather-unique-instructions inst)  
  156.                 (gather-entry-points inst)  
  157.                 (gather-saved-or-restored-registers inst)  
  158.                 (gather-regigster-sources inst))  
  159.               inst-text)     
  160.     (store-unique-instructions machine unique-instructions)  
  161.     (store-entry-points machine entry-points)  
  162.     (store-saved-or-restored-registers machine saved-or-restored-registers)  
  163.     (store-register-sources machine register-sources)))  

Exercise 5.13. Modify the simulator so that it uses the controller sequence to determine what registers the machine has rather than requiring a list of registers as an argument to make-machine. Instead of pre-allocating the registers in make-machine, you can allocate them one at a time when they are first seen during assembly of the instructions.

Answer:Make-machine does not require the list of registers to be explicitly passed.
view plainprint?
  1. (define (make-machine ops controller-text)  
  2.   (let ((machine (make-new-machine)))  
  3.     ((machine 'install-operations) ops)      
  4.     ((machine 'install-instruction-sequence)  
  5.      (assemble controller-text machine))  
  6.     machine))  

Update-insts will scan each instruction to find the registers used by that instruction. If that register has not already been installed update-insts will install it. Registers have to be allocated *before* installing the instruction execution procedures.
view plainprint?
  1. (define (update-insts! insts labels machine)  
  2.   (let ((pc (get-register machine 'pc))  
  3.         (flag (get-register machine 'flag))  
  4.         (stack (machine 'stack))  
  5.         (ops (machine 'operations))  
  6.         (installed-registers '()))  
  7.     (for-each  
  8.      (lambda (inst)  
  9.        (for-each (lambda (register)  
  10.                    (if (not (memq register installed-registers))  
  11.                        (begin  
  12.                          ((machine 'allocate-register) register)  
  13.                          (set! installed-registers (cons register installed-registers)))))  
  14.                  (find-registers-used (instruction-text inst)))  
  15.        (set-instruction-execution-proc!   
  16.         inst  
  17.         (make-execution-procedure  
  18.          (instruction-text inst) labels machine  
  19.          pc flag stack ops)))  
  20.      insts)))  

Find-registers-used will scan the given instruction to find the registers used.
view plainprint?
  1. (define (find-registers-used inst)  
  2.   (define (iter inst-text registers)  
  3.     (if (null? inst-text)  
  4.         registers  
  5.         (let ((first (car inst-text))  
  6.               (rest (cdr inst-text)))  
  7.           (if (and (register-exp? first) (not (memq (register-exp-reg first) registers)))  
  8.               (iter rest (cons (register-exp-reg first) registers))  
  9.               (iter rest registers)))))  
  10.   (cond ((eq? (car inst) 'assign)  
  11.          (iter (cdr inst) (list (assign-reg-name inst))))  
  12.         ((or (eq? (car inst) 'save) (eq? (car inst) 'restore))  
  13.          (list (stack-inst-reg-name inst)))  
  14.         (else  
  15.          (iter (cdr inst) '()))))  

Exercise 5.14. Measure the number of pushes and the maximum stack depth required to compute n! for various small values of n using the factorial machine shown in figure 5.11. From your data determine formulas in terms of n for the total number of push operations and the maximum stack depth used in computing n! for any n > 1. Note that each of these is a linear function of n and is thus determined by two constants. In order to get the statistics printed, you will have to augment the factorial machine with instructions to initialize the stack and print the statistics. You may want to also modify the machine so that it repeatedly reads a value for n, computes the factorial, and prints the result (as we did for the GCD machine in figure 5.4), so that you will not have to repeatedly invoke get-register-contents, set-register-contents!, and start.

Answer:
view plainprint?
  1. ;; Test setup  
  2. (define fact-machine  
  3.   (make-machine  
  4.    '(n val continue)  
  5.    (list (list 'read read) (list '- -) (list '* *) (list '= =) (list 'print printf))  
  6.    '(controller  
  7.      init  
  8.        (assign continue (label fact-done))     ; set up final return address  
  9.        (assign n (op read))  
  10.      fact-loop  
  11.        (test (op =) (reg n) (const 1))  
  12.        (branch (label base-case))  
  13.        ;; Set up for the recursive call by saving n and continue.  
  14.        ;; Set up continue so that the computation will continue  
  15.        ;; at after-fact when the subroutine returns.  
  16.        (save continue)  
  17.        (save n)  
  18.        (assign n (op -) (reg n) (const 1))  
  19.        (assign continue (label after-fact))  
  20.        (goto (label fact-loop))  
  21.      after-fact  
  22.        (restore n)  
  23.        (restore continue)  
  24.        (assign val (op *) (reg n) (reg val))   ; val now contains n(n - 1)!  
  25.        (goto (reg continue))                   ; return to caller  
  26.      base-case  
  27.        (assign val (const 1))                  ; base case: 1! = 1  
  28.        (goto (reg continue))                   ; return to caller  
  29.      fact-done  
  30.        (perform (op print) (const "Factorial:~a\n") (reg val))  
  31.        (perform (op print-stack-statistics))  
  32.        (perform (op initialize-stack))  
  33.        (goto (label init)))))  
  34.   
  35. (start fact-machine)  
  36.   
  37. ;; Results  
  38. ;; n  - total pushes - max depth  
  39. ;; 2  - 2            - 2    
  40. ;; 3  - 4            - 4  
  41. ;; 4  - 6            - 6  
  42. ;; 5  - 8            - 8  
  43. ;; 6  - 10           - 10  
  44. ;; 7  - 12           - 12  
  45. ;; 8  - 14           - 14  
  46. ;; 9  - 16           - 16  
  47. ;; 10 - 18           - 18  

The total number of pushes and max depth of the stack for calculating n! is given by the formula 2(n - 1).

Exercise 5.15. Add instruction counting to the register machine simulation. That is, have the machine model keep track of the number of instructions executed. Extend the machine model's interface to accept a new message that prints the value of the instruction count and resets the count to zero.

Answer:
view plainprint?
  1. (define (make-new-machine)  
  2.   (let ((pc (make-register 'pc))  
  3.         (flag (make-register 'flag))  
  4.         (stack (make-stack))  
  5.         (the-instruction-sequence '())  
  6.         (instruction-count 0))  
  7.     (let ((the-ops  
  8.            (list (list 'initialize-stack  
  9.                        (lambda () (stack 'initialize)))))  
  10.           (register-table  
  11.            (list (list 'pc pc) (list 'flag flag))))  
  12.       (define (allocate-register name)  
  13.         (if (assoc name register-table)  
  14.             (error "Multiply defined register: " name)  
  15.             (set! register-table  
  16.                   (cons (list name (make-register name))  
  17.                         register-table)))  
  18.         'register-allocated)  
  19.       (define (lookup-register name)  
  20.         (let ((val (assoc name register-table)))  
  21.           (if val  
  22.               (cadr val)  
  23.               (error "Unknown register:" name))))  
  24.       (define (execute)  
  25.         (let ((insts (get-contents pc)))  
  26.           (if (null? insts)  
  27.               'done  
  28.               (begin  
  29.                 ((instruction-execution-proc (car insts)))  
  30.                 (set! instruction-count (+ instruction-count 1))  
  31.                 (execute)))))  
  32.       (define (dispatch message)  
  33.         (cond ((eq? message 'start)  
  34.                (set-contents! pc the-instruction-sequence)  
  35.                (execute))  
  36.               ((eq? message 'install-instruction-sequence)  
  37.                (lambda (seq) (set! the-instruction-sequence seq)))  
  38.               ((eq? message 'allocate-register) allocate-register)  
  39.               ((eq? message 'get-register) lookup-register)  
  40.               ((eq? message 'install-operations)  
  41.                (lambda (ops) (set! the-ops (append the-ops ops))))  
  42.               ((eq? message 'stack) stack)  
  43.               ((eq? message 'operations) the-ops)  
  44.               ((eq? message 'instruction-count) instruction-count)  
  45.               ((eq? message 'reset-instruction-count)  
  46.                (set! instruction-count 0))  
  47.               (else (error "Unknown request -- MACHINE" message))))  
  48.       dispatch)))  
  49.   
  50. (define (get-instruction-count machine)  
  51.   (machine 'instruction-count))  
  52.   
  53. (define (reset-instruction-count machine)  
  54.   (machine 'reset-instruction-count))  

Exercise 5.16. Augment the simulator to provide for instruction tracing. That is, before each instruction is executed, the simulator should print the text of the instruction. Make the machine model accept trace-on and trace-off messages to turn tracing on and off.

Answer:
view plainprint?
  1. (define (make-new-machine)  
  2.   (let ((pc (make-register 'pc))  
  3.         (flag (make-register 'flag))  
  4.         (stack (make-stack))  
  5.         (the-instruction-sequence '())  
  6.         (instruction-count 0)  
  7.         (tracing false))  
  8.     (let ((the-ops  
  9.            (list (list 'initialize-stack  
  10.                        (lambda () (stack 'initialize)))))  
  11.           (register-table  
  12.            (list (list 'pc pc) (list 'flag flag))))  
  13.       (define (allocate-register name)  
  14.         (if (assoc name register-table)  
  15.             (error "Multiply defined register: " name)  
  16.             (set! register-table  
  17.                   (cons (list name (make-register name))  
  18.                         register-table)))  
  19.         'register-allocated)  
  20.       (define (lookup-register name)  
  21.         (let ((val (assoc name register-table)))  
  22.           (if val  
  23.               (cadr val)  
  24.               (error "Unknown register:" name))))  
  25.       (define (execute)  
  26.         (let ((insts (get-contents pc)))  
  27.           (if (null? insts)  
  28.               'done  
  29.               (let ((inst (car insts)))  
  30.                 (if tracing  
  31.                     (begin (display (instruction-text inst))  
  32.                            (newline)))  
  33.                 (set! instruction-count (+ instruction-count 1))  
  34.                 ((instruction-execution-proc inst))  
  35.                 (execute)))))  
  36.       (define (dispatch message)  
  37.         (cond ((eq? message 'start)  
  38.                (set-contents! pc the-instruction-sequence)  
  39.                (execute))  
  40.               ((eq? message 'install-instruction-sequence)  
  41.                (lambda (seq) (set! the-instruction-sequence seq)))  
  42.               ((eq? message 'allocate-register) allocate-register)  
  43.               ((eq? message 'get-register) lookup-register)  
  44.               ((eq? message 'install-operations)  
  45.                (lambda (ops) (set! the-ops (append the-ops ops))))  
  46.               ((eq? message 'stack) stack)  
  47.               ((eq? message 'operations) the-ops)  
  48.               ((eq? message 'instruction-count) instruction-count)  
  49.               ((eq? message 'reset-instruction-count) (set! instruction-count 0))  
  50.               ((eq? message 'trace-on) (set! tracing true))  
  51.               ((eq? message 'trace-off) (set! tracing false))                
  52.               (else (error "Unknown request -- MACHINE" message))))  
  53.       dispatch)))  
  54.   
  55. (define (set-trace-on machine)  
  56.   (machine 'trace-on))  
  57.   
  58. (define (set-trace-off machine)  
  59.   (machine 'trace-off))  

Exercise 5.17. Extend the instruction tracing of exercise 5.16 so that before printing an instruction, the simulator prints any labels that immediately precede that instruction in the controller sequence. Be careful to do this in a way that does not interfere with instruction counting (exercise 5.15). You will have to make the simulator retain the necessary label information.

Answer: Extract-labels will include labels as part of instructions.
view plainprint?
  1. (define (extract-labels text receive)  
  2.   (if (null? text)  
  3.       (receive '() '())  
  4.       (extract-labels (cdr text)  
  5.        (lambda (insts labels)  
  6.          (let ((next-inst (car text)))  
  7.            (if (symbol? next-inst)  
  8.                (let ((new-insts (cons (cons next-inst '()) insts)))  
  9.                  (receive new-insts  
  10.                           (cons (make-label-entry next-inst  
  11.                                                   new-insts)  
  12.                                 labels)))  
  13.                (receive (cons (make-instruction next-inst)  
  14.                               insts)  
  15.                         labels)))))))  

Make-execution-procedure will create a special execution procedure for labels. These procedures will advance the program counter (pc) and return the name of the label.
view plainprint?
  1. (define (make-execution-procedure inst labels machine  
  2.                                   pc flag stack ops)  
  3.   (cond ((not (pair? inst))   
  4.          (make-label-exec-proc inst pc))  
  5.         ((eq? (car inst) 'assign)  
  6.          (make-assign inst machine labels ops pc))  
  7.         ((eq? (car inst) 'test)  
  8.          (make-test inst machine labels ops flag pc))  
  9.         ((eq? (car inst) 'branch)  
  10.          (make-branch inst machine labels flag pc))  
  11.         ((eq? (car inst) 'goto)  
  12.          (make-goto inst machine labels pc))  
  13.         ((eq? (car inst) 'save)  
  14.          (make-save inst machine stack pc))  
  15.         ((eq? (car inst) 'restore)  
  16.          (make-restore inst machine stack pc))  
  17.         ((eq? (car inst) 'perform)  
  18.          (make-perform inst machine labels ops pc))  
  19.         (else (error "Unknown instruction type -- ASSEMBLE"  
  20.                      inst))))  
  21.   
  22. (define (make-label-exec-proc inst pc)  
  23.   (lambda ()  
  24.     (advance-pc pc)  
  25.     inst))  

Machine with tracing and counting. Count is not incremented if the instruction being executed is a label.
view plainprint?
  1. (define (make-new-machine)  
  2.   (let ((pc (make-register 'pc))  
  3.         (flag (make-register 'flag))  
  4.         (stack (make-stack))  
  5.         (the-instruction-sequence '())  
  6.         (instruction-count 0)  
  7.         (tracing false))  
  8.     (let ((the-ops  
  9.            (list (list 'initialize-stack  
  10.                        (lambda () (stack 'initialize)))))  
  11.           (register-table  
  12.            (list (list 'pc pc) (list 'flag flag))))  
  13.       (define (allocate-register name)  
  14.         (if (assoc name register-table)  
  15.             (error "Multiply defined register: " name)  
  16.             (set! register-table  
  17.                   (cons (list name (make-register name))  
  18.                         register-table)))  
  19.         'register-allocated)  
  20.       (define (lookup-register name)  
  21.         (let ((val (assoc name register-table)))  
  22.           (if val  
  23.               (cadr val)  
  24.               (error "Unknown register:" name))))  
  25.       (define (execute)  
  26.         (let ((insts (get-contents pc)))  
  27.           (if (null? insts)  
  28.               'done  
  29.               (let ((inst (car insts)))  
  30.                 (if tracing  
  31.                     (begin (display (instruction-text inst))  
  32.                            (newline)))  
  33.                 (if (pair? (car inst)) ;; Not a label.  
  34.                     (set! instruction-count (+ instruction-count 1)))  
  35.                 ((instruction-execution-proc inst))  
  36.                 (execute)))))  
  37.       (define (dispatch message)  
  38.         (cond ((eq? message 'start)  
  39.                (set-contents! pc the-instruction-sequence)  
  40.                (execute))  
  41.               ((eq? message 'install-instruction-sequence)  
  42.                (lambda (seq) (set! the-instruction-sequence seq)))  
  43.               ((eq? message 'allocate-register) allocate-register)  
  44.               ((eq? message 'get-register) lookup-register)  
  45.               ((eq? message 'install-operations)  
  46.                (lambda (ops) (set! the-ops (append the-ops ops))))  
  47.               ((eq? message 'stack) stack)  
  48.               ((eq? message 'operations) the-ops)  
  49.               ((eq? message 'instruction-count) instruction-count)  
  50.               ((eq? message 'reset-instruction-count) (set! instruction-count 0))  
  51.               ((eq? message 'trace-on) (set! tracing true))  
  52.               ((eq? message 'trace-off) (set! tracing false))                
  53.               (else (error "Unknown request -- MACHINE" message))))  
  54.       dispatch)))  
  55.   
  56. (define (get-instruction-count machine)  
  57.   (machine 'instruction-count))  
  58.   
  59. (define (reset-instruction-count machine)  
  60.   (machine 'reset-instruction-count))  
  61.   
  62. (define (set-trace-on machine)  
  63.   (machine 'trace-on))  
  64.   
  65. (define (set-trace-off machine)  
  66.   (machine 'trace-off))  

Exercise 5.18. Modify the make-register procedure of section 5.2.1 so that registers can be traced. Registers should accept messages that turn tracing on and off. When a register is traced, assigning a value to the register should print the name of the register, the old contents of the register, and the new contents being assigned. Extend the interface to the machine model to permit you to turn tracing on and off for designated machine registers.

Answer:
view plainprint?
  1. (define (make-register name)  
  2.   (let ((contents '*unassigned*)  
  3.         (tracing false))  
  4.     (define (set value)  
  5.       (if tracing   
  6.           (printf "~a ~a ~a\n" name contents value))  
  7.       (set! contents value))        
  8.     (define (dispatch message)  
  9.       (cond ((eq? message 'get) contents)  
  10.             ((eq? message 'set) set)  
  11.             ((eq? message 'trace-on) (set! tracing true))  
  12.             ((eq? message 'trace-off) (set! tracing false))  
  13.             (else  
  14.              (error "Unknown request -- REGISTER" message))))  
  15.     dispatch))  
  16.   
  17. (define (make-new-machine)  
  18.   (let ((pc (make-register 'pc))  
  19.         (flag (make-register 'flag))  
  20.         (stack (make-stack))  
  21.         (the-instruction-sequence '())  
  22.         (instruction-count 0)  
  23.         (tracing false))  
  24.     (let ((the-ops  
  25.            (list (list 'initialize-stack  
  26.                        (lambda () (stack 'initialize)))))  
  27.           (register-table  
  28.            (list (list 'pc pc) (list 'flag flag))))  
  29.       (define (allocate-register name)  
  30.         (if (assoc name register-table)  
  31.             (error "Multiply defined register: " name)  
  32.             (set! register-table  
  33.                   (cons (list name (make-register name))  
  34.                         register-table)))  
  35.         'register-allocated)  
  36.       (define (lookup-register name)  
  37.         (let ((val (assoc name register-table)))  
  38.           (if val  
  39.               (cadr val)  
  40.               (error "Unknown register:" name))))  
  41.       (define (execute)  
  42.         (let ((insts (get-contents pc)))  
  43.           (if (null? insts)  
  44.               'done  
  45.               (let ((inst (car insts)))  
  46.                 (if tracing  
  47.                     (begin (display (instruction-text inst))  
  48.                            (newline)))  
  49.                 (if (pair? (car inst)) ;; Not a label.  
  50.                     (set! instruction-count (+ instruction-count 1)))  
  51.                 ((instruction-execution-proc inst))  
  52.                 (execute)))))  
  53.       (define (dispatch message)  
  54.         (cond ((eq? message 'start)  
  55.                (set-contents! pc the-instruction-sequence)  
  56.                (execute))  
  57.               ((eq? message 'install-instruction-sequence)  
  58.                (lambda (seq) (set! the-instruction-sequence seq)))  
  59.               ((eq? message 'allocate-register) allocate-register)  
  60.               ((eq? message 'get-register) lookup-register)  
  61.               ((eq? message 'install-operations)  
  62.                (lambda (ops) (set! the-ops (append the-ops ops))))  
  63.               ((eq? message 'stack) stack)  
  64.               ((eq? message 'operations) the-ops)  
  65.               ((eq? message 'instruction-count) instruction-count)  
  66.               ((eq? message 'reset-instruction-count) (set! instruction-count 0))  
  67.               ((eq? message 'trace-on) (set! tracing true))  
  68.               ((eq? message 'trace-off) (set! tracing false))                
  69.               ((eq? message 'reg-trace-on)  
  70.                (lambda (reg-name) ((lookup-register reg-name) 'trace-on)))  
  71.               ((eq? message 'reg-trace-off)  
  72.                (lambda (reg-name) ((lookup-register reg-name) 'trace-off)))  
  73.               (else (error "Unknown request -- MACHINE" message))))  
  74.       dispatch)))  
  75.   
  76. (define (set-reg-trace-on machine reg-name)  
  77.   ((machine 'reg-trace-on) reg-name))  
  78.   
  79. (define (set-reg-trace-off machine reg-name)  
  80.   ((machine 'reg-trace-off) reg-name))  

Exercise 5.19. Alyssa P. Hacker wants a breakpoint feature in the simulator to help her debug her machine designs. You have been hired to install this feature for her. She wants to be able to specify a place in the controller sequence where the simulator will stop and allow her to examine the state of the machine. You are to implement a procedure
view plainprint?
  1. (set-breakpoint <machine> <label> <n>)  

that sets a breakpoint just before the nth instruction after the given label. For example,
view plainprint?
  1. (set-breakpoint gcd-machine 'test-b 4)  

installs a breakpoint in gcd-machine just before the assignment to register a. When the simulator reaches the breakpoint it should print the label and the offset of the breakpoint and stop executing instructions. Alyssa can then use get-register-contents and set-register-contents! to manipulate the state of the simulated machine. She should then be able to continue execution by saying
  1. (proceed-machine <machine>)  

She should also be able to remove a specific breakpoint by means of
  1. (cancel-breakpoint <machine> <label> <n>)  

or to remove all breakpoints by means of
  1. (cancel-all-breakpoints <machine>)  


Answer: I had a LOT of fun doing this exercise. Sure it took time and I messed up in between. But in the end it was worth the time and energy spent. I present, my first "debugger" :)
view plainprint?
  1. (define (remove-from-list element items)  
  2.     (filter (lambda (x) (not (eq? x element))) items))  
  3.   
  4. (define (make-new-machine)  
  5.   (let ((pc (make-register 'pc))  
  6.         (flag (make-register 'flag))  
  7.         (stack (make-stack))  
  8.         (the-instruction-sequence '())  
  9.         (instruction-count 0)  
  10.         (tracing false)  
  11.         (breakpoints '())  
  12.         (current-label '*unassigned*)  
  13.         (line-number 0))  
  14.     (let ((the-ops  
  15.            (list (list 'initialize-stack  
  16.                        (lambda () (stack 'initialize)))))  
  17.           (register-table  
  18.            (list (list 'pc pc) (list 'flag flag))))  
  19.       (define (allocate-register name)  
  20.         (if (assoc name register-table)  
  21.             (error "Multiply defined register: " name)  
  22.             (set! register-table  
  23.                   (cons (list name (make-register name))  
  24.                         register-table)))  
  25.         'register-allocated)  
  26.       (define (lookup-register name)  
  27.         (let ((val (assoc name register-table)))  
  28.           (if val  
  29.               (cadr val)  
  30.               (error "Unknown register:" name))))  
  31.       (define (execute)  
  32.         (let ((insts (get-contents pc)))  
  33.           (if (null? insts)  
  34.               'done  
  35.               (let ((inst (car insts)))  
  36.                 (if tracing  
  37.                     (printf "~a\n" (instruction-text inst)))  
  38.                   
  39.                 (cond ((pair? (car inst))                    ; Not a label inst.  
  40.                        (set! line-number (+ line-number 1))) ; Increment line number                  
  41.                       (else                                  ; Is a label inst.  
  42.                        (set! current-label (car inst))       ; Store the current label name  
  43.                        (set! line-number 0)))                ; Reset the line number  
  44.                   
  45.                 ; Check if there is a breakpoint matching the current label name and line number.  
  46.                 (let ((bp (assoc current-label breakpoints)))  
  47.                   (cond ((and bp (memq line-number (cdr bp)))  
  48.                          (printf "Breakpoint reached ~a ~a About to execute: ~a\n"   
  49.                                  current-label line-number (instruction-text inst)))  
  50.                         (else  
  51.                          (if (pair? (car inst))  
  52.                              (set! instruction-count (+ instruction-count 1)))  
  53.                          ((instruction-execution-proc inst))  
  54.                          (execute))))))))  
  55.       (define (dispatch message)  
  56.         (cond ((eq? message 'start)  
  57.                (set-contents! pc the-instruction-sequence)  
  58.                (execute))  
  59.               ((eq? message 'install-instruction-sequence)  
  60.                (lambda (seq) (set! the-instruction-sequence seq)))  
  61.               ((eq? message 'allocate-register) allocate-register)  
  62.               ((eq? message 'get-register) lookup-register)  
  63.               ((eq? message 'install-operations)  
  64.                (lambda (ops) (set! the-ops (append the-ops ops))))  
  65.               ((eq? message 'stack) stack)  
  66.               ((eq? message 'operations) the-ops)  
  67.               ((eq? message 'instruction-count) instruction-count)  
  68.               ((eq? message 'reset-instruction-count) (set! instruction-count 0))  
  69.               ((eq? message 'trace-on) (set! tracing true))  
  70.               ((eq? message 'trace-off) (set! tracing false))                
  71.               ((eq? message 'reg-trace-on)  
  72.                (lambda (reg-name) ((lookup-register reg-name) 'trace-on)))  
  73.               ((eq? message 'reg-trace-off)  
  74.                (lambda (reg-name) ((lookup-register reg-name) 'trace-off)))  
  75.               ((eq? message 'set-breakpoint)  
  76.                (lambda (label n)  
  77.                  (let ((bp (assoc label breakpoints)))  
  78.                    (cond (bp  ; Label is already present in breakpoints. Add line number to list.  
  79.                           (let ((line-numbers (cdr bp)))  
  80.                             (if (memq n line-numbers)  
  81.                                 (error "Breakpoint exists -- MACHINE" label n)  
  82.                                 (set-cdr! bp (cons n line-numbers)))))  
  83.                          (else  
  84.                           (set! breakpoints (cons (list label n) breakpoints)))))))               
  85.               ((eq? message 'cancel-breakpoint)  
  86.                (lambda (label n)  
  87.                  (let ((bp (assoc label breakpoints)))  
  88.                    (cond (bp   
  89.                           (let ((line-numbers (cdr bp)))  
  90.                             (if (memq n line-numbers)  
  91.                                 (set-cdr! bp (remove-from-list n line-numbers))  
  92.                                 (error "Missing breakpoint -- MACHINE" label n))))  
  93.                          (else  
  94.                           (error "Missing breakpoint -- MACHINE" label n))))))  
  95.               ((eq? message 'cancel-all-breakpoints)  
  96.                (set! breakpoints '()))  
  97.               ((eq? message 'proceed-machine)  
  98.                (execute))  
  99.               (else (error "Unknown request -- MACHINE" message))))  
  100.       dispatch)))  
  101.   
  102. (define (set-breakpoint machine label n)  
  103.   ((machine 'set-breakpoint) label n))  
  104.   
  105. (define (cancel-breakpoint machine label n)  
  106.   ((machine 'cancel-breakpoint) label n))  
  107.   
  108. (define (cancel-all-breakpoints machine)  
  109.   (machine 'cancel-all-breakpoints))  
  110.   
  111. (define (proceed-machine machine)  
  112.   (machine 'proceed-machine))  

Posted by Manoj Govindan at 2:26 PM 1 comments
Labels: ,
Subscribe to: Posts (Atom)