From 235450c98e7da0509b7bc9fc4e8e8bfab3ece067 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 2 Sep 2009 20:37:14 -0400 Subject: [PATCH] New version of the assembler, that does better branch generation. A couple of last minute hacks. --- asm.scm | 137 +++++++++++++++++++++++++++++----------------------- code-generation.scm | 48 +++++++++++++++--- six-comp.scm | 6 +-- 3 files changed, 120 insertions(+), 71 deletions(-) diff --git a/asm.scm b/asm.scm index b1d2d8c..485a496 100644 --- a/asm.scm +++ b/asm.scm @@ -2,7 +2,7 @@ ;;; ;;; This module implements the generic assembler. -;(##declare (standard-bindings) (fixnum) (block)) +;;(##declare (standard-bindings) (fixnum) (block)) (define compiler-internal-error error) @@ -85,8 +85,8 @@ ;; The argument "id" gives a name to the label (not necessarily ;; unique) and is only needed for debugging purposes. -(define (asm-make-label id #!optional (pos #f)) - (vector 'LABEL pos id)) +(define (asm-make-label id) + (vector 'LABEL #f id)) ;; (asm-label label-obj) sets the label to the current position in the ;; code stream. @@ -194,7 +194,7 @@ ;; (asm-32 (- (asm-label-pos x) self)))) (define (asm-at-assembly . procs) - (asm-code-extend (vector 'DEFERRED procs))) + (asm-code-extend (vector 'DEFERRED procs 0))) ;; (asm-listing text) adds text to the right side of the listing. ;; The atoms in "text" will be output using "display" (lists are @@ -212,68 +212,83 @@ ;; "asm-at-assembly" are called, the code stream will have to be ;; assembled once more. -(define symbol-table (make-table)) ; associates addresses to labels (define (asm-assemble) (let ((fixup-lst (asm-pass1))) (let loop1 () (let loop2 ((lst fixup-lst) - (changed? #f) (pos asm-start-pos)) - (if (null? lst) - (if changed? (loop1)) - (let* ((fixup (car lst)) - (pos (+ pos (car fixup))) - (curr (cdr fixup)) - (x (car curr))) - (if (eq? (vector-ref x 0) 'LABEL) - ;; LABEL - (if (= (vector-ref x 1) pos) - (loop2 (cdr lst) changed? pos) - (begin - (table-set! symbol-table pos (asm-label-id x)) - (vector-set! x 1 pos) - (loop2 (cdr lst) #t pos))) - ;; DEFERRED - (let loop3 () - (let ((n ((car (vector-ref x 1)) pos))) - (if n - (loop2 (cdr lst) changed? (+ pos n)) - (begin - (vector-set! x 1 (cddr (vector-ref x 1))) - (loop3)))))))))) - - (let loop4 ((prev asm-code-stream) + (if (pair? lst) + (let* ((fixup (car lst)) + (pos (+ pos (car fixup))) + (curr (cdr fixup)) + (x (car curr))) + (if (eq? (vector-ref x 0) 'LABEL) + ;; LABEL + (loop2 (cdr lst) pos) + ;; DEFERRED + (let ((old-size (vector-ref x 2))) + (let loop3 () + (let ((new-size ((car (vector-ref x 1)) pos))) + (if new-size + (begin + (vector-set! x 2 new-size) + (loop2 (cdr lst) (+ pos old-size))) + (begin + (vector-set! x 1 (cddr (vector-ref x 1))) + (loop3)))))))) + (let loop4 ((lst fixup-lst) + (pos asm-start-pos) + (changed? #f)) + (if (pair? lst) + (let* ((fixup (car lst)) + (pos (+ pos (car fixup))) + (curr (cdr fixup)) + (x (car curr))) + (if (eq? (vector-ref x 0) 'LABEL) + ;; LABEL + (if (= (vector-ref x 1) pos) + (loop4 (cdr lst) pos changed?) + (begin + (vector-set! x 1 pos) + (loop4 (cdr lst) pos #t))) + ;; DEFERRED + (let ((new-size (vector-ref x 2))) + (loop4 (cdr lst) (+ pos new-size) changed?)))) + (if changed? + (loop1))))))) + + (let loop5 ((prev asm-code-stream) (curr (cdr asm-code-stream)) (pos asm-start-pos)) (if (null? curr) - (set-car! asm-code-stream prev) - (let ((x (car curr)) - (next (cdr curr))) - (if (vector? x) - (let ((kind (vector-ref x 0))) - (cond ((eq? kind 'LABEL) - (let ((final-pos (vector-ref x 1))) - (if final-pos - (if (not (= pos final-pos)) - (compiler-internal-error - "asm-assemble, inconsistency detected")) - (vector-set! x 1 pos)) - (set-cdr! prev next) - (loop4 prev next pos))) - ((eq? kind 'DEFERRED) - (let ((temp asm-code-stream)) - (set! asm-code-stream (asm-make-stream)) - ((cadr (vector-ref x 1)) pos) - (let ((tail (car asm-code-stream))) - (set-cdr! tail next) - (let ((head (cdr asm-code-stream))) - (set-cdr! prev head) - (set! asm-code-stream temp) - (loop4 prev head pos))))) - (else - (loop4 curr next pos)))) - (loop4 curr next (+ pos 1)))))))) + (set-car! asm-code-stream prev) + (let ((x (car curr)) + (next (cdr curr))) + (if (vector? x) + (let ((kind (vector-ref x 0))) + (cond ((eq? kind 'LABEL) + (let ((final-pos (vector-ref x 1))) + (if final-pos + (if (not (= pos final-pos)) + (compiler-internal-error + "asm-assemble, inconsistency detected")) + (vector-set! x 1 pos)) + (set-cdr! prev next) + (loop5 prev next pos))) + ((eq? kind 'DEFERRED) + (let ((temp asm-code-stream)) + (set! asm-code-stream (asm-make-stream)) + ((cadr (vector-ref x 1)) pos) + (let ((tail (car asm-code-stream))) + (set-cdr! tail next) + (let ((head (cdr asm-code-stream))) + (set-cdr! prev head) + (set! asm-code-stream temp) + (loop5 prev head pos))))) + (else + (loop5 curr next pos)))) + (loop5 curr next (+ pos 1)))))))) ;; (asm-display-listing port) produces a listing of the code stream ;; on the given output port. The bytes generated are shown in @@ -417,10 +432,12 @@ (- pos (length rev-bytes)) (reverse rev-bytes))) (print-line 1 0 '()) - (if #t + (if #t (begin - (display pos ##stderr-port) - (display " ROM bytes\n" ##stderr-port))))))))) + ;;;(pp (- 3447 (- pos asm-start-pos)));;;;;;;;;;;; + + (display (- pos asm-start-pos) ##stderr-port) + (display " bytes\n" ##stderr-port))))))))) ;; Utilities. diff --git a/code-generation.scm b/code-generation.scm index 34b19e7..10f8708 100644 --- a/code-generation.scm +++ b/code-generation.scm @@ -246,7 +246,7 @@ (subwf z) (subwfb z)))) (set! ignore-carry-borrow? #f)))) - (let ((x (byte-cell-adr src1)) + (let ((x (or (and (byte-cell? src1) (byte-cell-adr src1)) 0)) ;; FOO this should not be needed (or correct), but without it, PICOBIT without bignums won't compile. it gives the right results for the vectors test, haven't checked the others. (y (byte-cell-adr src2)) (z (byte-cell-adr dst))) (cond ((and (not (= x y)) @@ -463,10 +463,46 @@ (add-todo dest-true))) ((branch-table) - (let ((off (if (byte-lit? src1) ; branch no - (byte-lit-val src1) - (byte-cell-adr src1))) - (scratch (byte-cell-adr src2))) ; working space + (let* ((off (if (byte-lit? src1) ; branch no + (byte-lit-val src1) + (byte-cell-adr src1))) + (scratch (byte-cell-adr src2)) ; working space + (succs (bb-succs bb)) + (n-succs (length succs))) + + +;; ;; size of the branch table (without the +;; ;; offset-calculating code), if it uses short jumps +;; ;; that take 2 bytes per instruction +;; (let ((size-using-bra (* 2 n-succs)) +;; ;; size of the offset-calculating code, if we +;; ;; use short jumps +;; (bra-header-size )) + +;; (asm-at-assembly +;; ;; check if the targets are close enough to use +;; ;; short jumps. all the targets must be close +;; ;; enough, since all jumps must be of the same +;; ;; size +;; (lambda (self) +;; (foldl +;; (lambda (acc new) +;; (and acc +;; (let ((dist (- (label-pos (car new)) +;; (+ self (cdr new))))) +;; ;; close enough for short jumps +;; (if (and (>= dist -2048) +;; (<= dist 2047) +;; (even? dist)) +;; 2 +;; #f)))) +;; #t +;; (map +;; (lambda (l n) +;; (cons l (+ self n bra-header-size))) +;; succs (iota n-succs)))))) ;; FOO no time for this for the moment + + ;; precalculate the low byte of the PC ;; note: both branches (off is a literal or a ;; register) are of the same length in terms of @@ -496,7 +532,7 @@ (for-each (lambda (bb) (goto (bb-label bb)) (add-todo bb)) - (bb-succs bb)))) + succs))) (else ;; ... diff --git a/six-comp.scm b/six-comp.scm index 36b98a9..3f702f5 100755 --- a/six-comp.scm +++ b/six-comp.scm @@ -103,8 +103,6 @@ (set! asm-filename (string-append filename ".s")) (with-output-to-file asm-filename (lambda () (asm-display-listing (current-output-port)))) - (with-output-to-file (string-append filename ".map") - (lambda () (write (table->list symbol-table)))) (with-output-to-file (string-append filename ".reg") (lambda () (display "(") @@ -130,7 +128,7 @@ "tests/picobit/picobit-vm-sixpic.c.reg" "tests/picobit/picobit-vm-sixpic.c.s"))) -(define (picobit-orig prog #!optional (recompile? #f)) ;; FOO +(define (picobit-orig prog #!optional (recompile? #f)) (set! trace-instr #f) ;; no need to preprocess, I have a custom script that patches it for SIXPIC (set! preprocess? #f) @@ -143,8 +141,6 @@ "orig/picobit-vm.c.s"))) (define (simulate hexs map-file reg-file asm-file) - (set! symbol-table (with-input-from-file map-file - (lambda () (list->table (read))))) (let ((regs (with-input-from-file reg-file read))) (set! register-table (list->table -- 2.11.4.GIT