impc:aot:compile-xtm-ll   scheme

Defined in:


;; aot compile llvm bitcode (bc)
(define impc:aot:compile-xtm-ll
  (lambda (lib-path)
    (set! *impc:compiler:aot:dll* #f)
    (let ((start-time (clock:clock))
          (llas-path (sanitize-platform-path (string-append (get-llvm-path) "/bin/llvm-as")))
          (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)))
                 (bc-path (sanitize-platform-path (string-append output-dir "/" libname-no-extension ".bc")))
                 (ll-path (sanitize-platform-path (string-append output-dir "/" libname-no-extension ".ll"))))
            (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))
                  ;; 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)))
                  ;; remove old LL file if present
                  (if (file-exists? ll-path)
                      (sys:command (string-append (unix-or-Windows "rm " "DEL ") ll-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?)
                        (llvm:optimize #t); // should this be restored later?
                        ;; this is the 'success' branch
                        (set! *impc:aot:current-lib-name* libname-no-extension)
                        ;; module name for globals
                        (set! *impc:compiler:global-module-name* libname-no-extension)
                        ;; (impc:aot:insert-header libname-no-extension)
                        (log-info "started compiling" lib-path)
                        (sys:load lib-path)
                        (log-info "finished compiling" lib-path)
                        (log-info "JIT-compiling IR...")
                        (sys:dump-string-to-file ll-path *impc:compiler:queued-llvm-ir-string*)
                        ;; this won't be straight forward without linking in all relevant ll files :(
                        ;; (sys:command (string-append llas-path " " ll-path " -o " bc-path))
                        (close-port *impc:aot:current-output-port*)
                        (set! *impc:compiler:global-module-name* #f)
                        (set! *impc:aot:current-lib-name* "xtmdylib")
                        (if  *impc:aot:current-output-port*
                             (begin (set! *impc:aot:current-output-port* #f)
                                    (print "Successfully wrote 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 file at " aot-compilation-file-path "\n")
                             (quit 2))))))))))

Back to Index