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