(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)))))))