/*
 * GDBM - The GNU database manager
 * <http://www.gnu.org/software/gdbm/>
 * Copyright (C) 2007  Masayuki Onjo <onjo@lispuser.net>
 * Copyright (C) 2007-2008, 2010-2012, 2018  Sam Steingold <sds@gnu.org>
 * This is Free Software, distributed under the GNU GPL v2+
 */

#include "clisp.h"
#include "config.h"

#include <string.h>             /* memcpy */
#include <unistd.h>             /* for lseek */

#if defined(HAVE_GDBM_H)
# include <gdbm.h>
#elif defined(HAVE_GDBM_GDBM_H)
# include <gdbm/gdbm.h>
#else
# error No GDBM headers!
#endif

/* gotta do it before DEFMODULE */
typedef enum {
  GDBM_DATA_STRING,
  GDBM_DATA_VECTOR,
  /* No support for sub-byte bit vectors because if we do, we have to
   * keep the vector length in the datum too (to avoid having #*10100000
   * retrieved when #*101 was stored), and the length would take a full
   * word which would nix any potential saving from using bits instead
   * of full bytes (this is similar to sub-byte :ELEMENT-TYPE for streams,
   * see <http://clisp.org/impnotes/stream-dict.html#eltype>).
   * Also, Atype_16Bit is not exported from lispbibl.
   *     GDBM_DATA_BIT_VECTOR,
   *     GDBM_DATA_2BIT_VECTOR,
   *     GDBM_DATA_4BIT_VECTOR, */
  GDBM_DATA_8BIT_VECTOR,
  /*     GDBM_DATA_16BIT_VECTOR, */
  GDBM_DATA_32BIT_VECTOR,
  GDBM_DATA_INTEGER,
  GDBM_DATA_SINGLE_FLOAT,
  GDBM_DATA_DOUBLE_FLOAT,
  GDBM_DATA_NOTYPE              /* raise an error on conversion */
} gdbm_data_t;

/* must be distinct from all gdbm_setopt options */
#define GDBM_GETDEFAULT_VALUE_TYPE -1
#define GDBM_SETDEFAULT_VALUE_TYPE GDBM_GETDEFAULT_VALUE_TYPE
#define GDBM_GETDEFAULT_KEY_TYPE   -2
#define GDBM_SETDEFAULT_KEY_TYPE   GDBM_GETDEFAULT_KEY_TYPE

DEFMODULE(gdbm,"GDBM");

/* CL::BIT-VECTOR EXT::2BIT-VECTOR EXT::4BIT-VECTOR EXT::16BIT-VECTOR */
DEFCHECKER(check_data_type, default=GDBM_DATA_NOTYPE, enum=gdbm_data_t, \
           prefix=GDBM_DATA, CL::STRING CL::VECTOR                      \
           EXT::8BIT-VECTOR EXT::32BIT-VECTOR                           \
           CL::INTEGER CL::SINGLE-FLOAT CL::DOUBLE-FLOAT)
DEFCHECKER(check_gdbm_errno, prefix=GDBM, NO-ERROR MALLOC-ERROR              \
           BLOCK-SIZE-ERROR FILE-OPEN-ERROR FILE-WRITE-ERROR FILE-SEEK-ERROR \
           FILE-READ-ERROR BAD-MAGIC-NUMBER EMPTY-DATABASE CANT-BE-READER \
           CANT-BE-WRITER READER-CANT-DELETE READER-CANT-STORE          \
           READER-CANT-REORGANIZE UNKNOWN-ERROR ITEM-NOT-FOUND          \
           REORGANIZE-FAILED CANNOT-REPLACE ILLEGAL-DATA OPT-ALREADY-SET \
           OPT-ILLEGAL BYTE-SWAPPED BAD-FILE-OFFSET BAD-OPEN-FLAGS      \
           FILE-STAT-ERROR FILE-EOF NO-DBNAME ERR-FILE-OWNER ERR-FILE-MODE \
           NEED-RECOVERY BACKUP-FAILED DIR-OVERFLOW BAD-BUCKET BAD-HEADER \
           BAD-AVAIL BAD-HASH-TABLE BAD-DIR-ENTRY)
static _Noreturn void error_gdbm (const char *fatal_message) {
  end_blocking_system_call(); /* in case we are called from _gdbm_fatal() */
  pushSTACK(`GDBM::GDBM-ERROR`);
  pushSTACK(`:MESSAGE`);
  if (fatal_message) {
    pushSTACK(asciz_to_string(fatal_message, GLO(misc_encoding)));
    pushSTACK(S(Kcode)); pushSTACK(`:FATAL`);
  } else {
    pushSTACK(safe_to_string(gdbm_strerror(gdbm_errno)));
    pushSTACK(S(Kcode)); pushSTACK(check_gdbm_errno_reverse(gdbm_errno));
  }
  pushSTACK(`"~S: ~A"`);
  pushSTACK(TheSubr(subr_self)->name);
  pushSTACK(STACK_4); /* message */
  funcall(L(error_of_type), 8);
  NOTREACHED;
}

DEFVAR(gdbm_version_cache,NIL)
DEFUN(GDBM::GDBM-VERSION,)
{ VALUES1(!nullp(O(gdbm_version_cache)) ? O(gdbm_version_cache)
          : (O(gdbm_version_cache) = safe_to_string(gdbm_version))); }

/* can trigger GC */
#define GDBM_SLOT_FILE  1
#define GDBM_SLOT_PATH  2
#define GDBM_SLOT_KEY   3
#define GDBM_SLOT_VAL   4
static GDBM_FILE check_gdbm (gcv_object_t *gdbm, gdbm_data_t *key,
                             gdbm_data_t *val, bool require_valid_handle)
{ /* gdbm is modified, so it has to be a pointer */
  *gdbm = check_classname(*gdbm,`GDBM::GDBM`);
  if (key && *key == GDBM_DATA_NOTYPE)
    *key = (gdbm_data_t)
      posfixnum_to_V(TheStructure(*gdbm)->recdata[GDBM_SLOT_KEY]);
  if (val && *val == GDBM_DATA_NOTYPE)
    *val = (gdbm_data_t)
      posfixnum_to_V(TheStructure(*gdbm)->recdata[GDBM_SLOT_VAL]);
  { object fp = TheStructure(*gdbm)->recdata[GDBM_SLOT_FILE];
    if (fpointerp(fp)) return (GDBM_FILE)TheFpointer(fp)->fp_pointer;
    else if (require_valid_handle) {
      pushSTACK(`GDBM::GDBM-ERROR`);
      pushSTACK(`:MESSAGE`);
      pushSTACK(`"open GDBM file required"`);
      pushSTACK(S(Kcode)); pushSTACK(`:CLOSED-FILE`);
      pushSTACK(`"~S: ~A"`);
      pushSTACK(TheSubr(subr_self)->name);
      pushSTACK(STACK_4); /* message */
      funcall(L(error_of_type), 8);
      NOTREACHED;
    } else return NULL;
  }
}

#define SYSCALL(statement) begin_blocking_system_call(); statement; end_blocking_system_call()

static object open_gdbm (object path, int bsize, int rw, int mode) {
  GDBM_FILE gdbm;
  with_string_0(path, GLO(pathname_encoding), name, {
      SYSCALL(gdbm = gdbm_open(name, bsize, rw, mode, error_gdbm));
    });
  if (gdbm == NULL) error_gdbm(NULL);
  return allocate_fpointer(gdbm);
}

DEFCHECKER(gdbm_open_read_write, default=GDBM_WRCREAT, prefix=GDBM,     \
           READER WRITER WRCREAT NEWDB)
DEFCHECKER(gdbm_open_flags, prefix=GDBM, bitmasks=both, \
           FAST SYNC NOLOCK NOMMAP CLOEXEC BSEXACT)
#if defined(HAVE_GDBM_OPEN)
DEFUN(GDBM::GDBM-OPEN, name &key BLOCKSIZE READ-WRITE \
      OPTIONS MODE DEFAULT-KEY-TYPE DEFAULT-VALUE-TYPE)
{
  gdbm_data_t default_value_type = check_data_type(popSTACK());
  gdbm_data_t default_key_type = check_data_type(popSTACK());
  int mode = check_uint_defaulted(popSTACK(), 0644);
  int rw_opt1 = gdbm_open_flags_of_list(popSTACK());
  int rw_opt2 = gdbm_open_read_write(popSTACK());
  int rw = rw_opt1 | rw_opt2;
  int bsize = check_uint_defaulted(popSTACK(), 512);
  if (typep_classname(STACK_0,`GDBM::GDBM`)) { /* reuse */
    if (!check_gdbm(&STACK_0,&default_key_type,&default_value_type,false)) {
      value1 = open_gdbm(TheStructure(STACK_0)->recdata[GDBM_SLOT_PATH],
                         bsize, rw, mode); /* reopen */
      TheStructure(STACK_0)->recdata[GDBM_SLOT_FILE] = value1;
    }
    TheStructure(STACK_0)->recdata[GDBM_SLOT_KEY]=fixnum(default_key_type);
    TheStructure(STACK_0)->recdata[GDBM_SLOT_VAL]=fixnum(default_value_type);
    VALUES1(popSTACK());        /* return the argument */
    return;
  }
  pushSTACK(open_gdbm(physical_namestring(STACK_0), bsize, rw, mode));
  pushSTACK(STACK_1);         /* path */
  pushSTACK(fixnum(default_key_type));
  pushSTACK(fixnum(default_value_type));
  funcall(`GDBM::MAKE-GDBM`,4);
  STACK_0 = value1;        /* save GDBM object, drop path */
  pushSTACK(STACK_0); pushSTACK(``GDBM::GDBM-CLOSE``);
  funcall(L(finalize),2);
  VALUES1(popSTACK());      /* restore */
}
#endif  /* HAVE_GDBM_OPEN */

#if defined(HAVE_GDBM_CLOSE)
DEFUN(GDBM:GDBM-CLOSE, dbf)
{
  GDBM_FILE dbf = check_gdbm(&STACK_0,NULL,NULL,false);
  if (dbf) {
    SYSCALL(gdbm_close(dbf));
    TheStructure(STACK_0)->recdata[GDBM_SLOT_FILE] = NIL;
    VALUES1(T);
  } else
    VALUES1(NIL);
  skipSTACK(1);
}
#endif  /* HAVE_GDBM_CLOSE */

#if defined(HAVE_GDBM_FDESC)
DEFUN(GDBM:GDBM-FILE-SIZE, dbf)
{
  GDBM_FILE dbf = check_gdbm(&STACK_0,NULL,NULL,true);
  off_t ret;
  SYSCALL(ret = handle_length(NULL,gdbm_fdesc(dbf)));
  VALUES1(off_to_I(ret)); skipSTACK(1);
}
#endif  /* HAVE_GDBM_FDESC */

static object coerce_bitvector (object arg) {
  if (bit_vector_p(Atype_8Bit,arg)) return arg;
  else {
    pushSTACK(arg); pushSTACK(GLO(type_uint8_vector));
    funcall(L(coerce),2);
    if (!bit_vector_p(Atype_8Bit,value1)) { NOTREACHED; }
    return value1;
  }
}

static _Noreturn void error_bad_type (object lisp_obj) {
  pushSTACK(`GDBM::GDBM-ERROR`);
  pushSTACK(`:MESSAGE`);
  pushSTACK(`"invalid lisp object type: "`);
  pushSTACK(lisp_obj); funcall(L(prin1_to_string),1);
  pushSTACK(value1); value1 = string_concat(2); pushSTACK(value1);
  pushSTACK(S(Kcode)); pushSTACK(`:LISP-TYPE`);
  pushSTACK(`"~S: ~A"`);
  pushSTACK(TheSubr(subr_self)->name);
  pushSTACK(STACK_4); /* message */
  funcall(L(error_of_type), 8);
  NOTREACHED;
}

#define with_datum(lisp_obj, datum_var, statement)  do {                \
  datum datum_var;                                                      \
  if (stringp(lisp_obj)) {                                              \
    with_string_0(lisp_obj, GLO(misc_encoding), datum_var##string, {    \
      datum_var.dptr = datum_var##string;                               \
      datum_var.dsize = datum_var##string_len;                          \
      SYSCALL(statement);                                               \
    });                                                                 \
  } else if (bit_vector_p(Atype_32Bit,lisp_obj)) {                      \
    datum_var.dsize = 4 * vector_length(lisp_obj);                      \
    datum_var.dptr = (char*)TheSbvector(lisp_obj)->data;                \
    SYSCALL(statement);                                                 \
  } else if (vectorp(lisp_obj)) { /* assume Atype_8Bit */               \
    lisp_obj = coerce_bitvector(lisp_obj);                              \
    datum_var.dsize = vector_length(lisp_obj);                          \
    datum_var.dptr = (char*)TheSbvector(lisp_obj)->data;                \
    SYSCALL(statement);                                                 \
  } else if (integerp(lisp_obj)) {                                      \
    unsigned long datum_var##bitsize =                                  \
      1 + I_integer_length(lisp_obj); /* an extra bit for the sign */   \
    datum_var.dsize = ceiling(datum_var##bitsize,8);                    \
    datum_var.dptr = (char*)alloca(datum_var.dsize);                    \
    if (I_to_LEbytes(lisp_obj,8*datum_var.dsize,(uintB*)datum_var.dptr)) \
      NOTREACHED; /* there must not be an overflow! */                  \
    SYSCALL(statement);                                                 \
  } else if (single_float_p(lisp_obj)) {                                \
    ffloatjanus datum_var##ffloat;                                      \
    FF_to_c_float(lisp_obj, &datum_var##ffloat);                        \
    datum_var.dptr = (char*)&datum_var##ffloat;                         \
    datum_var.dsize = sizeof(ffloat);                                   \
    SYSCALL(statement);                                                 \
  } else if (double_float_p(lisp_obj)) {                                \
    dfloatjanus datum_var##dfloat;                                      \
    DF_to_c_double(lisp_obj, &datum_var##dfloat);                       \
    datum_var.dptr = (char*)&datum_var##dfloat;                         \
    datum_var.dsize = sizeof(dfloat);                                   \
    SYSCALL(statement);                                                 \
  } else error_bad_type(lisp_obj);                                      \
 } while(0)


DEFCHECKER(gdbm_store_flag, default=GDBM_REPLACE, prefix=GDBM, REPLACE INSERT)
#if defined(HAVE_GDBM_STORE)
DEFUN(GDBM:GDBM-STORE, dbf key content &key FLAG)
{
  GDBM_FILE dbf = check_gdbm(&STACK_3,NULL,NULL,true);
  int flag = gdbm_store_flag(STACK_0), status;
  with_datum(STACK_2, key,
             with_datum(STACK_1, content,
                        status = gdbm_store(dbf, key, content, flag)));
  if (status) error_gdbm(NULL); /* reader call */
  VALUES0; skipSTACK(4);        /* cleanup */
}
#endif  /* HAVE_GDBM_STORE */

/* convert datum to Lisp string and release memory in datum
 can trigger GC */
static object datum_to_object (datum d, gdbm_data_t data_type) {
  if (d.dptr == NULL) return NIL;
  switch (data_type) {
    case GDBM_DATA_STRING: {
      object o = n_char_to_string(d.dptr, d.dsize, GLO(misc_encoding));
      free(d.dptr);
      return o;
    }
    case GDBM_DATA_VECTOR: case GDBM_DATA_8BIT_VECTOR: {
      object o = data_to_sb8vector(d.dptr,d.dsize);
      free(d.dptr);
      return o;
    }
    case GDBM_DATA_32BIT_VECTOR:
      if (d.dsize % 4) {
        pushSTACK(`GDBM::GDBM-ERROR`);
        pushSTACK(`:MESSAGE`);
        pushSTACK(`"32BIT-VECTOR conversion requires a datum length divisible by 4"`);
        pushSTACK(S(Kcode)); pushSTACK(`:DATUM-TYPE`);
        pushSTACK(`"~S: ~A"`);
        pushSTACK(TheSubr(subr_self)->name);
        pushSTACK(STACK_4); /* message */
        funcall(L(error_of_type), 8);
        NOTREACHED;
      } else {
        object o = data_to_sbvector(Atype_32Bit,d.dsize/4,d.dptr,d.dsize);
        free(d.dptr);
        return o;
      }
    case GDBM_DATA_INTEGER: {
      object o = LEbytes_to_I(d.dsize,(uintB*)d.dptr);
      free(d.dptr);
      return o;
    }
    case GDBM_DATA_SINGLE_FLOAT: {
      object o = c_float_to_FF((ffloatjanus*)d.dptr);
      free(d.dptr);
      return o;
    }
    case GDBM_DATA_DOUBLE_FLOAT: {
      object o = c_double_to_DF((dfloatjanus*)d.dptr);
      free(d.dptr);
      return o;
    }
    case GDBM_DATA_NOTYPE:
      pushSTACK(`GDBM::GDBM-ERROR`);
      pushSTACK(`:MESSAGE`);
      pushSTACK(`"desired lisp type not specified"`);
      pushSTACK(S(Kcode)); pushSTACK(`:DATUM-TYPE`);
      pushSTACK(`"~S: ~A"`);
      pushSTACK(TheSubr(subr_self)->name);
      pushSTACK(STACK_4); /* message */
      funcall(L(error_of_type), 8);
      NOTREACHED;
    default: NOTREACHED;        /* pacify the compiler */
  }
}

#if defined(HAVE_GDBM_FETCH)
DEFUN(GDBM:GDBM-FETCH, dbf key &key :TYPE)
{
  gdbm_data_t data_type = check_data_type(popSTACK());
  GDBM_FILE dbf = check_gdbm(&STACK_1,NULL,&data_type,true);
  datum res;
  with_datum(STACK_0, key, res = gdbm_fetch(dbf,key));
  VALUES1(datum_to_object(res,data_type));
  skipSTACK(2);                 /* cleanup */
}
#endif  /* HAVE_GDBM_FETCH */

#if defined(HAVE_GDBM_DELETE)
DEFUN(GDBM:GDBM-DELETE, dbf key)
{
  GDBM_FILE dbf = check_gdbm(&STACK_1,NULL,NULL,true);
  int status;
  with_datum(STACK_0, key, status = gdbm_delete(dbf,key));
  if (status) error_gdbm(NULL); /* reader call */
  VALUES0; skipSTACK(2);        /* cleanup */
}
#endif  /* HAVE_GDBM_DELETE */

#if defined(HAVE_GDBM_FIRSTKEY)
DEFUN(GDBM:GDBM-FIRSTKEY, dbf &key :TYPE)
{
  gdbm_data_t data_type = check_data_type(popSTACK());
  GDBM_FILE dbf = check_gdbm(&STACK_0,&data_type,NULL,true);
  datum res;
  SYSCALL(res = gdbm_firstkey(dbf));
  VALUES1(datum_to_object(res,data_type)); skipSTACK(1);
}
#endif  /* HAVE_GDBM_FIRSTKEY */

#if defined(HAVE_GDBM_NEXTKEY)
DEFUN(GDBM:GDBM-NEXTKEY, dbf key &key :TYPE)
{
  gdbm_data_t data_type = check_data_type(STACK_0);
  GDBM_FILE dbf = check_gdbm(&STACK_2,&data_type,NULL,true);
  datum res;
  with_datum(STACK_1, key, res = gdbm_nextkey(dbf,key));
  VALUES1(datum_to_object(res,data_type));
  skipSTACK(3);                 /* cleanup */
}
#endif  /* HAVE_GDBM_NEXTKEY */

#define CHECK_RUN(statement)  do {              \
    int status;                                 \
    SYSCALL(status = statement);                \
    if (status) error_gdbm(NULL);               \
    else VALUES0;                               \
  } while(0)

#if defined(HAVE_GDBM_REORGANIZE)
DEFUN(GDBM:GDBM-REORGANIZE, dbf)
{
  GDBM_FILE dbf = check_gdbm(&STACK_0,NULL,NULL,true);
  CHECK_RUN(gdbm_reorganize(dbf)); skipSTACK(1);
}
#endif  /* HAVE_GDBM_REORGANIZE */

#if defined(HAVE_GDBM_SYNC)
DEFUN(GDBM:GDBM-SYNC, dbf)
{
  GDBM_FILE dbf = check_gdbm(&STACK_0,NULL,NULL,true);
  SYSCALL(gdbm_sync(dbf));
  VALUES0; skipSTACK(1);
}
#endif  /* HAVE_GDBM_SYNC */

#if defined(HAVE_GDBM_EXISTS)
DEFUN(GDBM:GDBM-EXISTS, dbf key)
{
  GDBM_FILE dbf = check_gdbm(&STACK_1,NULL,NULL,true);
  int status;
  with_datum(STACK_0, key, status = gdbm_exists(dbf, key));
  VALUES_IF(status);
  skipSTACK(2);                 /* cleanup */
}
#endif  /* HAVE_GDBM_EXISTS */

#if defined(HAVE_GDBM_COUNT)
DEFUN(GDBM:GDBM-COUNT, dbf)
{
  GDBM_FILE dbf = check_gdbm(&STACK_0,NULL,NULL,true);
  unsigned long long int count; /* gdbm_count_t */
  int status;
  SYSCALL(status = gdbm_count(dbf, &count));
  if (status) error_gdbm(NULL);
  VALUES1(uint64_to_I(count));
  skipSTACK(1);                 /* cleanup */
}
#endif  /* HAVE_GDBM_COUNT */

DEFCHECKER(gdbm_getopt_option, prefix=GDBM_GET, delim=, default=,   \
           FLAGS MMAP CACHESIZE SYNCMODE CENTFREE                   \
           COALESCEBLKS MAXMAPSIZE DBNAME BLOCKSIZE                 \
           DEFAULT-VALUE-TYPE DEFAULT-KEY-TYPE)
DEFUN(GDBM:GDBM-OPT, dbf option)
{
  gdbm_data_t key = GDBM_DATA_NOTYPE;
  gdbm_data_t val = GDBM_DATA_NOTYPE;
  GDBM_FILE dbf = check_gdbm(&STACK_1,&key,&val,true);
  int option = gdbm_getopt_option(STACK_0);
  switch (option) {
    case GDBM_GETDEFAULT_KEY_TYPE:
      VALUES1(check_data_type_reverse(key));
      break;
    case GDBM_GETDEFAULT_VALUE_TYPE:
      VALUES1(check_data_type_reverse(val));
      break;
    default:
#    if defined(HAVE_GDBM_SETOPT)
      switch (option) {
#      ifdef GDBM_GETFLAGS
        case GDBM_GETFLAGS: {
          int v;
          CHECK_RUN(gdbm_setopt(dbf, option, &v, sizeof(v)));
          STACK_0 = gdbm_open_read_write_reverse(v & GDBM_OPENMASK);
          value1 = gdbm_open_flags_to_list(v & ~GDBM_OPENMASK);
          STACK_1 = value1;
          value1 = allocate_cons();
          Car(value1) = STACK_0;
          Cdr(value1) = STACK_1;
          mv_count = 1;
        } break;
#      endif
#      if defined(GDBM_GETCACHESIZE) && defined(GDBM_GETMAXMAPSIZE)
        case GDBM_GETCACHESIZE: case GDBM_GETMAXMAPSIZE: {
          size_t v;
          CHECK_RUN(gdbm_setopt(dbf, option, &v, sizeof(v)));
          VALUES1(size_to_I(v));
        } break;
#      endif
#      ifdef GDBM_GETBLOCKSIZE
        case GDBM_GETBLOCKSIZE: {
          int v;
          CHECK_RUN(gdbm_setopt(dbf, option, &v, sizeof(v)));
          VALUES1(sint_to_I(v));
        } break;
#      endif
#      if defined(GDBM_GETMMAP) && defined(GDBM_GETCENTFREE) && defined(GDBM_GETCENTFREE) && defined(GDBM_GETCOALESCEBLKS)
        case GDBM_GETMMAP: case GDBM_GETSYNCMODE:
        case GDBM_GETCENTFREE: case GDBM_GETCOALESCEBLKS: {
          int v;
          CHECK_RUN(gdbm_setopt(dbf, option, &v, sizeof(v)));
          VALUES_IF(v);
        } break;
#      endif
#      ifdef GDBM_GETDBNAME
        case GDBM_GETDBNAME: {
          char *v;
          CHECK_RUN(gdbm_setopt(dbf, option, &v, sizeof(v)));
          VALUES1(asciz_to_string(v,GLO(pathname_encoding)));
          begin_system_call(); free(v); end_system_call();
        } break;
#      endif
        default: NOTREACHED;
      }
#    else
      NOTREACHED;
#    endif  /* HAVE_GDBM_SETOPT */
  }
  skipSTACK(2);
}

DEFCHECKER(gdbm_setopt_option, prefix=GDBM_SET, delim=, default=,   \
           CACHESIZE SYNCMODE CENTFREE COALESCEBLKS MAXMAPSIZE MMAP \
           DEFAULT-VALUE-TYPE DEFAULT-KEY-TYPE)
DEFUN(GDBM::%SET-GDBM-OPT, dbf option value)
{
  GDBM_FILE dbf = check_gdbm(&STACK_2,NULL,NULL,true);
  int option = gdbm_setopt_option(STACK_1);
  int v;
  switch (option) {
    case GDBM_SETDEFAULT_VALUE_TYPE: v = GDBM_SLOT_VAL; goto gdbm_setopt_slot;
    case GDBM_SETDEFAULT_KEY_TYPE: v = GDBM_SLOT_KEY; gdbm_setopt_slot:
      value1 = fixnum(check_data_type(STACK_0));
      TheStructure(STACK_2)->recdata[v] = value1;
      break;
# if defined(HAVE_GDBM_SETOPT)
#  ifdef GDBM_SETCACHESIZE
    case GDBM_SETCACHESIZE:
#  endif
#  ifdef GDBM_SETMAXMAPSIZE
    case GDBM_SETMAXMAPSIZE:
#  endif
      v = I_to_sint(check_sint(STACK_0));
      goto gdbm_setopt_common;
#  ifdef GDBM_SETSYNCMODE
    case GDBM_SETSYNCMODE:
#  endif
#  ifdef GDBM_SETMMAP
    case GDBM_SETMMAP:
#  endif
#  ifdef GDBM_SETCENTFREE
    case GDBM_SETCENTFREE:
#  endif
#  ifdef GDBM_SETCOALESCEBLKS
    case GDBM_SETCOALESCEBLKS:
#  endif
      v = !nullp(STACK_0);
    gdbm_setopt_common:
      CHECK_RUN(gdbm_setopt(dbf, option, &v, sizeof(v)));
      break;
# endif
    default: NOTREACHED;
  }
  VALUES1(STACK_0);
  skipSTACK(3);
}
