From 393e20412350432092c4dfe7c0659912ea82a27a Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Tue, 21 Apr 2009 01:33:39 -0400 Subject: [PATCH] Major bugfix (subtraction) and changes (movff, literal operations). Fixed a long-standing (was there from the beginning) but recently discovered bug with subtraction: depending on register allocation, arguments could be swapped during code generation, which broke the semantics of subtraction. Argument order is now preserved, and subtraction now works as intended. In order to do that, movff was needed. movff support was therefore added to the simulator. It is not yet fully integrated to the register allocation (values can be kept in wreg a little bit longer, which can save some extra moves). Literals as first arguments of operators (with variables as second) now work even with non-commutative operators (the subtraction bug was discovered while testing this). --- cfg.scm | 66 ++++++++++++++++++++++++++++------------------------- code-generation.scm | 36 +++++++++++++++++++++++------ parser.scm | 3 ++- pic18-sim.scm | 16 +++++++++---- 4 files changed, 78 insertions(+), 43 deletions(-) diff --git a/cfg.scm b/cfg.scm index f69f81e..1d4c0b1 100644 --- a/cfg.scm +++ b/cfg.scm @@ -491,6 +491,7 @@ (let ((type (expr-type ast)) (value (expression ast))) ;; since nonzero is true, we must swap the destinations to use == + ;; TODO use int->value ? the padding is done automatically later on... (test-value 'x==y value (int->value 0 type) bb-false bb-true))) ;; TODO should probably call test-relation, instead, no shortcuts (cond ((oper? ast) @@ -706,37 +707,40 @@ (case id ((x+y x-y x*y x/y x%y x&y |x\|y| x^y) (let* ((x (subast1 ast)) - (y (subast2 ast))) ;; TODO where is the case of 2 literals found ? - ;; only the second argument can be a literal TODO don't forget the case where both are - (if (literal? x) - (let ((tmp x)) - (set! x y) - (set! y tmp) - (if (memq id '(x-y x/y x%y)) - ;; the operation is not commutative, a simple - ;; swap would give the wrong result - (error "a literal as first argument of a non-commutative operation is not supported")))) ;; TODO fix this - (let* ((value-x (expression x)) - (value-y (expression y))) - (let* ((ext-value-x (extend value-x type)) - (ext-value-y (extend value-y type))) - (let ((result (alloc-value type))) - (cond ((or (eq? id 'x+y) - (eq? id 'x-y)) - (add-sub id ext-value-x ext-value-y result)) - ((eq? id 'x*y) - ;; the asts of x and y must be used, since mul - ;; calls call - (mul x y type result)) - ((eq? id 'x/y) - (error "division not implemented yet")) ;; TODO implement these - ((eq? id 'x%y) - (error "modulo not implemented yet")) - ((or (eq? id 'x&y) - (eq? id '|x\|y|) - (eq? id 'x^y)) - (bitwise id ext-value-x ext-value-y result))) - result))))) + (y (subast2 ast))) + ;; TODO use the extend function to do the padding, instead of doing it ad hoc everywhere + (let* ((value-x (extend (expression x) type)) + (value-y (extend (expression y) type))) + ;; unless both arguments are literals, only the second can + ;; be one + (if (and (literal? x) (not (literal? y))) + (if (memq id '(x+y x*y x&y |x\|y| x^y)) + ;; the operator is commutative, we can swap the args + (let ((tmp value-x)) + (set! value-x value-y) + (set! value-y tmp)) + ;; the operator is not commutative, we have to + ;; allocate the first argument somewhere + (let ((dest (alloc-value (expr-type x)))) + (move-value value-x dest) + (set! value-x dest)))) + (let ((result (alloc-value type))) + (cond ((or (eq? id 'x+y) ;; TODO why not case here ? + (eq? id 'x-y)) + (add-sub id value-x value-y result)) + ((eq? id 'x*y) + ;; the asts of x and y must be used, since mul + ;; calls call + (mul x y type result)) + ((eq? id 'x/y) + (error "division not implemented yet")) ;; TODO implement these + ((eq? id 'x%y) + (error "modulo not implemented yet")) + ((or (eq? id 'x&y) + (eq? id '|x\|y|) + (eq? id 'x^y)) + (bitwise id value-x value-y result))) + result)))) ((x=y) (let* ((x (subast1 ast)) (y (subast2 ast)) diff --git a/code-generation.scm b/code-generation.scm index 5faae08..421217e 100644 --- a/code-generation.scm +++ b/code-generation.scm @@ -229,10 +229,11 @@ ((= dst WREG) (movfw src)) (else - (movfw src) - (movwf dst) - ;(movff src dst) ; takes 2 cycles (as much as movfw src ; movwf dst), but takes only 1 instruction TODO not implemented in the simulator - ))) +;; (movfw src) +;; (movwf dst) + ;; takes 2 cycles (as much as movfw src ; movwf dst), but takes + ;; only 1 instruction + (movff src dst)))) (define (bb-linearize bb) (let ((label-num (bb-label-num bb))) @@ -302,9 +303,24 @@ (let ((x (byte-cell-adr src1)) (y (byte-cell-adr src2)) (z (byte-cell-adr dst))) - (cond ((and (not (= x y)) (= y z)) + (cond ((and (not (= x y)) + (= y z) + (memq (instr-id instr) + '(add addc))) + ;; since this basically swaps the + ;; arguments, it can't be used for + ;; subtraction (move-reg x WREG)) - (else + ((and (not (= x y)) + (= y z)) + ;; for subtraction, preserves argument + ;; order + (move-reg y WREG) + ;; this NEEDS to be done with movff, or + ;; else wreg will get clobbered and this + ;; won't work + (move-reg x z)) + (else ;; TODO check if it could be merged with the previous case (move-reg x z) (move-reg y WREG))) (case (instr-id instr) @@ -316,18 +332,24 @@ ((mul) ; 8 by 8 multiplication (if (byte-lit? src2) + ;; since multiplication is commutative, the + ;; arguments are set up so the second one will + ;; be a literal if the operator is applied on a + ;; literal and a variable (let ((n (byte-lit-val src2))) (if (byte-lit? src1) ;; TODO will probably never be called with literals, since it's always inside a function (movlw (byte-lit-val src1)) (movereg (byte-cell-adr src1) WREG)) ;; literal multiplication (mullw n)) - (let ((x (byte-cell-adr src1)) ;; TODO how to be sure that we can't get the case of the 1st arg being a literal, but not the 2nd ? + (let ((x (byte-cell-adr src1)) (y (byte-cell-adr src2))) (move-reg x WREG) (mulwf y)))) ((and ior xor) ;; TODO similar to add sub and co, except that I removed the literal part + ;; no instructions for bitwise operations involving + ;; literals exist on the PIC18 (let ((x (if (byte-lit? src1) (byte-lit-val src1) (byte-cell-adr src1))) diff --git a/parser.scm b/parser.scm index 534aa5f..7ad7085 100644 --- a/parser.scm +++ b/parser.scm @@ -313,7 +313,7 @@ (cont (new-for (list ast1 (or ast2 - (new-literal 'int 1)) + (new-literal 'byte 1)) (or ast3 (new-block '())) ast4)) @@ -384,6 +384,7 @@ (define (literal source cte cont) (let ((n (cadr source))) + ;; TODO might need to be expanded (cont (new-literal (cond ((and (>= n 0) (< n 256)) 'byte) ((and (>= n 0) (< n 65536)) diff --git a/pic18-sim.scm b/pic18-sim.scm index c381d11..f975dd8 100644 --- a/pic18-sim.scm +++ b/pic18-sim.scm @@ -521,10 +521,18 @@ (decode-opcode #b1100 12 (lambda (opcode) - '(byte-to-byte "movff") - (byte-oriented opcode "movff" 'none - (lambda (f) - f)))) ;; TODO doesn't work + (let* ((src (bitwise-and opcode #xfff)) + ;; the destination is in the second 16-bit part, need to fetch + (dst (bitwise-and (get-program-mem) #xfff))) + (if trace-instr + (print (list (last-pc) " movff " + (let ((x (assv src file-reg-names))) + (if x (cdr x) (list "0x" (number->string src 16)))) + ", " + (let ((x (assv dst file-reg-names))) + (if x (cdr x) (list "0x" (number->string dst 16)))) ;; TODO printing 2 args ruins the formatting + ""))) + (set-ram dst (get-ram src))))) (decode-opcode #b0110111 9 (lambda (opcode) -- 2.11.4.GIT