X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=inline;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fwrappers.c;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fwrappers.c;h=7e83aa99ba6805f2cf146d8b1c102da7a67caec9;hb=2ee84a2a641938988703e329aef9fc3c5eb5aacf;hp=0000000000000000000000000000000000000000;hpb=34d83812af9b7064cc8f735c2a78169881140010;p=helm.git

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/wrappers.c b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/wrappers.c
new file mode 100644
index 000000000..7e83aa99b
--- /dev/null
+++ b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/wrappers.c
@@ -0,0 +1,76 @@
+/* $Id$ */
+
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/callback.h>
+#include <caml/fail.h>
+
+#include "wrappers.h"
+
+value copy_memblock_indirected (void *src, asize_t size)
+{
+    value ret = alloc (Wosize_asize(size)+2, Abstract_tag);
+    if (!src) ml_raise_null_pointer ();
+    
+    Field(ret,1) = 2;
+    memcpy (&Field(ret,2), src, size);
+    return ret;
+}
+
+value ml_some (value v)
+{
+     CAMLparam1(v);
+     value ret = alloc_small(1,0);
+     Field(ret,0) = v;
+     CAMLreturn(ret);
+}
+
+void ml_raise_null_pointer ()
+{
+  static value * exn = NULL;
+  if (exn == NULL)
+      exn = caml_named_value ("null_pointer");
+  raise_constant (*exn);
+}   
+
+value Val_pointer (void *ptr)
+{
+    value ret = alloc_small (2, Abstract_tag);
+    if (!ptr) ml_raise_null_pointer ();
+    Field(ret,1) = (value)ptr;
+    return ret;
+}
+
+value copy_string_check (const char*str)
+{
+    if (!str) ml_raise_null_pointer ();
+    return copy_string ((char*) str);
+}
+
+value copy_string_or_null (const char*str)
+{
+    return copy_string (str ? (char*) str : "");
+}
+
+value ml_lookup_from_c (lookup_info *table, int data)
+{
+    int i;
+    for (i = table[0].data; i > 0; i--)
+	if (table[i].data == data) return table[i].key;
+    invalid_argument ("ml_lookup_from_c");
+}
+    
+int ml_lookup_to_c (lookup_info *table, value key)
+{
+    int first = 1, last = table[0].data, current;
+
+    while (first < last) {
+	current = (first+last)/2;
+	if (table[current].key >= key) last = current;
+	else first = current + 1;
+    }
+    if (table[first].key == key) return table[first].data;
+    invalid_argument ("ml_lookup_to_c");
+}