diff --git a/src/cxx-jit.lisp b/src/cxx-jit.lisp index 1d3ff0b..c668b05 100644 --- a/src/cxx-jit.lisp +++ b/src/cxx-jit.lisp @@ -3,7 +3,7 @@ (defparameter *cxx-compiler-executable-path* "/usr/bin/g++") (defparameter *cxx-compiler-flags* "-std=c++17 -Wall -Wextra -I/usr/include/eigen3") ;;; #\/ '/' should be the last char -(defparameter *cxx-compiler-working-directory* "/tmp/") +(defparameter *cxx-compiler-working-directory* (namestring (uiop:temporary-directory))) (defconstant +cxx-compiler-lib-name+ (intern "plugin")) (defconstant +cxx-compiler-wrap-cxx-path+ (uiop:merge-pathnames* "./src/wrap-cxx.cpp" (asdf:system-source-directory :cxx-jit))) ;;; TODO: detect compiler then set flags #+#. @@ -11,8 +11,6 @@ ;;; change to "-Wl,-undefined,error -Wl,-flat_namespace" for clang++ (defparameter *cxx-compiler-internal-flags* "-shared -fPIC -Wl,--no-undefined -Wl,--no-allow-shlib-undefined") (defparameter *cxx-compiler-link-libs* "-lm") -;;; async process value -(defparameter *cxx-compiler-process* nil) ;;; list of libs compiled (defparameter *cxx-compiler-packages* nil) (defparameter *cxx-compiler-packages-number* 0) @@ -55,6 +53,13 @@ ("long double" . :long-double) ("bool" . :bool))) +(define-condition cxx-compile-error (error) + ((message + :initarg :message + :reader cxx-compile-error-message)) + (:report (lambda (condition stream) + (format stream "C++ compile error:~%~A" + (cxx-compile-error-message condition))))) ;; inline void lisp_error(const char *error) (cffi:defcallback lisp-error :void ((err :string)) @@ -66,12 +71,18 @@ (arg-types (:pointer :string)) (types-size :int8)) +(defun string-replace-first (str old new) + (let ((tmp (search old str))) + (strcat (subseq str 0 tmp) + new + (subseq str (+ tmp (length old)))))) + (defun symbols-list (arg-types &optional (method-p nil)) "Return a list of symbols '(V0 V1 V2 V3 ...) representing the number of args" (let ((lst (if arg-types (loop for i below (length arg-types) - collect (intern (concatenate 'string "V" (write-to-string i))))))) + collect (intern (format nil "V~A" i)))))) (if method-p (push (intern "OBJ") lst)) lst)) @@ -88,12 +99,10 @@ (defun parse-input-args (arg-types) "return argument types (with variables if they are inputs) in a proper list" - (if arg-types (loop - for i in arg-types - for sym in (symbols-list arg-types) - as type = (cffi-type i) then (cffi-type i) - append - `(,type ,sym)))) + (when arg-types + (mapcan (lambda (arg-type sym) + (list (cffi-type arg-type) sym)) + arg-types (symbols-list arg-types)))) ;; void send_data(MetaData *M) (cffi:defcallback reg-data :void ((meta-ptr :pointer)) @@ -101,153 +110,100 @@ (let ((name (pop *cxx--fun-names*)) (args (loop for i below types-size collect (cffi:mem-aref arg-types :string i)))) - (eval `(progn - ;; don't export functions starting with '%' - ,(if (equal #\% (char name 0)) - nil - `(export ',(read-from-string name))) - (defun - ,(read-from-string name) ,(symbols-list (cdr args) method-p) + (let ((fname (read-from-string name))) + (unless (string-prefix-p "%" name) + (export fname)) + (eval `(defun + ,fname ,(symbols-list (cdr args) method-p) ;; TODO: add declare type (cffi:foreign-funcall-pointer ,func-ptr nil ,@(append - (if method-p - ;; cxx-ptr defined in defclass - (append '(:pointer obj) (parse-input-args (cdr args))) - (parse-input-args (cdr args))) + ;; cxx-ptr defined in defclass + (when method-p '(:pointer obj)) + (parse-input-args (cdr args)) (list (cffi-type (car args))))))))))) (defun compile-code (code) "compile aync. code string with cxx compiler" ;; compiler command - (let* ((cmd (concatenate 'string - *cxx-compiler-executable-path* - " " - *cxx-compiler-internal-flags* - " " - *cxx-compiler-flags* - " " - ;;*cxx-compiler-output-path* - ;;" " - *cxx-compiler-working-directory* (symbol-name +cxx-compiler-lib-name+) ".cpp -o " - *cxx-compiler-working-directory* (symbol-name +cxx-compiler-lib-name+) ".so " - *cxx-compiler-link-libs*))) + (let* ((cmd (strcat *cxx-compiler-executable-path* + " " + *cxx-compiler-internal-flags* + " " + *cxx-compiler-flags* + " " + ;;*cxx-compiler-output-path* + ;;" " + *cxx-compiler-working-directory* (symbol-name +cxx-compiler-lib-name+) ".cpp -o " + *cxx-compiler-working-directory* (symbol-name +cxx-compiler-lib-name+) ".so " + *cxx-compiler-link-libs*))) ;; create cxx file and insert code into it - (with-open-file (cxx-source-code-file (concatenate - 'string - *cxx-compiler-working-directory* - (symbol-name +cxx-compiler-lib-name+) - ".cpp") + (with-open-file (cxx-source-code-file (strcat *cxx-compiler-working-directory* + (symbol-name +cxx-compiler-lib-name+) + ".cpp") :direction :output ;; Write to disk :if-exists :supersede ;; Overwrite the file :if-does-not-exist :create) - (format cxx-source-code-file "~A" code)) + (write-string code cxx-source-code-file)) ;; compile cxx file (print cmd) - (setf *cxx-compiler-process* - (uiop:launch-program cmd :output :stream - :error-output :stream)))) - -(defun try-get-cxx-compiler-output () - "returns nil if compiler process is compiling -else returns the exit value from the process" - (if (uiop/launch-program:process-alive-p *cxx-compiler-process*) - nil - (progn - (loop for line = (read-line - (uiop:process-info-error-output - *cxx-compiler-process*) nil nil) - while line - do (print line) ) - (loop for line = (read-line - (uiop:process-info-output - *cxx-compiler-process*) nil nil) - while line - do (print line) ) - (uiop:wait-process *cxx-compiler-process*)))) + (multiple-value-bind (out errs code) + (uiop:run-program cmd :output :string + :error-output :string + :ignore-error-status t) + (format t "~A~%~A" out errs) + (when (/= code 0) + (error 'cxx-compile-error :message errs)) + (= code 0)))) (defun copy-and-load-new-library () "if compilation suceceded copy plugin.so to plugin_x.so ,where x = 0,1,... then load the library" - (let ((exit-code (try-get-cxx-compiler-output))) - (when (eq exit-code 0) - (let* ((n_str (write-to-string - (1- (setf *cxx-compiler-packages-number* - (1+ *cxx-compiler-packages-number*))))) - (source (concatenate 'string - *cxx-compiler-working-directory* - (symbol-name +cxx-compiler-lib-name+) - ".so")) - (destination (concatenate 'string - *cxx-compiler-working-directory* - (symbol-name +cxx-compiler-lib-name+) - "_" n_str ".so"))) - (uiop:copy-file source destination) - (push - (eval `(cffi:use-foreign-library ,destination)) - *cxx-compiler-packages*))))) + (let* ((n_str (write-to-string + (1- (setf *cxx-compiler-packages-number* + (1+ *cxx-compiler-packages-number*))))) + (source (strcat *cxx-compiler-working-directory* + (symbol-name +cxx-compiler-lib-name+) + ".so")) + (destination (strcat *cxx-compiler-working-directory* + (symbol-name +cxx-compiler-lib-name+) + "_" n_str ".so"))) + (uiop:copy-file source destination) + (push + (cffi:load-foreign-library destination) + *cxx-compiler-packages*))) (defun from (header-names import &rest body) "import cxx functions/methods from the header" (declare (ignore import)) ;; 1. create code-block - (let* ((header - (format nil "~{~a~}" - (loop for header-name in header-names - collect - (concatenate 'string - "#include " - (if - (or (eq #\< (aref header-name 0)) - (eq #\" (aref header-name 0))) - header-name - (concatenate 'string - "\"" - header-name - "\"")) - " -")))) - (cxx-code (concatenate 'string header (uiop:read-file-string +cxx-compiler-wrap-cxx-path+))) - (insert-code-pos-str "// BlaBlaBla;") - (insert-pack-name-pos-str "$") + (let* ((header (with-output-to-string (stream) + (dolist (header-name header-names) + (format stream "#include ~A~%" + (if (member (char header-name 0) '(#\< #\")) + header-name + (strcat "\"" header-name "\"")))))) (pack-name (symbol-name (gensym "RegisterPackage"))) - (lst '()) - (tmp '()) - (fun-names '()) - (import-str (format nil "~{~a~}" - (progn - (loop for f in body - do (if (consp f) - (progn - (setf fun-names (append fun-names (list (cdr f)))) - (setf lst (append lst - (list - (concatenate 'string - " - IMPORT(" - (car f) ");"))))) - (setf lst (append lst (list f))))) - lst)))) - (setf tmp (search insert-pack-name-pos-str cxx-code)) - (setf cxx-code (concatenate 'string - (subseq cxx-code 0 tmp) - pack-name - (subseq cxx-code (+ tmp (length insert-pack-name-pos-str))))) - (setf tmp (search insert-code-pos-str cxx-code)) - (setf cxx-code (concatenate 'string - (subseq cxx-code 0 tmp) - import-str - (subseq cxx-code (+ tmp (length insert-code-pos-str))))) + (import-str (with-output-to-string (stream) + (dolist (f body) + (write-string (if (consp f) + (format nil "~%IMPORT(~A);" (car f)) + f) + stream)))) + (cxx-code (strcat header (uiop:read-file-string +cxx-compiler-wrap-cxx-path+))) + (cxx-code (string-replace-first cxx-code "$" pack-name)) + (cxx-code (string-replace-first cxx-code "// BlaBlaBla;" import-str))) + ;; 2. compile code - (compile-code cxx-code) - ;; 3. call c function to register package - (setf *cxx--fun-names* fun-names) - (loop while (not (try-get-cxx-compiler-output))) - (copy-and-load-new-library) - (if (eq (try-get-cxx-compiler-output) 0) (eval - `(cffi:foreign-funcall ,pack-name :pointer (cffi:callback lisp-error) - :pointer (cffi:callback reg-data)))))) + (when (compile-code cxx-code) + ;; 3. call c function to register package + (copy-and-load-new-library) + (let ((*cxx--fun-names* (mapcan (lambda (elem) + (when (consp elem) (list (cdr elem)))) + body))) + (eval `(cffi:foreign-funcall ,pack-name :pointer (cffi:callback lisp-error) + :pointer (cffi:callback reg-data)))))))