six-comp.scm

   1 #!/usr/bin/env gsi
   2
   3 (declare (standard-bindings)) ;; add (block) to increase compilation time, but reduce execution time
   4
   5 ;; (include "pic18-sim.scm") ;; use includes to increase compilation time, but reduce execution time
   6 ;; (include "utilities.scm")
   7 ;; (include "ast.scm")
   8 ;; (include "operators.scm")
   9 ;; (include "cte.scm")
  10 ;; (include "parser.scm")
  11 ;; (include "cfg.scm")
  12 ;; (include "optimizations.scm")
  13 ;; (include "code-generation.scm")
  14
  15 (load "pic18-sim")
  16 (load "utilities")
  17 (load "ast")
  18 (load "operators")
  19 (load "cte")
  20 (load "parser")
  21 (load "cfg")
  22 (load "optimizations")
  23 (load "code-generation")
  24 (load "register-allocation")
  25
  26 ;------------------------------------------------------------------------------
  27
  28 ;; temporary solution, to support more than int
  29 (set! ##six-types ;; TODO signed types ?
  30   '((int    . #f)
  31     (byte   . #f)
  32     (int8   . #f)
  33     (int16  . #f)
  34     (int32  . #f)
  35     (char   . #f)
  36     (bool   . #f)
  37     (void   . #f)
  38     (float  . #f)
  39     (double . #f)
  40     (obj    . #f)))
  41 ;; TODO typedef should add to this list
  42
  43 '(current-exception-handler (lambda (exc) (##repl))) ; when not running in the repl
  44
  45 (define (read-source filename)
  46   (shell-command (string-append "cpp -P " filename " > " filename ".tmp"))
  47 ;;   (##read-all-as-a-begin-expr-from-path ;; TODO use vectorized notation to have info on errors (where in the source)
  48 ;;    (string-append filename ".tmp")
  49 ;;    (readtable-start-syntax-set (current-readtable) 'six)
  50 ;;    ##wrap-datum
  51 ;;    ##unwrap-datum)
  52   (with-input-from-file
  53       (string-append filename ".tmp")
  54     (lambda ()
  55       (input-port-readtable-set!
  56        (current-input-port)
  57        (readtable-start-syntax-set
  58         (input-port-readtable (current-input-port))
  59         'six))
  60       (read-all)))
  61   )
  62
  63 (define allocate-registers? #t) ; can be turned off to reduce compilation time
  64 (define fold-constants? #t)
  65
  66 (define (main filename . data)
  67
  68   (output-port-readtable-set!
  69    (current-output-port)
  70    (readtable-sharing-allowed?-set
  71     (output-port-readtable (current-output-port))
  72     #t))
  73
  74   (let ((source (read-source filename)))
  75     '(pretty-print source)
  76     (let* ((ast (parse source)))
  77       '(pretty-print ast)
  78       (let ((cfg (generate-cfg ast)))
  79         '(print-cfg-bbs cfg)
  80         '(pretty-print cfg)
  81         (remove-branch-cascades-and-dead-code cfg)
  82         (remove-converging-branches cfg) ;; TODO maybe make it possible to disable it, and the next one ?
  83         (remove-dead-instructions cfg)
  84         (if allocate-registers? (allocate-registers cfg))
  85         (assembler-gen filename cfg)
  86         (asm-assemble)
  87         '(asm-display-listing (current-output-port))
  88         (with-output-to-file (string-append filename ".s")
  89           (lambda () (asm-display-listing (current-output-port))))
  90         (with-output-to-file (string-append filename ".map")
  91           (lambda () (write (table->list symbol-table))))
  92         (asm-write-hex-file (string-append filename ".hex"))
  93         (asm-end!)
  94         ;; data contains a list of additional hex files
  95         (apply execute-hex-files (cons (string-append filename ".hex") data))
  96         #t))))
  97
  98 (define (picobit prog) (main "tests/picobit/picobit-vm-sixpic.c" prog))
  99 (define (simulate hexs map-file)
 100   (set! symbol-table (with-input-from-file map-file
 101                        (lambda () (list->table (read)))))
 102   (apply execute-hex-files hexs))
 103
 104 (include "../statprof/statprof.scm")
 105 (define (profile) ; profile using picobit
 106   (time (begin (with-exception-catcher
 107                 ;; to have the profiling results even it the compilation fails
 108                 (lambda (x)
 109                   (profile-stop!)
 110                   (write-profile-report "profiling-picobit"))
 111                 (lambda ()
 112                   (profile-start!)
 113                   (main "tests/picobit/picobit-vm-sixpic.c")
 114                   (profile-stop!)
 115                   (write-profile-report "profiling-picobit")))
 116                (pp TOTAL:))))