Merge pull request #24 from rigetti/fix-foreig-alloc-return-strings

fix: foreign alloc return values

examples/quilc/version.c

@@ -31,8 +31,10 @@ int main() {
     exit(1);
   }
 
-
   printf("quilc %s (%s)\n", version, githash);
 
+  free(version);
+  free(githash);
+
   return 0;
 }

examples/qvm/version.c

@@ -28,5 +28,8 @@ int main(int argc, char **argv) {
 
   printf("QVM %s (%s)\n", version, githash);
 
+  free(version);
+  free(githash);
+
   return 0;
 }

src/libquil.lisp

@@ -1,5 +1,10 @@
 (in-package #:libquil)
 
+(defun foreign-alloc-and-set-string (c-ptr s)
+  (let* ((ptr (cffi:foreign-alloc :string :initial-element s)))
+    (setf (cffi:mem-ref (sb-alien:alien-sap c-ptr) :pointer)
+          (sb-alien:alien-sap (sb-alien:deref (sb-alien:sap-alien ptr (* (* t))))))))
+
 (defun unpack-c-array-to-lisp-list (ptr len type)
   (loop :for i :below len
         :collect (cffi:mem-aref (sb-alien:alien-sap ptr) type i)))
@@ -47,7 +52,7 @@
         (return-from error-map 1)))))
 
 (sbcl-librarian:define-api common (:error-map error-map
-                                   :function-prefix "libquil_")
+                                   :function-prefix "libquil_") 
   (:type error-type)
   (:function
    (("error" libquil-last-error) :string ())))

src/quilc/api.lisp

@@ -12,15 +12,17 @@
     (setf (gethash "githash" version-info) githash)
     version-info))
 
-(defun quilc-version-info-version (version-info)
-  (gethash "version" version-info))
+(defun quilc-version-info-version (version-info ptr)
+  (foreign-alloc-and-set-string ptr (gethash "version" version-info)))
 
-(defun quilc-version-info-githash (version-info)
-  (gethash "githash" version-info))
+(defun quilc-version-info-githash (version-info ptr)
+  (foreign-alloc-and-set-string ptr (gethash "githash" version-info)))
 
-(defun program-to-string (program)
-  (with-output-to-string (s)
-    (cl-quil.frontend:print-parsed-program program s)))
+(defun program-to-string (program ptr)
+  (foreign-alloc-and-set-string
+   ptr
+   (with-output-to-string (s)
+     (cl-quil.frontend:print-parsed-program program s))))
 
 (defun parse-chip-spec-isa-json (isa-json)
   (cl-quil::qpu-hash-table-to-chip-specification (yason:parse isa-json)))
@@ -102,8 +104,8 @@
   (:literal "/* Quilc functions */")
   (:function
    (("get_version_info" quilc-get-version-info) quilc-version-info ())
-   (("version_info_version" quilc-version-info-version) :string ((version-info quilc-version-info)))
-   (("version_info_githash" quilc-version-info-githash) :string ((version-info quilc-version-info)))
+   (("version_info_version" quilc-version-info-version) :void ((version-info quilc-version-info) (ptr :pointer)))
+   (("version_info_githash" quilc-version-info-githash) :void ((version-info quilc-version-info) (ptr :pointer)))
    (("parse_quil" cl-quil.frontend:safely-parse-quil) quil-program ((source :string)))
    (("print_program" cl-quil.frontend:print-parsed-program) :void ((program quil-program)))
    (("compile_quil" cl-quil:compiler-hook) quil-program ((program quil-program) (chip-spec chip-specification)))
@@ -150,7 +152,7 @@
    (("chip_spec_from_isa_descriptor" quilc::lookup-isa-descriptor-for-name) chip-specification ((descriptor :string)))
    (("print_chip_spec" cl-quil::debug-print-chip-spec) :void ((chip-spec chip-specification)))
    (("parse_chip_spec_isa_json" parse-chip-spec-isa-json) chip-specification ((isa-json :string)))
-   (("program_string" program-to-string) :string ((program quil-program)))
+   (("program_string" program-to-string) :void ((program quil-program) (ptr :pointer)))
    (("conjugate_pauli_by_clifford" conjugate-pauli-by-clifford)
     :void
     ((pauli-indices :pointer)

src/qvm.lisp

@@ -11,11 +11,11 @@
     (setf (gethash "githash" version-info) githash)
     version-info))
 
-(defun qvm-version-info-version (version-info)
-  (gethash "version" version-info))
+(defun qvm-version-info-version (version-info ptr)
+  (foreign-alloc-and-set-string ptr (gethash "version" version-info)))
 
-(defun qvm-version-info-githash (version-info)
-  (gethash "githash" version-info))
+(defun qvm-version-info-githash (version-info ptr)
+  (foreign-alloc-and-set-string ptr (gethash "githash" version-info)))
 
 (defun qvm-multishot-addresses-new ()
   (make-hash-table :test #'equal))
@@ -105,11 +105,13 @@
     qvm-version-info
     ())
    (("version_info_version" qvm-version-info-version)
-    :string
-    ((version-info qvm-version-info)))
+    :void
+    ((version-info qvm-version-info)
+     (result-ptr :pointer)))
    (("version_info_githash" qvm-version-info-githash)
-    :string
-    ((version-info qvm-version-info)))
+    :void
+    ((version-info qvm-version-info)
+     (result-ptr :pointer)))
    (("multishot_addresses_new" qvm-multishot-addresses-new)
     qvm-multishot-addresses
     ())