git » nmdb » commit 02f0dcd

Add bigloo bindings.

author Alberto Bertogli
2007-07-10 19:39:14 UTC
committer Alberto Bertogli
2007-07-10 19:39:14 UTC
parent 2fc78405891b8855cbf23d014cf7c901ea355c8c

Add bigloo bindings.

Very simple and straightforward bindings for Bigloo Scheme.
The test was copied from the NewLISP bindings.

Signed-off-by: Alberto Bertogli <albertito@gmail.com>

bindings/bigloo/Makefile +29 -0
bindings/bigloo/nmdb.scm +133 -0
bindings/bigloo/test1.scm +25 -0

diff --git a/bindings/bigloo/Makefile b/bindings/bigloo/Makefile
new file mode 100644
index 0000000..64bd1c9
--- /dev/null
+++ b/bindings/bigloo/Makefile
@@ -0,0 +1,29 @@
+
+BFLAGS += -Wall -O6
+ALL_BFLAGS = $(BFLAGS)
+
+ifdef DEBUG
+ALL_CFLAGS += -g
+endif
+
+ifdef PROFILE
+ALL_CFLAGS += -pg
+endif
+
+
+default: all
+
+all: lib test1
+
+lib:
+	bigloo $(ALL_BFLAGS) -c nmdb.scm -o nmdb.o
+
+test1: lib
+	bigloo $(ALL_BFLAGS) nmdb.o test1.scm -lnmdb -o test1
+
+clean:
+	rm -f nmdb.o test1.o test1
+
+.PHONY: default all clean
+
+
diff --git a/bindings/bigloo/nmdb.scm b/bindings/bigloo/nmdb.scm
new file mode 100644
index 0000000..9989d3f
--- /dev/null
+++ b/bindings/bigloo/nmdb.scm
@@ -0,0 +1,133 @@
+
+;; Bigloo nmdb bindings
+
+(module nmdb
+
+	;; C functions
+	(extern
+	  (type _nmdb_t (pointer void) "void *")
+
+	  (macro _nmdb_init::_nmdb_t () "nmdb_init")
+	  (macro _nmdb_free::int (::_nmdb_t) "nmdb_free")
+
+	  (macro _nmdb_add_tipc_server::int (::_nmdb_t ::int)
+		 "nmdb_add_tipc_server")
+	  (macro _nmdb_add_tcp_server::int (::_nmdb_t ::string ::int)
+		 "nmdb_add_tcp_server")
+	  (macro _nmdb_add_udp_server::int (::_nmdb_t ::string ::int)
+		 "nmdb_add_udp_server")
+
+	  (macro _nmdb_set::int
+		 (::_nmdb_t ::string ::uint ::string ::uint)
+		 "nmdb_set")
+	  (macro _nmdb_set_sync::int
+		 (::_nmdb_t ::string ::uint ::string ::uint)
+		 "nmdb_set_sync")
+	  (macro _nmdb_cache_set::int
+		 (::_nmdb_t ::string ::uint ::string ::uint)
+		 "nmdb_cache_set")
+
+	  (macro _nmdb_get::ulong
+		 (::_nmdb_t ::string ::uint ::string ::uint)
+		 "nmdb_get")
+	  (macro _nmdb_cache_get::ulong
+		 (::_nmdb_t ::string ::uint ::string ::uint)
+		 "nmdb_cache_get")
+
+	  (macro _nmdb_del::int
+		 (::_nmdb_t ::string ::uint)
+		 "nmdb_del")
+	  (macro _nmdb_del_sync::int
+		 (::_nmdb_t ::string ::uint)
+		 "nmdb_del_sync")
+	  (macro _nmdb_cache_del::int
+		 (::_nmdb_t ::string ::uint)
+		 "nmdb_cache_del")
+
+	  (macro _nmdb_cas::int
+		 (::_nmdb_t ::string ::uint ::string ::uint ::string ::uint)
+		 "nmdb_cas")
+	  (macro _nmdb_cache_cas::int
+		 (::_nmdb_t ::string ::uint ::string ::uint ::string ::uint)
+		 "nmdb_cache_cas")
+
+	  )
+
+	(export
+	  (make-nmdb)
+	  (nmdb-free db)
+
+	  (nmdb-add-tipc-server db port)
+	  (nmdb-add-tcp-server db addr port)
+	  (nmdb-add-udp-server db addr port)
+
+	  (nmdb-get db key)
+	  (nmdb-cache-get db key)
+
+	  (nmdb-set db key val)
+	  (nmdb-set-sync db key val)
+	  (nmdb-cache-set db key val)
+
+	  (nmdb-del db key)
+	  (nmdb-del-sync db key)
+	  (nmdb-cache-del db key)
+
+	  (nmdb-cas db key oldval newval)
+	  (nmdb-cache-cas db key oldval newval)
+	  )
+
+	)
+
+
+;; creator and destructor
+(define (make-nmdb) (_nmdb_init))
+(define (nmdb-free db) (_nmdb_free db))
+
+;; adding servers
+(define (nmdb-add-tipc-server db port) (_nmdb_add_tipc_server db port))
+(define (nmdb-add-tcp-server db addr port) (_nmdb_add_tcp_server db addr port))
+(define (nmdb-add-udp-server db addr port) (_nmdb_add_udp_server db addr port))
+
+;; get functions
+(define (nmdb-generic-get func db key)
+  (define buflen (* 70 1024))
+  (define buf (make-string buflen))
+  (define vsize (func db key (string-length key) buf buflen))
+  (if (< vsize 0)
+    vsize
+    (substring buf 0 vsize) )
+  )
+
+(define (nmdb-get db key) (nmdb-generic-get _nmdb_get db key))
+(define (nmdb-cache-get db key) (nmdb-generic-get _nmdb_cache_get db key))
+
+;; set functions
+(define (nmdb-generic-set func db key val)
+  (func db key (string-length key) val (string-length val)) )
+(define (nmdb-set db key val)
+  (nmdb-generic-set _nmdb_set db key val))
+(define (nmdb-set-sync db key val)
+  (nmdb-generic-set _nmdb_set_sync db key val))
+(define (nmdb-cache-set db key val)
+  (nmdb-generic-set _nmdb_cache_set db key val))
+
+;; del functions
+(define (nmdb-generic-del func db key)
+  (func db key (string-length key)) )
+(define (nmdb-del db key)
+  (nmdb-generic-del _nmdb_del db key))
+(define (nmdb-del-sync db key)
+  (nmdb-generic-del _nmdb_del_sync db key))
+(define (nmdb-cache-del db key)
+  (nmdb-generic-del _nmdb_cache_del db key))
+
+;; cas functions
+(define (nmdb-generic-cas func db key oldval newval)
+  (func db key (string-length key)
+	oldval (string-length oldval)
+	newval (string-length newval) ) )
+(define (nmdb-cas db key oldval newval)
+  (nmdb-generic-cas _nmdb_cas db key oldval newval))
+(define (nmdb-cache-cas db key oldval newval)
+  (nmdb-generic-cas _nmdb_cache_cas db key oldval newval))
+
diff --git a/bindings/bigloo/test1.scm b/bindings/bigloo/test1.scm
new file mode 100644
index 0000000..4262a87
--- /dev/null
+++ b/bindings/bigloo/test1.scm
@@ -0,0 +1,25 @@
+
+(module test1
+	(import (nmdb "nmdb.scm")) )
+
+(define db (make-nmdb))
+(nmdb-add-tipc-server db -1)
+
+(print)
+(print "db-set D1 V1\t"		(nmdb-set db "D1" "D1"))
+(print "sync-set S2 V2\t"	(nmdb-set-sync db "S2" "V2"))
+(print "cache-set C3 C3\t"	(nmdb-cache-set db "C3" "C3"))
+(print)
+(print "db-get D1\t"		(nmdb-get db "D1"))
+(print "db-get S2\t"		(nmdb-get db "S2"))
+(print "cache-get C3\t"		(nmdb-cache-get db "C3"))
+(print)
+(print "db-cas D1\t"		(nmdb-cas db "D1" "D1" "DX"))
+(print "cache-cas C3\t"		(nmdb-cache-cas db "C3" "C3" "CX"))
+(print)
+(print "db-del D1\t"		(nmdb-del db "D1"))
+(print "sync-del S2\t"		(nmdb-del-sync db "S2"))
+(print "cache-del C3\t"		(nmdb-cache-del db "C3"))
+
+(nmdb-free db)
+