impc:aot:compile-xtm-exe   scheme


Defined in:  https://github.com/digego/extempore/tree/v0.8.9/runtime/llvmti.xtm

Implementation

(define impc:aot:compile-xtm-exe
  (lambda (file-path)
    (let* ((start-time (clock:clock))
           (libs (if (sys:cmdarg "link") (sys:cmdarg "link") ""))
           (asdll? (if (sys:cmdarg "dll") #t #f))
           (file-no-extension (filename-strip-extension (filename-from-path file-path)))
           (aot-compilation-file (string-append file-no-extension ".exe"))
           (in-file-port (open-input-file (sanitize-platform-path file-path))))
      (set! *impc:aot:current-output-port* #t) ;;(open-output-file aot-compilation-file))
      (set! *impc:aot:func-defs-in-mod* '())
      (if (impc:aot:currently-compiling?)
          (begin
            (llvm:optimize #t); // should this be restored later?
            ;; this is the 'success' branch
            (set! *impc:aot:current-lib-name* file-no-extension)
            ;; (impc:aot:insert-header libname-no-extension)
            ;; turn off scheme stubs!
            (set! *impc:compile:scheme-stubs* #f)
            ;; turn off aot-cache loading
            (set! *impc:compiler:with-cache* #f)
            (log-info "Started compiling: ")
            (if asdll? ;; need to preregister init function
                (impc:ti:register-new-nativefunc
                     (string-append file-no-extension "_init")
                     (impc:ir:get-type-from-pretty-str "[void]*") "" '()))
            (println)
            (sys:load file-path)
            (println)
            ;; static functions don't get a _setter()
            (define remove-all-static-functions
              (lambda (lst)
                (filter (lambda (x) (impc:ir:type? (vector-ref (cdr x) 0))) lst)))
            (define all-closure-setters
              (apply string-append
                     (map (lambda (x)
                            (string-append "call void @" (car x) "_setter();\n"))
                          (reverse (remove-all-static-functions *impc:ti:closure-cache*))))) ;; reverse - make sure we initialize function in correct order!
            (if asdll?
              (llvm:compile-ir
                (string-append "define dllexport void @" file-no-extension "_init() {\n"
                all-closure-setters
                "ret void;
              }"))
              (llvm:compile-ir
                (string-append "define i32 @main(i32 %args, i8** %argv) {\n"
                all-closure-setters
                ;; "call void @test22_adhoc_W2kzMl0_setter();\n"
                ;; "call void @run_adhoc_W2kzMixpMzIsaTgqKl0_setter();\n"
                "%res = call i32 @run_adhoc_W2kzMixpMzIsaTgqKl0_native(i32 %args, i8** %argv);
                ret i32 %res;
              }")))
            (log-info "Finished compiling:" file-path)
            (println file-path)
            ;; turn back on scheme stubs
            (set! *impc:compile:scheme-stubs* #t)
            ;; turn back on cache loading
            (set! *impc:compiler:with-cache* #t)
            (log-info "JIT-compiling IR...")
            (let ((module (impc:compiler:flush-jit-compilation-queue)))
              (if (not module)
                  (impc:compiler:print-compiler-error "Failed compiling LLVM IR"))
                (impc:aot:compile-exe file-no-extension module libs asdll?))
            (set! *impc:aot:current-output-port* #f)
            ;; (close-port *impc:aot:current-output-port*)
            (quit 0))
          (begin
            (begin (print-with-colors 'black 'red #t (print " Error "))
              (print "\n\ncannot write AOT-compilation file at " aot-compilation-file-path "\n")
              (quit 2)))))))


Back to Index