six-comp.scm

   1 #!/usr/bin/env gsi
   2
   3 (declare (standard-bindings) (block))
   4
   5 (include "pic18-sim.scm")
   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
  16 ;------------------------------------------------------------------------------
  17
  18 ;; temporary solution, to support more than int
  19 (set! ##six-types ;; TODO signed types ?
  20   '((int    . #f)
  21     (byte   . #f)
  22     (int8   . #f)
  23     (int16  . #f)
  24     (int32  . #f)
  25     (char   . #f)
  26     (bool   . #f)
  27     (void   . #f)
  28     (float  . #f)
  29     (double . #f)
  30     (obj    . #f)))
  31 ;; TODO typedef should add to this list
  32
  33 '(current-exception-handler (lambda (exc) (##repl))) ; when not running in the repl
  34
  35 (define (read-source filename)
  36   (shell-command (string-append "cpp -P " filename " > " filename ".tmp"))
  37 ;;   (##read-all-as-a-begin-expr-from-path ;; TODO use vectorized notation to have info on errors (where in the source)
  38 ;;    (string-append filename ".tmp")
  39 ;;    (readtable-start-syntax-set (current-readtable) 'six)
  40 ;;    ##wrap-datum
  41 ;;    ##unwrap-datum)
  42   (with-input-from-file
  43       (string-append filename ".tmp")
  44     (lambda ()
  45       (input-port-readtable-set!
  46        (current-input-port)
  47        (readtable-start-syntax-set
  48         (input-port-readtable (current-input-port))
  49         'six))
  50       (read-all)))
  51   )
  52
  53 (define (main filename)
  54
  55   (output-port-readtable-set!
  56    (current-output-port)
  57    (readtable-sharing-allowed?-set
  58     (output-port-readtable (current-output-port))
  59     #t))
  60
  61   (let ((source (read-source filename)))
  62     '(pretty-print source)
  63     (let* ((ast (parse source)))
  64       '(pretty-print ast)
  65       (let ((cfg (generate-cfg ast)))
  66         '(print-cfg-bbs cfg)
  67         '(pretty-print cfg)
  68         (remove-branch-cascades-and-dead-code cfg)
  69         (remove-converging-branches cfg)
  70         (remove-dead-instructions cfg)
  71         '(pp "AFTER")
  72         '(print-cfg-bbs cfg)
  73         '(pretty-print cfg)
  74         (let ((code (code-gen filename cfg)))
  75           (asm-assemble)
  76           '(display "------------------ GENERATED CODE\n")
  77           (asm-display-listing (current-output-port))
  78           (asm-write-hex-file (string-append filename ".hex"))
  79           (asm-end!)
  80           '(display "------------------ EXECUTION USING SIMULATOR\n")
  81           (execute-hex-file (string-append filename ".hex"))
  82           #t)))))
  83
  84 (include "../statprof/statprof.scm")
  85 (define (profile) ; profile using picobit
  86   (time (with-exception-catcher
  87          ;; to have the profiling results even it the compilation fails
  88          (lambda (x)
  89            (profile-stop!)
  90            (write-profile-report "profiling-picobit"))
  91          (lambda ()
  92            (profile-start!)
  93            (main "tests/picobit/picobit-vm-sixpic.c")
  94            (profile-stop!)
  95            (write-profile-report "profiling-picobit")))))