/ tests / execution-engine.scm
execution-engine.scm
 1  (define-module (tests execution-engine)
 2    #:use-module (srfi srfi-64)
 3    #:use-module (llvm)
 4    #:use-module (llvm lljit)
 5    #:use-module (llvm orc)
 6    #:use-module (srfi srfi-64)
 7    #:use-module (ice-9 binary-ports)
 8    #:use-module (system foreign)
 9    #:use-module (llvm module)
10    #:use-module (llvm use)
11    #:use-module (llvm context)
12    #:use-module (llvm pass-manager)
13    #:use-module (llvm block)
14    #:use-module (llvm raw)
15    #:use-module (llvm types)
16    #:use-module (llvm type)
17    #:use-module (llvm target-machine)
18    #:use-module (llvm value)
19    #:use-module (llvm function)
20    #:use-module (llvm builder)
21    #:use-module (llvm utils)
22    #:use-module (llvm execution-engine)
23    #:use-module (llvm error)
24    #:use-module (llvm memory-buffer)
25    #:use-module (llvm object)
26    #:use-module (llvm bitcode))
27  
28  (init-llvm!)
29  (test-group "llvm-execution-engine"
30    (let* ((module (module-create "hello"))
31           (add-func (add-function module
32                                   #:name "main"
33                                   #:return (int32-type)
34                                   #:arg-types (list (int32-type)
35                                                     (int32-type))))
36           (block (append-block add-func "entry"))
37           (builder (builder-create))
38           (_ (position-builder-at-end builder block))
39           (pam-0 (param add-func 0))
40           (pam-1 (param add-func 1))
41           (mul (build-mul builder pam-0 pam-1 #:name "mul"))
42           (add (build-add builder mul pam-1 #:name "ad"))
43           (_ (build-return builder add))
44           (ee (create-execution-engine module))
45           (proc (pointer->procedure
46                  int64 (make-pointer
47                         (function-address ee "main"))
48                  (list int32 int32))))
49      (test-equal "execution-engine" 630 (proc 20 30))
50      (let ((m (write-bitcode-to-memory-buffer
51                module)))
52        (test-assert "buffer->bytevector"
53          (pointer->bytevector
54           (LLVMGetBufferStart
55            (unwrap-llvm-memory-buffer
56             m))
57           (LLVMGetBufferSize
58            (unwrap-llvm-memory-buffer
59             m)))))))