Optimized register allocation by moving a costly calculation outside
[sixpic.git] / six-comp.scm
blob81269aeaa4b21e27742b527f3e10ed8444538cc7
1 #!/usr/bin/env gsi
3 (declare (standard-bindings))
5 (define allocate-registers? #t) ; can be turned off to reduce compilation time
6 (define fold-constants?     #t)
7 (define coalesce?           #t)
9 ;; to use when interpreting
10 '(begin (include "asm.scm")
11        (include "pic18.scm")
12        (include "pic18-sim.scm")
13        (include "utilities.scm")
14        (include "ast.scm")
15        (include "operators.scm")
16        (include "cte.scm")
17        (include "parser.scm")
18        (include "cfg.scm")
19        (include "optimizations.scm")
20        (include "code-generation.scm")
21        (include "register-allocation.scm")
22        (include "profiler.scm"))
23 ;; to use with compiled code
24 (begin (load "asm")
25        (load "pic18")
26        (load "pic18-sim")
27        (load "utilities")
28        (load "ast")
29        (load "operators")
30        (load "cte")
31        (load "parser")
32        (load "cfg")
33        (load "optimizations")
34        (load "code-generation")
35        (load "register-allocation")
36        (load "profiler"))
38 ;------------------------------------------------------------------------------
40 ;; temporary solution, to support more than int
41 (set! ##six-types ;; TODO signed types ?
42   '((int    . #f)
43     (byte   . #f)
44     (int8   . #f)
45     (int16  . #f)
46     (int32  . #f)
47     (char   . #f)
48     (bool   . #f)
49     (void   . #f)
50     (float  . #f)
51     (double . #f)
52     (obj    . #f)))
53 ;; TODO typedef should add to this list
55 '(current-exception-handler (lambda (exc) (##repl))) ; when not running in the repl
57 (define (read-source filename)
58   (shell-command (string-append "cpp -P " filename " > " filename ".tmp"))
59 ;;   (##read-all-as-a-begin-expr-from-path ;; TODO use vectorized notation to have info on errors (where in the source)
60 ;;    (string-append filename ".tmp")
61 ;;    (readtable-start-syntax-set (current-readtable) 'six)
62 ;;    ##wrap-datum
63 ;;    ##unwrap-datum)
64   (with-input-from-file
65       (string-append filename ".tmp")
66     (lambda ()
67       (input-port-readtable-set!
68        (current-input-port)
69        (readtable-start-syntax-set
70         (input-port-readtable (current-input-port))
71         'six))
72       (read-all)))
73   )
76 (define asm-filename #f)
78 (define (main filename . data)
80   (output-port-readtable-set!
81    (current-output-port)
82    (readtable-sharing-allowed?-set
83     (output-port-readtable (current-output-port))
84     #t))
86   (let ((source (read-source filename)))
87     '(pretty-print source)
88     (let* ((ast (parse source)))
89       '(pretty-print ast)
90       (let ((cfg (generate-cfg ast)))
91         '(print-cfg-bbs cfg)
92         '(pretty-print cfg)
93         (remove-branch-cascades-and-dead-code cfg)
94         (remove-converging-branches cfg) ;; TODO maybe make it possible to disable it, the one before, and the next one ?
95         (remove-dead-instructions cfg)
96         '(print-cfg-bbs cfg)
97         (if allocate-registers? (allocate-registers cfg))
98         (assembler-gen filename cfg)
99         (asm-assemble)
100         '(asm-display-listing (current-output-port))
101         (set! asm-filename (string-append filename ".s"))
102         (with-output-to-file asm-filename
103           (lambda () (asm-display-listing (current-output-port))))
104         (with-output-to-file (string-append filename ".map")
105           (lambda () (write (table->list symbol-table))))
106         (with-output-to-file (string-append filename ".reg")
107           (lambda () (write (map (lambda (x)
108                                    ;; write it in hex, for easier
109                                    ;; cross-reference with the simulation
110                                    (cons (number->string (car x) 16) (cdr x)))
111                                  (table->list register-table)))))
112         (asm-write-hex-file (string-append filename ".hex"))
113         (asm-end!)
114         ;; data contains a list of additional hex files
115         (apply execute-hex-files (cons (string-append filename ".hex") data))
116         #t))))
118 (define (picobit prog #!optional (recompile? #f))
119   (set! trace-instr #f)
120   (if recompile?
121       (main "tests/picobit/picobit-vm-sixpic.c" prog)
122       (simulate (list "tests/picobit/picobit-vm-sixpic.c.hex" prog)
123                 "tests/picobit/picobit-vm-sixpic.c.map"
124                 "tests/picobit/picobit-vm-sixpic.c.reg"
125                 "tests/picobit/picobit-vm-sixpic.c.s")))
127 (define (simulate hexs map-file reg-file asm-file)
128   (set! symbol-table   (with-input-from-file map-file
129                          (lambda () (list->table (read)))))
130   (let ((regs (with-input-from-file reg-file read)))
131     (set! register-table
132           (list->table
133            (map (lambda (x) (cons (string->number (car x) 16) (cdr x)))
134                 regs)))
135     (set! reverse-register-table (make-table))
136     (for-each (lambda (x)
137                 (for-each (lambda (y)
138                             (table-set! reverse-register-table
139                                         (cdr y)
140                                         (string->number (car x) 16)))
141                           (cdr x)))
142               regs))
143   (set! asm-filename asm-file)
144   (apply execute-hex-files hexs))
146 ;; (include "../statprof/statprof.scm")
147 ;; (define (profile) ; profile using picobit
148 ;;   (time (begin (with-exception-catcher
149 ;;              ;; to have the profiling results even it the compilation fails
150 ;;              (lambda (x)
151 ;;                (profile-stop!)
152 ;;                (write-profile-report "profiling-picobit"))
153 ;;              (lambda ()
154 ;;                (profile-start!)
155 ;;                (main "tests/picobit/picobit-vm-sixpic.c")
156 ;;                (profile-stop!)
157 ;;                (write-profile-report "profiling-picobit")))
158 ;;             (pp TOTAL:))))