impc:aot:compile-xtm-dll   scheme


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

Implementation

(define impc:aot:compile-xtm-dll
  (lambda (lib-path)
    (set! *impc:compiler:aot:dll* #t)
    (let ((start-time (clock:clock))
          (in-file-port (or
                         (open-input-file (sanitize-platform-path lib-path))
                         (open-input-file (sanitize-platform-path (string-append (sys:share-dir) "/" lib-path))))))
      (if (not in-file-port)
          (begin (print-with-colors 'black 'red #t
                                    (print "Error:"))
                 (print " no .xtm file at" (sanitize-platform-path lib-path) "\n"))
          (let* ((res (close-port in-file-port))
                 (libname (sanitize-platform-path (filename-from-path lib-path)))
                 (libname-no-extension (string-append "xtm" (filename-strip-extension libname)))
                 (output-dir (sanitize-platform-path (string-append (sys:share-dir) "/libs/aot-cache")))
                 (aot-compilation-file-path (sanitize-platform-path (string-append output-dir "/" libname))))
            (if (not (sys:load-preload-check (string->symbol libname-no-extension)))
                (begin (print "AOT-compilation file not written ")
                       (close-port *impc:aot:current-output-port*)
                       (set! *impc:aot:current-output-port* #f))
                (begin
                  ;; if the preload check passes, create aot-cache dir
                  ;; if it doesn't exist
                  (sys:command (string-append (unix-or-Windows "mkdir " "md ") output-dir))
                  ;; remove old AOT file if present
                  (if (file-exists? aot-compilation-file-path)
                      (sys:command (string-append (unix-or-Windows "rm " "DEL ") aot-compilation-file-path)))
                  ;; open output file, ready for writing
                  (set! *impc:aot:current-output-port* (open-output-file aot-compilation-file-path))
                  (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* libname-no-extension)
                        ;; (impc:aot:insert-header libname-no-extension)
                        (print-with-colors 'cyan 'black #t (print "Started compiling: "))
                        (println lib-path)
                        (println)
                        (sys:load lib-path)
                        (println)
                        (print-with-colors 'cyan 'black #t (print "Finished compiling: "))
                        (println lib-path)
                        (println)
                        (begin
                          (println)
                          (print-with-colors 'black 'yellow #t (print " JIT-compiling IR "))
                          (print "\n"))
                        (let ((module (impc:compiler:flush-jit-compilation-queue)))
                          (if (not module)
                              (impc:compiler:print-compiler-error "Failed compiling LLVM IR"))
                          (impc:aot:compile-module libname-no-extension module))
                        ;; (impc:aot:insert-footer libname-no-extension)
                        (close-port *impc:aot:current-output-port*)
                        (set! *impc:aot:current-lib-name* "xtmdylib")
                        (if  *impc:aot:current-output-port*
                             (begin (set! *impc:aot:current-output-port* #f)
                                    (print "Successfully wrote AOT-compilation file to ")
                                    (print-with-colors 'green 'default #f (print aot-compilation-file-path "\n\n"))
                                    (impc:aot:print-compilation-details start-time)
                                    (quit 0))
                             (begin (print-with-colors 'black 'red #t (print " Error "))
                                    (print "\n\nsomething went wrong in writing the output file ")
                                    (print-with-colors 'red 'faultde #t (print aot-compilation-file-path "\n"))
                                    (quit 1))))
                      (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