fixed bug in juggle-operands: I was computing n much too early.

This commit is contained in:
Danny Yoo 2011-03-10 14:52:36 -05:00
parent 634e23daa8
commit 4a60a852e7

View File

@ -348,15 +348,13 @@
;; Installs the operators. At the end of this, ;; Installs the operators. At the end of this,
;; the procedure lives in 'proc, and the operands on the environment stack. ;; the procedure lives in 'proc, and the operands on the environment stack.
(define (juggle-operands operand-codes) (define (juggle-operands operand-codes)
(let: ([n : Natural (let: loop : InstructionSequence ([ops : (Listof InstructionSequence) operand-codes])
;; defensive coding: the operand codes should be nonempty. (cond
(ensure-natural (sub1 (length operand-codes)))]) ;; If there are no operands, no need to juggle.
(let: loop : InstructionSequence ([ops : (Listof InstructionSequence) operand-codes]) [(null? ops)
(cond (make-instruction-sequence empty)]
;; If there are no operands, no need to juggle. [(null? (rest ops))
[(null? ops) (let: ([n : Natural (ensure-natural (sub1 (length operand-codes)))])
(make-instruction-sequence empty)]
[(null? (rest ops))
;; The last operand needs to be handled specially: it currently lives in ;; The last operand needs to be handled specially: it currently lives in
;; val. We move the procedure at env[n] over to proc, and move the ;; val. We move the procedure at env[n] over to proc, and move the
;; last operand at 'val into env[n]. ;; last operand at 'val into env[n].
@ -366,11 +364,11 @@
`(,(make-AssignImmediateStatement 'proc `(,(make-AssignImmediateStatement 'proc
(make-EnvLexicalReference n)) (make-EnvLexicalReference n))
,(make-AssignImmediateStatement (make-EnvLexicalReference n) ,(make-AssignImmediateStatement (make-EnvLexicalReference n)
(make-Reg 'val)))))] (make-Reg 'val))))))]
[else [else
;; Otherwise, add instructions to juggle the operator and operands in the stack. ;; Otherwise, add instructions to juggle the operator and operands in the stack.
(append-instruction-sequences (car ops) (append-instruction-sequences (car ops)
(loop (rest ops)))])))) (loop (rest ops)))])))