/ llvm / execution-engine.scm
execution-engine.scm
 1  (define-module (llvm execution-engine)
 2    #:use-module ((rnrs base) #:select (assert))
 3  
 4    #:use-module (system foreign)
 5    #:use-module (oop goops)
 6    #:use-module (llvm types)
 7    #:use-module (llvm utils)
 8    #:use-module (llvm type)
 9    #:use-module (llvm module)
10    #:use-module (llvm context)
11    #:use-module (llvm raw)
12    #:export (create-generic-value-of-int))
13  
14  ;; (define-once link-in-mcjit #f)
15  ;; (define-once link-in-interpreter #f)
16  ;; (define (ensure-link-in-interpreter)
17  ;;   (unless link-in-interpreter
18  ;;     (LLVMLinkInInterpreter)
19  ;;     (set! link-in-interpreter #t)))
20  ;; (define (ensure-link-in-mcjit)
21  ;;   (unless link-in-mcjit
22  ;;     (LLVMLinkInMCJIT)
23  ;;     (set! link-in-mcjit #t)))
24  
25  (define* (create-generic-value-of-int
26            int-t n
27            #:key
28            (is-signed? (error "must set is-signed?")))
29    (wrap-llvm-generic-value
30     (LLVMCreateGenericValueOfInt (unwrap-llvm-integer-type int-t)
31                                  n
32                                  (if is-signed? 1 0))))
33  
34  (define-public (create-execution-engine module)
35    (let ((p (make-double-pointer))
36          (error-p (make-double-pointer)))
37      (if  (zero? (LLVMCreateExecutionEngineForModule
38                   p
39                   (unwrap-llvm-module module)
40                   error-p))
41           (wrap-llvm-execution-engine (dereference-pointer p) #:module module)
42           (error (pointer->string error-p)))))
43  
44  ;; (define-public (run-function ee fn args)
45  ;;   (wrap-llvm-generic-value
46  ;;    (LLVMRunFunction
47  ;;     (unwrap-llvm-execution-engine ee)
48  ;;     (unwrap-llvm-function fn)
49  ;;     (length args)
50  ;;     (make-c-struct*
51  ;;      (make-list (length args) '*)
52  ;;      (map (lambda (x) (unwrap-llvm-generic-value x)) args)))))
53  
54  (define-public (find-function ee name)
55    (let ((ep (unwrap-llvm-execution-engine ee))
56          (re (make-double-pointer)))
57      (if (zero? (LLVMFindFunction ep (string->pointer name) re))
58          (wrap-llvm-value (dereference-pointer re))
59          (error "not find function ~a" name))))
60  (define-public (function-address ee name)
61    (assert (find-function ee name))
62    (LLVMGetFunctionAddress (unwrap-llvm-execution-engine ee)
63                            (string->pointer name)))