Exemple #1
0
CAMLprim value getFileInfos (value path, value need_size) {
#ifdef __APPLE__

  CAMLparam1(path);
  CAMLlocal3(res, fInfo, length);
  int retcode;
  struct attrlist attrList;
  unsigned long options = FSOPT_REPORT_FULLSIZE;
  struct {
    u_int32_t length;
    char      finderInfo [32];
    off_t     rsrcLength;
  } __attribute__ ((packed)) attrBuf;

  attrList.bitmapcount = ATTR_BIT_MAP_COUNT;
  attrList.reserved = 0;
  attrList.commonattr = ATTR_CMN_FNDRINFO;
  attrList.volattr = 0;     /* volume attribute group */
  attrList.dirattr = 0;     /* directory attribute group */
  if (Bool_val (need_size))
    attrList.fileattr = ATTR_FILE_RSRCLENGTH;    /* file attribute group */
  else
    attrList.fileattr = 0;
  attrList.forkattr = 0;    /* fork attribute group */

  retcode = getattrlist(String_val (path), &attrList, &attrBuf,
                        sizeof attrBuf, options);

  if (retcode == -1) uerror("getattrlist", path);

  if (Bool_val (need_size)) {
    if (attrBuf.length != sizeof attrBuf)
      unix_error (EINVAL, "getattrlist", path);
  } else {
    if (attrBuf.length != sizeof (u_int32_t) + 32)
      unix_error (EINVAL, "getattrlist", path);
  }

  fInfo = alloc_string (32);
  memcpy (String_val (fInfo), attrBuf.finderInfo, 32);
  if (Bool_val (need_size))
    length = copy_int64 (attrBuf.rsrcLength);
  else
    length = copy_int64 (0);

  res = alloc_small (2, 0);
  Field (res, 0) = fInfo;
  Field (res, 1) = length;

  CAMLreturn (res);

#else

  unix_error (ENOSYS, "getattrlist", path);

#endif
}
Exemple #2
0
CAMLprim value netsys_int64_of_file_descr(value fd) {
#ifdef _WIN32
    switch (Descr_kind_val(fd)) {
    case KIND_HANDLE:
	return copy_int64((intnat) (Handle_val(fd)));
    case KIND_SOCKET:
	return copy_int64((intnat) (Socket_val(fd)));
    }
    return copy_int64(0);
#else
    return copy_int64(Long_val(fd));
#endif
}
Exemple #3
0
value
c_int64_of_indexed_bytes(value s, value index)
{
  CAMLparam2 (s, index);
  int64_t *x = (int64_t*)(String_val(s) + Int_val(index));
  CAMLreturn (copy_int64(*x));
}
CAMLprim value unix_lseek_64(value fd, value ofs, value cmd)
{
  __int64 ret;

  ret = caml_set_file_pointer(Handle_val(fd), Int64_val(ofs),
                              seek_command_table[Int_val(cmd)]);
  return copy_int64(ret);
}
Exemple #5
0
CAMLprim value
int56_of_int128(value v)
{
  CAMLparam1(v);
#ifdef HAVE_INT128
  CAMLreturn (copy_int64(((int64_t)Int128_val(v)) << 8));
#else
  failwith("unimplemented");
  CAMLreturn(Val_unit);
#endif
}
extern CAMLprim
value kc_count(value caml_db)
{
  CAMLparam1(caml_db);
  CAMLlocal1(val);

  KCDB* db = get_db(caml_db);
  int64_t count = kcdbcount(db);
  val = copy_int64(count);
  
  CAMLreturn(val);
}
Exemple #7
0
value
c_uint32_of_indexed_bytes(value s, value index)
{
  CAMLparam2 (s, index);
  uint32_t *x = (uint32_t*)(String_val(s) + Int_val(index));

  /* since OCaml doesn't have unsigned integers,
   * we represent it as 64bit signed int to make sure it doesn't overflow
   */
  int64_t y = *x;
  CAMLreturn (copy_int64(y));
}
extern CAMLprim
value kc_size(value caml_db)
{
  CAMLparam1(caml_db);
  CAMLlocal1(val);

  KCDB* db = get_db(caml_db);
  int64_t size = kcdbsize(db);
  val = copy_int64(size);
  
  CAMLreturn(val);
}
Exemple #9
0
static value
copy_statfs (struct statfs *buf)
{
  CAMLparam0 ();
  CAMLlocal2 (bufv, v);
  bufv = caml_alloc (11, 0);
  v = copy_int64 (buf->f_type); caml_modify (&Field (bufv, 0), v);
  v = copy_int64 (buf->f_bsize); caml_modify (&Field (bufv, 1), v);
  v = copy_int64 (buf->f_blocks); caml_modify (&Field (bufv, 2), v);
  v = copy_int64 (buf->f_bfree); caml_modify (&Field (bufv, 3), v);
  v = copy_int64 (buf->f_bavail); caml_modify (&Field (bufv, 4), v);
  v = copy_int64 (buf->f_files); caml_modify (&Field (bufv, 5), v);
  v = copy_int64 (buf->f_ffree); caml_modify (&Field (bufv, 6), v);
  v = copy_int64 (buf->f_namelen); caml_modify (&Field (bufv, 8), v);
  v = copy_string ("-1"); caml_modify (&Field (bufv, 9), v);
  v = copy_int64 (-1); caml_modify (&Field (bufv, 10), v);
  CAMLreturn (bufv);
}
Exemple #10
0
value
c_int64_of_indexed_bytes(value s, value index)
{
  CAMLparam2 (s, index);
  char *x = (char *)(String_val(s) + Int_val(index));

  union { char b[sizeof(int64_t)]; int64_t i; } buffer;
  int i;
  for (i=0; i < sizeof(int64_t); i++) {
    buffer.b[i] = x[i];
  }
  CAMLreturn (copy_int64(buffer.i));
}
Exemple #11
0
CAMLprim value
stub_pcap_stats (value p_p)
{
	CAMLparam1 (p_p);
	CAMLlocal1 (ret);
	pcap_t *p;
	struct pcap_stat ps;

	p = (pcap_t *) p_p;

	if (pcap_stats(p, &ps)) {
		raise_error (pcap_geterr (p));
	}

	ret = caml_alloc (3, 0);

	Store_field (ret, 0, copy_int64 (ps.ps_recv));
	Store_field (ret, 1, copy_int64 (ps.ps_drop));
	Store_field (ret, 2, copy_int64 (ps.ps_ifdrop));

	CAMLreturn (ret);
}
Exemple #12
0
value camlidl_libbfd_bfd_section_get_flags(
	value _v_s)
{
  section_ptr s; /*in*/
  long long _res;
  value _vres;

  struct camlidl_ctx_struct _ctxs = { CAMLIDL_TRANSIENT, NULL };
  camlidl_ctx _ctx = &_ctxs;
  camlidl_ml2c_libbfd_section_ptr(_v_s, &s, _ctx);
  _res = bfd_section_get_flags(s);
  _vres = copy_int64(_res);
  camlidl_free(_ctx);
  return _vres;
}
Exemple #13
0
value camlidl_c2ml_libbfd_struct_bfd_symbol(struct bfd_symbol * _c1, camlidl_ctx _ctx)
{
  value _v2;
  value _v3[5];
  memset(_v3, 0, 5 * sizeof(value));
  Begin_roots_block(_v3, 5)
    _v3[0] = camlidl_c2ml_libbfd_bfdp(&(*_c1).the_bfd, _ctx);
    _v3[1] = copy_string((*_c1).name);
    _v3[2] = copy_int64((*_c1).value);
    _v3[3] = Val_int((*_c1).flags);
    _v3[4] = camlidl_c2ml_libbfd_section_ptr(&(*_c1).section, _ctx);
    _v2 = camlidl_alloc_small(5, 0);
    { mlsize_t _c4;
      for (_c4 = 0; _c4 < 5; _c4++) Field(_v2, _c4) = _v3[_c4];
    }
  End_roots()
  return _v2;
}
Exemple #14
0
static value stat_aux(int use_64, struct _stati64 *buf)
{
  CAMLparam0 ();
  CAMLlocal1 (v);

  v = caml_alloc (12, 0);
  Store_field (v, 0, Val_int (buf->st_dev));
  Store_field (v, 1, Val_int (buf->st_ino));
  Store_field (v, 2, cst_to_constr (buf->st_mode & S_IFMT, file_kind_table,
                                    sizeof(file_kind_table) / sizeof(int), 0));
  Store_field (v, 3, Val_int(buf->st_mode & 07777));
  Store_field (v, 4, Val_int (buf->st_nlink));
  Store_field (v, 5, Val_int (buf->st_uid));
  Store_field (v, 6, Val_int (buf->st_gid));
  Store_field (v, 7, Val_int (buf->st_rdev));
  Store_field (v, 8,
               use_64 ? copy_int64(buf->st_size) : Val_int (buf->st_size));
  Store_field (v, 9, copy_double((double) buf->st_atime));
  Store_field (v, 10, copy_double((double) buf->st_mtime));
  Store_field (v, 11, copy_double((double) buf->st_ctime));
  CAMLreturn (v);
}
Exemple #15
0
value load_int64(value v_string, value v_off)
{
    CAMLparam2(v_string, v_off);
    CAMLlocal1(result);
    int off, len;
    char *str;
    int64 i;

    /* Get arguments */
    str = String_val(v_string);
    len = string_length(v_string);
    off = Int_val(v_off);

    /* Check bounds */
    if(off < 0 || off > len - 8 || off & 3)
        failwith("load_int64");

    /* Get the number */
    i = *(int64 *)(str + off);
    result = copy_int64(i);
    CAMLreturn(result);
}
Exemple #16
0
value camlidl_c2ml_libbfd_bfd_size_type(bfd_size_type * _c2, camlidl_ctx _ctx)
{
value _v1;
  _v1 = copy_int64((*_c2));
  return _v1;
}
Exemple #17
0
value caml_bgzf_tell(value bgzf) {
	CAMLparam1(bgzf);
	CAMLreturn(copy_int64(bgzf_tell(BGZF_val(bgzf))));
}
Exemple #18
0
CAMLprim value
int56_of_int64(value v)
{
  CAMLparam1(v);
  CAMLreturn (copy_int64(((int64_t)Int64_val(v)) << 8));
}
Exemple #19
0
value get_perf_frequency()
{
  LARGE_INTEGER  fr;
  QueryPerformanceFrequency(&fr);
  return copy_int64(fr.QuadPart);
}
Exemple #20
0
CAMLprim value
int56_of_nativeint(value v)
{
  CAMLparam1(v);
  CAMLreturn (copy_int64(((int64_t)Nativeint_val(v)) << 8));
}
Exemple #21
0
CAMLprim value
int56_of_float(value v)
{
  CAMLparam1(v);
  CAMLreturn (copy_int64(((int64_t)Double_val(v)) << 8));
}
Exemple #22
0
value get_perf_counter() 
{
  LARGE_INTEGER  cnt;
  QueryPerformanceCounter(&cnt);
  return copy_int64(cnt.QuadPart);
}
Exemple #23
0
CAMLprim value
int64_of_int48(value v)
{
  CAMLparam1(v);
  CAMLreturn (copy_int64((int64_t)Int48_val(v)));
}
Exemple #24
0
value camlidl_c2ml_libbfd_file_ptr(file_ptr * _c2, camlidl_ctx _ctx)
{
value _v1;
  _v1 = copy_int64((*_c2));
  return _v1;
}
Exemple #25
0
value ml_getfdsize64(value fd_v)
{
/*  int ret; */
  OS_FD fd = Fd_val(fd_v);
  return copy_int64(os_getfdsize(fd));
}
Exemple #26
0
copy_statfs (struct statfs *buf)
#endif  /* ((defined (sun) || defined (__sun__))) || (defined(__NetBSD__) && (__NetBSD_Version__ > 299000000)) || defined (__hpux__) */
{
  CAMLparam0 ();
  CAMLlocal2 (bufv, v);
  bufv = caml_alloc (11, 0);
#if ((defined (sun) || defined (__sun__))) || (defined(__FreeBSD__) && __FreeBSD_version >= 503001) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__alpha__)
  v = copy_int64 (-1); caml_modify (&Field (bufv, 0), v);
#else
  v = copy_int64 (buf->f_type); caml_modify (&Field (bufv, 0), v);
#endif  /* ((defined (sun) || defined (__sun__))) || (defined(__FreeBSD__) && __FreeBSD_version >= 503001) || defined(__OpenBSD__) || defined(__NetBSD__) */
  v = copy_int64 (buf->f_bsize); caml_modify (&Field (bufv, 1), v);
  v = copy_int64 (buf->f_blocks); caml_modify (&Field (bufv, 2), v);
  v = copy_int64 (buf->f_bfree); caml_modify (&Field (bufv, 3), v);
  v = copy_int64 (buf->f_bavail); caml_modify (&Field (bufv, 4), v);
  v = copy_int64 (buf->f_files); caml_modify (&Field (bufv, 5), v);
  v = copy_int64 (buf->f_ffree); caml_modify (&Field (bufv, 6), v);
#if ((defined (sun) || defined (__sun__))) || defined (__hpux__) || defined(__alpha__)
  v = copy_int64 (-1); caml_modify (&Field (bufv, 7), v);
  v = copy_int64 (buf->f_namemax); caml_modify (&Field (bufv, 8), v);
# if ! defined(__alpha__)
  v = copy_string (buf->f_basetype); caml_modify (&Field (bufv, 9), v);
# else
  v = copy_string ("-1"); caml_modify (&Field (bufv, 9), v);
# endif
  v = copy_int64 (buf->f_frsize); caml_modify (&Field (bufv, 10), v);
#else
#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__APPLE__) || defined(__DragonFly__) || defined(__FreeBSD_kernel__)
#  if defined(__OpenBSD__) || defined(__NetBSD__) || (defined(__FreeBSD__) && __FreeBSD_version < 502000) || defined(__DragonFly__) || defined(__APPLE__)
#    include <sys/syslimits.h>
     v = copy_int64 (NAME_MAX); caml_modify (&Field (bufv, 8), v);
#  else
     v = copy_int64 (buf->f_namemax); caml_modify (&Field (bufv, 8), v);
#  endif /* (__OpenBSD__) || defined(__NetBSD__) || (defined(__FreeBSD__) && __FreeBSD_version < 502000) */
  v = copy_string (buf->f_fstypename); caml_modify (&Field (bufv, 9), v);
#else
  v = copy_int64 (buf->f_namelen); caml_modify (&Field (bufv, 8), v);
  v = copy_string ("-1"); caml_modify (&Field (bufv, 9), v);
#endif /* defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__APPLE__) */
  caml_modify (&Field (bufv, 7), Val_unit);
  v = copy_int64 (-1); caml_modify (&Field (bufv, 10), v);
#endif /*  ((defined (sun) || defined (__sun__))) || defined (__hpux__) */
  CAMLreturn (bufv);
}
Exemple #27
0
value ml_getsize64(value path)
{
/*  int ret; */

  return copy_int64(os_getfilesize(String_val(path)));
}
Exemple #28
0
CAMLprim value win_stat(value path, value wpath)
{
  int res, mode;
  HANDLE h;
  BY_HANDLE_FILE_INFORMATION info;
  CAMLparam2(path,wpath);
  CAMLlocal1 (v);

  h = CreateFileW ((LPCWSTR) String_val (wpath), 0, 0, NULL, OPEN_EXISTING,
		   FILE_FLAG_BACKUP_SEMANTICS | FILE_ATTRIBUTE_READONLY, NULL);

  if (h == INVALID_HANDLE_VALUE) {
    win32_maperr (GetLastError ());
    uerror("stat", path);
  }

  res = GetFileInformationByHandle (h, &info);
  if (res == 0) {
    win32_maperr (GetLastError ());
    (void) CloseHandle (h);
    uerror("stat", path);
  }

  res = CloseHandle (h);
  if (res == 0) {
    win32_maperr (GetLastError ());
    uerror("stat", path);
  }

  v = caml_alloc (12, 0);
  Store_field (v, 0, Val_int (info.dwVolumeSerialNumber));

  // Apparently, we cannot trust the inode number to be stable when
  // nFileIndexHigh is 0.
  if (info.nFileIndexHigh == 0) info.nFileIndexLow = 0;
  /* The ocaml code truncates inode numbers to 31 bits.  We hash the
     low and high parts in order to lose as little information as
     possible. */
  Store_field
    (v, 1, Val_int (MAKEDWORDLONG(info.nFileIndexLow,info.nFileIndexHigh)+155825701*((DWORDLONG)info.nFileIndexHigh)));
  Store_field
    (v, 2, Val_int (info.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY
		    ? 1: 0));
  mode = 0000444;
  if (info.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
    mode |= 0000111;
  if (!(info.dwFileAttributes & FILE_ATTRIBUTE_READONLY))
    mode |= 0000222;
  Store_field (v, 3, Val_int(mode));
  Store_field (v, 4, Val_int (info.nNumberOfLinks));
  Store_field (v, 5, Val_int (0));
  Store_field (v, 6, Val_int (0));
  Store_field (v, 7, Val_int (0));
  Store_field
    (v, 8, copy_int64(MAKEDWORDLONG(info.nFileSizeLow,info.nFileSizeHigh)));
  Store_field
    (v, 9, copy_double((double) FILETIME_TO_TIME(info.ftLastAccessTime)));
  Store_field
    (v, 10, copy_double((double) FILETIME_TO_TIME(info.ftLastWriteTime)));
  Store_field
    (v, 11, copy_double((double) FILETIME_TO_TIME(info.ftCreationTime)));

  CAMLreturn (v);
}
/* t -> int64 */
CAMLprim value llvm_genericvalue_as_int64(value GenVal) {
  CAMLparam1(GenVal);
  assert(LLVMGenericValueIntWidth(Genericvalue_val(GenVal)) <= 64
         && "Generic value too wide to treat as an int64!");
  CAMLreturn(copy_int64(LLVMGenericValueToInt(Genericvalue_val(GenVal), 1)));
}
Exemple #30
0
CAMLprim value
int64_of_uint64(value v)
{
  CAMLparam1(v);
  CAMLreturn (copy_int64((int64_t)Uint64_val(v)));
}