bindings/bigloo/nmdb.scm

   1
   2 ;; Bigloo nmdb bindings
   3
   4 (module nmdb
   5
   6         ;; C functions
   7         (extern
   8           (type _nmdb_t (pointer void) "void *")
   9           (type long* (pointer long) "int64_t *")
  10
  11           (macro _nmdb_init::_nmdb_t () "nmdb_init")
  12           (macro _nmdb_free::int (::_nmdb_t) "nmdb_free")
  13
  14           (macro _nmdb_add_tipc_server::int (::_nmdb_t ::int)
  15                  "nmdb_add_tipc_server")
  16           (macro _nmdb_add_tcp_server::int (::_nmdb_t ::string ::int)
  17                  "nmdb_add_tcp_server")
  18           (macro _nmdb_add_udp_server::int (::_nmdb_t ::string ::int)
  19                  "nmdb_add_udp_server")
  20           (macro _nmdb_add_sctp_server::int (::_nmdb_t ::string ::int)
  21                  "nmdb_add_sctp_server")
  22
  23           (macro _nmdb_set::int
  24                  (::_nmdb_t ::string ::uint ::string ::uint)
  25                  "nmdb_set")
  26           (macro _nmdb_set_sync::int
  27                  (::_nmdb_t ::string ::uint ::string ::uint)
  28                  "nmdb_set_sync")
  29           (macro _nmdb_cache_set::int
  30                  (::_nmdb_t ::string ::uint ::string ::uint)
  31                  "nmdb_cache_set")
  32
  33           (macro _nmdb_get::ulong
  34                  (::_nmdb_t ::string ::uint ::string ::uint)
  35                  "nmdb_get")
  36           (macro _nmdb_cache_get::ulong
  37                  (::_nmdb_t ::string ::uint ::string ::uint)
  38                  "nmdb_cache_get")
  39
  40           (macro _nmdb_del::int
  41                  (::_nmdb_t ::string ::uint)
  42                  "nmdb_del")
  43           (macro _nmdb_del_sync::int
  44                  (::_nmdb_t ::string ::uint)
  45                  "nmdb_del_sync")
  46           (macro _nmdb_cache_del::int
  47                  (::_nmdb_t ::string ::uint)
  48                  "nmdb_cache_del")
  49
  50           (macro _nmdb_cas::int
  51                  (::_nmdb_t ::string ::uint ::string ::uint ::string ::uint)
  52                  "nmdb_cas")
  53           (macro _nmdb_cache_cas::int
  54                  (::_nmdb_t ::string ::uint ::string ::uint ::string ::uint)
  55                  "nmdb_cache_cas")
  56
  57           (macro _nmdb_incr::int
  58                  (::_nmdb_t ::string ::uint ::long ::long*)
  59                  "nmdb_incr")
  60           (macro _nmdb_cache_incr::int
  61                  (::_nmdb_t ::string ::uint ::long ::long*)
  62                  "nmdb_cache_incr")
  63
  64           )
  65
  66         (export
  67           (make-nmdb)
  68           (nmdb-free db)
  69
  70           (nmdb-add-tipc-server db port)
  71           (nmdb-add-tcp-server db addr port)
  72           (nmdb-add-udp-server db addr port)
  73           (nmdb-add-sctp-server db addr port)
  74
  75           (nmdb-get db key)
  76           (nmdb-cache-get db key)
  77
  78           (nmdb-set db key val)
  79           (nmdb-set-sync db key val)
  80           (nmdb-cache-set db key val)
  81
  82           (nmdb-del db key)
  83           (nmdb-del-sync db key)
  84           (nmdb-cache-del db key)
  85
  86           (nmdb-cas db key oldval newval)
  87           (nmdb-cache-cas db key oldval newval)
  88
  89           (nmdb-incr db key increment)
  90           (nmdb-cache-incr db key increment)
  91           )
  92
  93         )
  94
  95
  96 ;; creator and destructor
  97 (define (make-nmdb) (_nmdb_init))
  98 (define (nmdb-free db) (_nmdb_free db))
  99
 100 ;; adding servers
 101 (define (nmdb-add-tipc-server db port) (_nmdb_add_tipc_server db port))
 102 (define (nmdb-add-tcp-server db addr port) (_nmdb_add_tcp_server db addr port))
 103 (define (nmdb-add-udp-server db addr port) (_nmdb_add_udp_server db addr port))
 104 (define (nmdb-add-sctp-server db addr port) (_nmdb_add_sctp_server db addr port))
 105
 106 ;; get functions
 107 (define (nmdb-generic-get func db key)
 108   (define buflen (* 70 1024))
 109   (define buf (make-string buflen))
 110   (define vsize (func db key (string-length key) buf buflen))
 111   (if (< vsize 0)
 112     vsize
 113     (substring buf 0 vsize) )
 114   )
 115
 116 (define (nmdb-get db key) (nmdb-generic-get _nmdb_get db key))
 117 (define (nmdb-cache-get db key) (nmdb-generic-get _nmdb_cache_get db key))
 118
 119 ;; set functions
 120 (define (nmdb-generic-set func db key val)
 121   (func db key (string-length key) val (string-length val)) )
 122 (define (nmdb-set db key val)
 123   (nmdb-generic-set _nmdb_set db key val))
 124 (define (nmdb-set-sync db key val)
 125   (nmdb-generic-set _nmdb_set_sync db key val))
 126 (define (nmdb-cache-set db key val)
 127   (nmdb-generic-set _nmdb_cache_set db key val))
 128
 129 ;; del functions
 130 (define (nmdb-generic-del func db key)
 131   (func db key (string-length key)) )
 132 (define (nmdb-del db key)
 133   (nmdb-generic-del _nmdb_del db key))
 134 (define (nmdb-del-sync db key)
 135   (nmdb-generic-del _nmdb_del_sync db key))
 136 (define (nmdb-cache-del db key)
 137   (nmdb-generic-del _nmdb_cache_del db key))
 138
 139 ;; cas functions
 140 (define (nmdb-generic-cas func db key oldval newval)
 141   (func db key (string-length key)
 142         oldval (string-length oldval)
 143         newval (string-length newval) ) )
 144 (define (nmdb-cas db key oldval newval)
 145   (nmdb-generic-cas _nmdb_cas db key oldval newval))
 146 (define (nmdb-cache-cas db key oldval newval)
 147   (nmdb-generic-cas _nmdb_cache_cas db key oldval newval))
 148
 149 ;; incr functions
 150 (define (nmdb-generic-incr func db key increment)
 151   (define newval (make-long* 1))
 152   (define res (func db key (string-length key) increment newval) )
 153   (list res (long*-ref newval 0) ) )
 154 (define (nmdb-incr db key increment)
 155   (nmdb-generic-incr _nmdb_incr db key increment))
 156 (define (nmdb-cache-incr db key increment)
 157   (nmdb-generic-incr _nmdb_cache_incr db key increment))
 158