1  (define-module (llvm memory-buffer)
 2    #:use-module (oop goops)
 3    #:use-module (rnrs bytevectors)
 4    #:use-module (system foreign)
 5    #:use-module (llvm utils)
 6    #:use-module (llvm types)
 7    #:use-module (llvm raw)
 8    #:export (create-memory-buffer
 9              call-with-memory-buffer))
10  
11  (define (%create-memory-buffer/path path)
12    (let ((p (make-double-pointer))
13          (sp (make-double-pointer)))
14      (if (zero?
15           (LLVMCreateMemoryBufferWithContentsOfFile
16            (string->pointer path) p sp))
17          (wrap-llvm-memory-buffer (dereference-pointer p))
18          (error 'system-error (pointer->string (dereference-pointer sp))))))
19  
20  (define (%create-memory-buffer/bv bv name)
21    (wrap-llvm-memory-buffer
22     (LLVMCreateMemoryBufferWithMemoryRangeCopy
23      (bytevector->pointer bv)
24      (bytevector-length bv)
25      (if name
26          (string->pointer name)
27          %null-pointer))))
28  
29  (define* (create-memory-buffer
30            path-or-bytevectory
31            #:key name)
32    (if (bytevector? path-or-bytevectory)
33        (%create-memory-buffer/bv path-or-bytevectory name)
34        (%create-memory-buffer/path path-or-bytevectory)))
35  
36  (define-public (memory-buffer-content buffer)
37    (let ((b-p (unwrap-llvm-memory-buffer buffer)))
38      (pointer->bytevector (LLVMGetBufferStart b-p)
39                           (LLVMGetBufferSize b-p))))
40  
41  ;; (define-public (dispose-memory-buffer buffer)
42  ;;   (let ((p (unwrap-llvm-memory-buffer buffer)))
43  ;;     (change-class buffer <llvm-freed>)
44  ;;     (LLVMDisposeMemoryBuffer p)))
45  
46  (define* (call-with-memory-buffer path-or-bv
47                                    proc
48                                    #:key (name #f))
49    (let ((mb #f))
50      (dynamic-wind
51        (lambda ()
52          (set! mb (create-memory-buffer path-or-bv #:name name)))
53        (lambda ()
54          (proc mb))
55        (lambda ()
56          ;(dispose-memory-buffer mb)
57          (set! mb #f)))))