# 1 "src/ctypes-foreign/dl_stubs.c.unix"
/*
 * Copyright (c) 2013 Jeremy Yallop.
 *
 * This file is distributed under the terms of the MIT License.
 * See the file LICENSE for details.
 */

#define _GNU_SOURCE
#include <dlfcn.h>

#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/alloc.h>

#include <assert.h>
#include <stdint.h>

#define Val_none Val_int(0)
#define Some_val(v) Field(v, 0)

enum dl_flags_caml {
  _RTLD_LAZY,
  _RTLD_NOW,
  _RTLD_GLOBAL,
  _RTLD_LOCAL,
#ifdef RTLD_NODELETE
  _RTLD_NODELETE,
#endif /* RTLD_NODELETE */
#ifdef RTLD_NOLOAD
  _RTLD_NOLOAD,
#endif /* RTLD_NOLOAD */
#ifdef RTLD_DEEPBIND
  _RTLD_DEEPBIND,
#endif /* RTLD_DEEPBIND */
};

static value Val_some(value v)
{
    CAMLparam1(v);
    CAMLlocal1(some);
    some = caml_alloc(1, 0);
    Store_field(some, 0, v);
    CAMLreturn(some);
}

/* ctypes_resolve_dl_flag : flag -> int */
value ctypes_resolve_dl_flag(value flag)
{
  int rv;

  switch (Int_val(flag))
  {
    case _RTLD_LAZY:     rv = RTLD_LAZY;     break;
    case _RTLD_NOW:      rv = RTLD_NOW;      break;
    case _RTLD_GLOBAL:   rv = RTLD_GLOBAL;   break;
    case _RTLD_LOCAL:    rv = RTLD_LOCAL;    break;
#ifdef RTLD_NODELETE
    case _RTLD_NODELETE: rv = RTLD_NODELETE; break;
#endif /* RTLD_NODELETE */
#ifdef RTLD_NOLOAD
    case _RTLD_NOLOAD:   rv = RTLD_NOLOAD;   break;
#endif /* RTLD_NOLOAD */
#ifdef RTLD_DEEPBIND
    case _RTLD_DEEPBIND: rv = RTLD_DEEPBIND; break;
#endif /* RTLD_DEEPBIND */
    default: assert(0);
  }

  return Val_long(rv);
}

/* ctypes_dlopen : filename:string -> flags:int -> library option */
value ctypes_dlopen(value filename, value flag)
{
  CAMLparam2(filename, flag);

  const char *cfilename = filename == Val_none ? NULL : String_val(Some_val(filename));
  int cflag = Int_val(flag);

  void *handle = dlopen(cfilename, cflag);
  CAMLreturn (handle != NULL ? Val_some(caml_copy_nativeint((intptr_t)handle)) : Val_none);
}

/* ctypes_dlsym : ?handle:library -> symbol:string -> cvalue option */
value ctypes_dlsym(value handle_option, value symbol)
{
  CAMLparam2(handle_option, symbol);

  void *handle = handle_option == Val_none
    ? RTLD_DEFAULT
    : (void *)Nativeint_val(Some_val(handle_option));

  const char *s = String_val(symbol);
  void *result = dlsym(handle, s);
  CAMLreturn(result == NULL
             ? Val_none
             : Val_some(caml_copy_nativeint((intptr_t)result)));
}


/* ctypes_dlclose : handle:library -> int */
value ctypes_dlclose(value handle)
{
  return Val_long(dlclose((void *)Nativeint_val(handle)));
}

/* ctypes_dlerror : unit -> string option */
value ctypes_dlerror(value unit)
{
  CAMLparam1(unit);
  const char *error = dlerror();
  CAMLreturn (error != NULL ? Val_some(caml_copy_string(error)) : Val_none);
}
