six-comp.scm

   1 #!/usr/bin/env gsi
   2
   3 (declare (standard-bindings))
   4
   5 (define allocate-registers? #t) ; can be turned off to reduce compilation time
   6 (define fold-constants?     #t)
   7 (define coalesce?           #t)
   8
   9 ;; ;; to use when interpreting
  10 ;; (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
  24 ;; to use with compiled code
  25 (load "asm")
  26 (load "pic18")
  27 (load "pic18-sim")
  28 (load "utilities")
  29 (load "ast")
  30 (load "operators")
  31 (load "cte")
  32 (load "parser")
  33 (load "cfg")
  34 (load "optimizations")
  35 (load "code-generation")
  36 (load "register-allocation")
  37 (load "profiler")
  38
  39 ;------------------------------------------------------------------------------
  40
  41 ;; temporary solution, to support more than int
  42 (set! ##six-types ;; TODO signed types ?
  43   '((int    . #f)
  44     (byte   . #f)
  45     (int8   . #f)
  46     (int16  . #f)
  47     (int32  . #f)
  48     (char   . #f)
  49     (bool   . #f)
  50     (void   . #f)
  51     (float  . #f)
  52     (double . #f)
  53     (obj    . #f)))
  54 ;; TODO typedef should add to this list
  55
  56 '(current-exception-handler (lambda (exc) (##repl))) ; when not running in the repl
  57
  58 (define (read-source filename)
  59   (shell-command (string-append "cpp -P " filename " > " filename ".tmp"))
  60 ;;   (##read-all-as-a-begin-expr-from-path ;; TODO use vectorized notation to have info on errors (where in the source)
  61 ;;    (string-append filename ".tmp")
  62 ;;    (readtable-start-syntax-set (current-readtable) 'six)
  63 ;;    ##wrap-datum
  64 ;;    ##unwrap-datum)
  65   (with-input-from-file
  66       (string-append filename ".tmp")
  67     (lambda ()
  68       (input-port-readtable-set!
  69        (current-input-port)
  70        (readtable-start-syntax-set
  71         (input-port-readtable (current-input-port))
  72         'six))
  73       (read-all)))
  74   )
  75
  76
  77 (define asm-filename #f)
  78
  79 (define (main filename . data)
  80
  81   (output-port-readtable-set!
  82    (current-output-port)
  83    (readtable-sharing-allowed?-set
  84     (output-port-readtable (current-output-port))
  85     #t))
  86
  87   (let ((source (read-source filename)))
  88     '(pretty-print source)
  89     (let* ((ast (parse source)))
  90       '(pretty-print ast)
  91       (let ((cfg (generate-cfg ast)))
  92         '(print-cfg-bbs cfg)
  93         '(pretty-print cfg)
  94         (remove-branch-cascades-and-dead-code cfg)
  95         (remove-converging-branches cfg) ;; TODO maybe make it possible to disable it, and the next one ?
  96         (remove-dead-instructions 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))))
 117
 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")))
 126
 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   (set! register-table
 131         (with-input-from-file reg-file
 132           (lambda () (list->table
 133                       (map (lambda (x)
 134                              ;; read from hex
 135                              (cons (string->number (car x) 16) (cdr x)))
 136                            (read))))))
 137   (set! asm-filename asm-file)
 138   (apply execute-hex-files hexs))
 139
 140 (include "../statprof/statprof.scm")
 141 (define (profile) ; profile using picobit
 142   (time (begin (with-exception-catcher
 143                 ;; to have the profiling results even it the compilation fails
 144                 (lambda (x)
 145                   (profile-stop!)
 146                   (write-profile-report "profiling-picobit"))
 147                 (lambda ()
 148                   (profile-start!)
 149                   (main "tests/picobit/picobit-vm-sixpic.c")
 150                   (profile-stop!)
 151                   (write-profile-report "profiling-picobit")))
 152                (pp TOTAL:))))