git » nmdb » master » tree

[master] / bindings / bigloo / nmdb.scm 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
;; Bigloo nmdb bindings

(module nmdb

	;; C functions
	(extern
	  (type _nmdb_t (pointer void) "void *")
	  (type long* (pointer long) "int64_t *")

	  (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_add_sctp_server::int (::_nmdb_t ::string ::int)
		 "nmdb_add_sctp_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")

	  (macro _nmdb_incr::int
		 (::_nmdb_t ::string ::uint ::long ::long*)
		 "nmdb_incr")
	  (macro _nmdb_cache_incr::int
		 (::_nmdb_t ::string ::uint ::long ::long*)
		 "nmdb_cache_incr")

	  )

	(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-add-sctp-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)

	  (nmdb-incr db key increment)
	  (nmdb-cache-incr db key increment)
	  )

	)


;; 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))
(define (nmdb-add-sctp-server db addr port) (_nmdb_add_sctp_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))

;; incr functions
(define (nmdb-generic-incr func db key increment)
  (define newval (make-long* 1))
  (define res (func db key (string-length key) increment newval) )
  (list res (long*-ref newval 0) ) )
(define (nmdb-incr db key increment)
  (nmdb-generic-incr _nmdb_incr db key increment))
(define (nmdb-cache-incr db key increment)
  (nmdb-generic-incr _nmdb_cache_incr db key increment))