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 (main filename)
  64
  65   (output-port-readtable-set!
  66    (current-output-port)
  67    (readtable-sharing-allowed?-set
  68     (output-port-readtable (current-output-port))
  69     #t))
  70
  71   (let ((source (read-source filename)))
  72     '(pretty-print source)
  73     (let* ((ast (parse source)))
  74       '(pretty-print ast)
  75       (let ((cfg (generate-cfg ast)))
  76         '(print-cfg-bbs cfg)
  77         '(pretty-print cfg)
  78         (remove-branch-cascades-and-dead-code cfg)
  79         (remove-converging-branches cfg)
  80         (remove-dead-instructions cfg)
  81         (profile-start!) ;; TODO DEBUG
  82         (allocate-registers cfg)
  83         (profile-stop!) ;; TODO DEBUG
  84         (write-profile-report "profiling-registers") ;; TODO DEBUG
  85         (assembler-gen filename cfg)
  86         (asm-assemble)
  87         '(display "------------------ GENERATED CODE\n")
  88         (asm-display-listing (current-output-port))
  89         (asm-write-hex-file (string-append filename ".hex"))
  90         (asm-end!)
  91         '(display "------------------ EXECUTION USING SIMULATOR\n")
  92         (execute-hex-file (string-append filename ".hex"))
  93         #t))))
  94
  95 (define (picobit) (main "tests/picobit/picobit-vm-sixpic.c"))
  96
  97 (include "../statprof/statprof.scm")
  98 (define (profile) ; profile using picobit
  99   (time (begin (with-exception-catcher
 100                 ;; to have the profiling results even it the compilation fails
 101                 (lambda (x)
 102                   (profile-stop!)
 103                   (write-profile-report "profiling-picobit"))
 104                 (lambda ()
 105                   (profile-start!)
 106                   (main "tests/picobit/picobit-vm-sixpic.c")
 107                   (profile-stop!)
 108                   (write-profile-report "profiling-picobit")))
 109                (pp TOTAL:))))