3 (declare (standard-bindings))
5 (define allocate-registers? #t) ; can be turned off to reduce compilation time
6 (define fold-constants? #t)
9 ;; to use when interpreting
10 '(begin (include "asm.scm")
12 (include "pic18-sim.scm")
13 (include "utilities.scm")
15 (include "operators.scm")
17 (include "parser.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
33 (load "optimizations")
34 (load "code-generation")
35 (load "register-allocation")
38 ;------------------------------------------------------------------------------
40 ;; temporary solution, to support more than int
41 (set! ##six-types ;; TODO signed types ?
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)
65 (string-append filename ".tmp")
67 (input-port-readtable-set!
69 (readtable-start-syntax-set
70 (input-port-readtable (current-input-port))
76 (define asm-filename #f)
78 (define (main filename . data)
80 (output-port-readtable-set!
82 (readtable-sharing-allowed?-set
83 (output-port-readtable (current-output-port))
86 (let ((source (read-source filename)))
87 '(pretty-print source)
88 (let* ((ast (parse source)))
90 (let ((cfg (generate-cfg ast)))
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)
97 (if allocate-registers? (allocate-registers cfg))
98 (assembler-gen filename cfg)
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"))
114 ;; data contains a list of additional hex files
115 (apply execute-hex-files (cons (string-append filename ".hex") data))
118 (define (picobit prog #!optional (recompile? #f))
119 (set! trace-instr #f)
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)))
133 (map (lambda (x) (cons (string->number (car x) 16) (cdr x)))
135 (set! reverse-register-table (make-table))
136 (for-each (lambda (x)
137 (for-each (lambda (y)
138 (table-set! reverse-register-table
140 (string->number (car x) 16)))
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
152 ;; (write-profile-report "profiling-picobit"))
155 ;; (main "tests/picobit/picobit-vm-sixpic.c")
157 ;; (write-profile-report "profiling-picobit")))