Esempio n. 1
0
File: read.c Progetto: MassD/ocaml
CAMLprim value unix_read(value fd, value buf, value ofs, value vlen)
{
  intnat len;
  DWORD numbytes, numread;
  char iobuf[UNIX_BUFFER_SIZE];
  DWORD err = 0;

  Begin_root (buf);
    len = Long_val(vlen);
    numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
    if (Descr_kind_val(fd) == KIND_SOCKET) {
      int ret;
      SOCKET s = Socket_val(fd);
      enter_blocking_section();
      ret = recv(s, iobuf, numbytes, 0);
      if (ret == SOCKET_ERROR) err = WSAGetLastError();
      leave_blocking_section();
      numread = ret;
    } else {
      HANDLE h = Handle_val(fd);
      enter_blocking_section();
      if (! ReadFile(h, iobuf, numbytes, &numread, NULL))
        err = GetLastError();
      leave_blocking_section();
    }
    if (err) {
      win32_maperr(err);
      uerror("read", Nothing);
    }
    memmove (&Byte(buf, Long_val(ofs)), iobuf, numread);
  End_roots();
  return Val_int(numread);
}
Esempio n. 2
0
CAMLprim value unix_gethostbyaddr(value a)
{
  struct in_addr adr = GET_INET_ADDR(a);
  struct hostent * hp;
#if HAS_GETHOSTBYADDR_R == 7
  struct hostent h;
  char buffer[NETDB_BUFFER_SIZE];
  int h_errnop;
  enter_blocking_section();
  hp = gethostbyaddr_r((char *) &adr, 4, AF_INET,
                       &h, buffer, sizeof(buffer), &h_errnop);
  leave_blocking_section();
#elif HAS_GETHOSTBYADDR_R == 8
  struct hostent h;
  char buffer[NETDB_BUFFER_SIZE];
  int h_errnop, rc;
  enter_blocking_section();
  rc = gethostbyaddr_r((char *) &adr, 4, AF_INET,
                       &h, buffer, sizeof(buffer), &hp, &h_errnop);
  leave_blocking_section();
  if (rc != 0) hp = NULL;
#else
#ifdef GETHOSTBYADDR_IS_REENTRANT
  enter_blocking_section();
#endif
  hp = gethostbyaddr((char *) &adr, 4, AF_INET);
#ifdef GETHOSTBYADDR_IS_REENTRANT
  leave_blocking_section();
#endif
#endif
  if (hp == (struct hostent *) NULL) raise_not_found();
  return alloc_host_entry(hp);
}
Esempio n. 3
0
CAMLprim value unix_gethostbyname(value name)
{
  struct hostent * hp;
  char * hostname;
#if HAS_GETHOSTBYNAME_R
  struct hostent h;
  char buffer[NETDB_BUFFER_SIZE];
  int err;
#endif

  if (! caml_string_is_c_safe(name)) raise_not_found();

#if HAS_GETHOSTBYNAME_R || GETHOSTBYNAME_IS_REENTRANT
  hostname = caml_strdup(String_val(name));
#else
  hostname = String_val(name);
#endif

#if HAS_GETHOSTBYNAME_R == 5
  {
    enter_blocking_section();
    hp = gethostbyname_r(hostname, &h, buffer, sizeof(buffer), &err);
    leave_blocking_section();
  }
#elif HAS_GETHOSTBYNAME_R == 6
  {
    int rc;
    enter_blocking_section();
    rc = gethostbyname_r(hostname, &h, buffer, sizeof(buffer), &hp, &err);
    leave_blocking_section();
    if (rc != 0) hp = NULL;
  }
#else
#ifdef GETHOSTBYNAME_IS_REENTRANT
  enter_blocking_section();
#endif
  hp = gethostbyname(hostname);
#ifdef GETHOSTBYNAME_IS_REENTRANT
  leave_blocking_section();
#endif
#endif

#if HAS_GETHOSTBYNAME_R || GETHOSTBYNAME_IS_REENTRANT
  stat_free(hostname);
#endif

  if (hp == (struct hostent *) NULL) raise_not_found();
  return alloc_host_entry(hp);
}
Esempio n. 4
0
CAMLprim value unix_recv(value sock, value buff, value ofs, value len,
                         value flags)
{
  SOCKET s = Socket_val(sock);
  int flg = convert_flag_list(flags, msg_flag_table);
  int ret;
  intnat numbytes;
  char iobuf[UNIX_BUFFER_SIZE];
  DWORD err = 0;

  Begin_root (buff);
    numbytes = Long_val(len);
    if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
    enter_blocking_section();
    ret = recv(s, iobuf, (int) numbytes, flg);
    if (ret == -1) err = WSAGetLastError();
    leave_blocking_section();
    if (ret == -1) {
      win32_maperr(err);
      uerror("recv", Nothing);
    }
    memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
  End_roots();
  return Val_int(ret);
}
Esempio n. 5
0
CAMLprim value unix_write(value fd, value buf, value vofs, value vlen)
{
  long ofs, len, written;
  int numbytes, ret;
  char iobuf[UNIX_BUFFER_SIZE];

  Begin_root (buf);
    ofs = Long_val(vofs);
    len = Long_val(vlen);
    written = 0;
    while (len > 0) {
      numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
      memmove (iobuf, &Byte(buf, ofs), numbytes);
      enter_blocking_section();
      ret = write(Int_val(fd), iobuf, numbytes);
      leave_blocking_section();
      if (ret == -1) {
        if ((errno == EAGAIN || errno == EWOULDBLOCK) && written > 0) break;
        uerror("write", Nothing);
      }
      written += ret;
      ofs += ret;
      len -= ret;
    }
  End_roots();
  return Val_long(written);
}
Esempio n. 6
0
CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len,
                             value flags)
{
  int ret, cv_flags;
  long numbytes;
  char iobuf[UNIX_BUFFER_SIZE];
  value res;
  value adr = Val_unit;
  union sock_addr_union addr;
  socklen_param_type addr_len;

  cv_flags = convert_flag_list(flags, msg_flag_table);
  Begin_roots2 (buff, adr);
    numbytes = Long_val(len);
    if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
    addr_len = sizeof(addr);
    enter_blocking_section();
    ret = recvfrom(Int_val(sock), iobuf, (int) numbytes, cv_flags,
                   &addr.s_gen, &addr_len);
    leave_blocking_section();
    if (ret == -1) uerror("recvfrom", Nothing);
    memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
    adr = alloc_sockaddr(&addr, addr_len, -1);
    res = alloc_small(2, 0);
    Field(res, 0) = Val_int(ret);
    Field(res, 1) = adr;
  End_roots();
  return res;
}
Esempio n. 7
0
value ml_ip_job_start(value job_v)
{
  strcpy( (char*) job_hostname, String_val(Field(job_v,0)));

  if(!thread_started){
    int retcode;

    pthread_attr_t attr;
    pthread_attr_init(&attr);
    pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);

    pthread_cond_init(&cond, NULL);
    pthread_mutex_init(&mutex, NULL);

    thread_started = 1;
    retcode = pthread_create(&pthread, &attr, hasher_thread, NULL);

    if(retcode){
      perror("Error while starting Hashing thread");
      exit(2);
    }
  }

  enter_blocking_section();
  pthread_mutex_lock(&mutex);
/*  printf("Starting job\n");  */
  ip_job_done = 0; /* Thread can run ... */
  pthread_cond_signal(&cond);  
  pthread_mutex_unlock(&mutex);
  leave_blocking_section ();

  return Val_unit;
}
Esempio n. 8
0
CAMLprim value win_waitpid(value vflags, value vpid_req)
{
  int flags;
  DWORD status, retcode;
  HANDLE pid_req = (HANDLE) Long_val(vpid_req);
  DWORD err = 0;

  flags = convert_flag_list(vflags, wait_flag_table);
  if ((flags & CAML_WNOHANG) == 0) {
    enter_blocking_section();
    retcode = WaitForSingleObject(pid_req, INFINITE);
    if (retcode == WAIT_FAILED) err = GetLastError();
    leave_blocking_section();
    if (err) {
      win32_maperr(err);
      uerror("waitpid", Nothing);
    }
  }
  if (! GetExitCodeProcess(pid_req, &status)) {
    win32_maperr(GetLastError());
    uerror("waitpid", Nothing);
  }
  if (status == STILL_ACTIVE)
    return alloc_process_status((HANDLE) 0, 0);
  else {
    CloseHandle(pid_req);
    return alloc_process_status(pid_req, status);
  }
}
Esempio n. 9
0
LPWORKER worker_job_submit (WORKERFUNC f, void *user_data)
{
  LPWORKER lpWorker = worker_pop();

#ifdef DBUG
  dbug_print("Waiting for worker to be ready");
#endif
  enter_blocking_section();
  WaitForSingleObject(lpWorker->hWorkerReady, INFINITE);
  ResetEvent(lpWorker->hWorkerReady);
  leave_blocking_section();
#ifdef DBUG
  dbug_print("Worker is ready");
#endif

  lpWorker->hJobFunc      = f;
  lpWorker->lpJobUserData = user_data;
  lpWorker->ECommand      = WORKER_CMD_EXEC;

#ifdef DBUG
  dbug_print("Call worker (func: %x, worker: %x)", f, lpWorker);
#endif
  SetEvent(lpWorker->hCommandReady);

  return (LPWORKER)lpWorker;
}
Esempio n. 10
0
CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len, value flags)
{
    SOCKET s = Socket_val(sock);
    int flg = convert_flag_list(flags, msg_flag_table);
    int ret;
    intnat numbytes;
    char iobuf[UNIX_BUFFER_SIZE];
    value res;
    value adr = Val_unit;
    union sock_addr_union addr;
    socklen_param_type addr_len;
    DWORD err = 0;

    Begin_roots2 (buff, adr);
    numbytes = Long_val(len);
    if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
    addr_len = sizeof(sock_addr);
    enter_blocking_section();
    ret = recvfrom(s, iobuf, (int) numbytes, flg, &addr.s_gen, &addr_len);
    if (ret == -1) err = WSAGetLastError();
    leave_blocking_section();
    if (ret == -1) {
        win32_maperr(err);
        uerror("recvfrom", Nothing);
    }
    memmove (&Byte(buff, Long_val(ofs)), iobuf, ret);
    adr = alloc_sockaddr(&addr, addr_len, -1);
    res = alloc_small(2, 0);
    Field(res, 0) = Val_int(ret);
    Field(res, 1) = adr;
    End_roots();
    return res;
}
Esempio n. 11
0
CAMLprim value stub_sendfile64(value in_fd, value out_fd, value len){
  CAMLparam3(in_fd, out_fd, len);
  CAMLlocal1(result);
  size_t c_len = Int64_val(len);
  size_t bytes;
  int c_in_fd = Int_val(in_fd);
  int c_out_fd = Int_val(out_fd);

  int rc = NOT_IMPLEMENTED;

  enter_blocking_section();

#ifdef __linux__
  rc = TRIED_AND_FAILED;
  bytes = sendfile(c_out_fd, c_in_fd, NULL, c_len);
  if (bytes != -1) rc = OK;
#endif

  leave_blocking_section();

  switch (rc) {
    case NOT_IMPLEMENTED:
      caml_failwith("This platform does not support sendfile()");
      break;
    case TRIED_AND_FAILED:
      uerror("sendfile", Nothing);
      break;
    default: break;
  }
  result = caml_copy_int64(bytes);
  CAMLreturn(result);
}
Esempio n. 12
0
CAMLprim value unix_getnameinfo(value vaddr, value vopts)
{
  CAMLparam0();
  CAMLlocal3(vhost, vserv, vres);
  union sock_addr_union addr;
  socklen_param_type addr_len;
  char host[4096];
  char serv[1024];
  int opts, retcode;

  get_sockaddr(vaddr, &addr, &addr_len);
  opts = convert_flag_list(vopts, getnameinfo_flag_table);
  enter_blocking_section();
  retcode =
    getnameinfo((const struct sockaddr *) &addr.s_gen, addr_len,
                host, sizeof(host), serv, sizeof(serv), opts);
  leave_blocking_section();
  if (retcode != 0) raise_not_found(); /* TODO: detailed error reporting? */
  vhost = copy_string(host);
  vserv = copy_string(serv);
  vres = alloc_small(2, 0);
  Field(vres, 0) = vhost;
  Field(vres, 1) = vserv;
  CAMLreturn(vres);
}
Esempio n. 13
0
CAMLprim value unix_sleep(value t)
{
  enter_blocking_section();
  sleep(Int_val(t));
  leave_blocking_section();
  return Val_unit;
}
Esempio n. 14
0
value unix_sendto_native(value sock, value buff, value ofs, value len, value flags, value dest)
{
    SOCKET s = Socket_val(sock);
    int flg = convert_flag_list(flags, msg_flag_table);
    int ret;
    intnat numbytes;
    char iobuf[UNIX_BUFFER_SIZE];
    union sock_addr_union addr;
    socklen_param_type addr_len;
    DWORD err = 0;

    get_sockaddr(dest, &addr, &addr_len);
    numbytes = Long_val(len);
    if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE;
    memmove (iobuf, &Byte(buff, Long_val(ofs)), numbytes);
    enter_blocking_section();
    ret = sendto(s, iobuf, (int) numbytes, flg, &addr.s_gen, addr_len);
    if (ret == -1) err = WSAGetLastError();
    leave_blocking_section();
    if (ret == -1) {
        win32_maperr(err);
        uerror("sendto", Nothing);
    }
    return Val_int(ret);
}
Esempio n. 15
0
File: win32.c Progetto: OpenXT/ocaml
CAMLprim value caml_thread_delay(value val)
{
  enter_blocking_section();
  Sleep((DWORD)(Double_val(val)*1000)); /* milliseconds */
  leave_blocking_section();
  return Val_unit;
}
Esempio n. 16
0
File: win32.c Progetto: OpenXT/ocaml
CAMLprim value caml_thread_yield(value unit)
{
  enter_blocking_section();
  Sleep(0);
  leave_blocking_section();
  return Val_unit;
}
Esempio n. 17
0
CAMLprim value netsys_openat(value dirfd, value path, value flags, value perm)
{
#ifdef HAVE_AT
    CAMLparam4(dirfd, path, flags, perm);
    int ret, cv_flags;
    char * p;

    /* shamelessly copied from ocaml distro */
    cv_flags = convert_flag_list(flags, open_flag_table);
    p = stat_alloc(string_length(path) + 1);
    strcpy(p, String_val(path));
    enter_blocking_section();
    ret = openat(Int_val(dirfd), p, cv_flags, Int_val(perm));
    leave_blocking_section();
    stat_free(p);
    if (ret == -1) uerror("openat", path);
#if defined(NEED_CLOEXEC_EMULATION) && defined(FD_CLOEXEC)
    if (convert_flag_list(flags, open_cloexec_table) != 0) {
        int flags = fcntl(Int_val(dirfd), F_GETFD, 0);
        if (flags == -1 || fcntl(Int_val(dirfd), F_SETFD, flags | FD_CLOEXEC) == -1)
          uerror("openat", path);
    }
#endif
    CAMLreturn (Val_int(ret));
#else
    invalid_argument("Netsys_posix.openat not available");
#endif
}
Esempio n. 18
0
CAMLprim value onlyWin32_waitpids_ml(value ncount_v, value pid_reqs_v)
{
  int flags,i;
  DWORD status, retcode;
  DWORD err = 0;
  int ncount = Int_val(ncount_v);
  HANDLE* pid_reqs;
  HANDLE pid_req;

  pid_reqs = malloc(sizeof(HANDLE) * ncount);
  for(i=0; i < ncount; i++){
     pid_reqs[i] = (HANDLE) Long_val(Field(pid_reqs_v,i));
  }
  enter_blocking_section();
  retcode = WaitForMultipleObjects(ncount, pid_reqs, FALSE,INFINITE);
  if (retcode == WAIT_FAILED) err = GetLastError();
  leave_blocking_section();
  if (err) {
    free(pid_reqs);
    win32_maperr(err);
    uerror("waitpids", Nothing);
  }
  pid_req = pid_reqs[retcode - WAIT_OBJECT_0];
  free(pid_reqs);
  if (! GetExitCodeProcess(pid_req, &status)) {
    win32_maperr(GetLastError());
    uerror("waitpids", Nothing);
  }
  if (status == STILL_ACTIVE)
    return alloc_process_status((HANDLE) 0, 0);
  else {
    CloseHandle(pid_req);
    return alloc_process_status(pid_req, status);
  }
}
Esempio n. 19
0
CAMLprim value caml_thread_yield(value unit)        /* ML */
{
  if (st_masterlock_waiters(&caml_master_lock) == 0) return Val_unit;
  enter_blocking_section();
  st_thread_yield();
  leave_blocking_section();
  return Val_unit;
}
Esempio n. 20
0
CAMLprim value
sdltimer_delay (value ms)
{
  enter_blocking_section();
  SDL_Delay(Int_val(ms));
  leave_blocking_section();
  return Val_unit;
}
Esempio n. 21
0
void invoke_pending_caml_signals (ClientData clientdata)
{
  signal_events = 0;
  enter_blocking_section(); /* triggers signal handling */
  /* Rearm timer */
  Tk_CreateTimerHandler(SIGNAL_INTERVAL, invoke_pending_caml_signals, NULL);
  signal_events = 1;
  leave_blocking_section();
}
Esempio n. 22
0
void worker_job_finish (LPWORKER lpWorker)
{
  DEBUG_PRINT("Finishing call of worker %x", lpWorker);
  enter_blocking_section();
  WaitForSingleObject(lpWorker->hJobDone, INFINITE);
  leave_blocking_section();

  worker_push(lpWorker);
}
Esempio n. 23
0
value
Pvm_recv(value tid,value msgtag)
{
  enter_blocking_section();
  int res = pvm_recv(Int_val(tid), Int_val(msgtag));
  leave_blocking_section();
  if (res<0) TreatError(res);
  return(Val_int(res));
}
Esempio n. 24
0
CAMLprim value unix_wait(value unit)
{
  int pid, status;

  enter_blocking_section();
  pid = wait(&status);
  leave_blocking_section();
  if (pid == -1) uerror("wait", Nothing);
  return alloc_process_status(pid, status);
}
Esempio n. 25
0
CAMLprim value mlsdlevent_wait(value unit)
{
  int status;
  enter_blocking_section();
  status = SDL_WaitEvent(NULL);
  leave_blocking_section();
  if(! status)
    raise_event_exn(SDL_GetError());
  return Val_unit;
}
Esempio n. 26
0
CAMLprim value caml_mutex_unlock(value mut)
{
  BOOL retcode;
  Begin_root(mut)               /* prevent deallocation of mutex */
    enter_blocking_section();
    retcode = ReleaseMutex(Mutex_val(mut));
    leave_blocking_section();
  End_roots();
  if (!retcode) caml_wthread_error("Mutex.unlock");
  return Val_unit;
}
Esempio n. 27
0
/* The following routines were rewritten 07/14/04 by Paul Pelzl
 * to allow other threads to run while getch() is blocking */
value mlcurses_getch(void)
{
   CAMLparam0();
   int ch;

   enter_blocking_section();
   ch = getch();
   leave_blocking_section();

   CAMLreturn(Val_int(ch));
}
Esempio n. 28
0
CAMLprim value unix_waitpid(value flags, value pid_req)
{
  int pid, status, cv_flags;

  cv_flags = convert_flag_list(flags, wait_flag_table);
  enter_blocking_section();
  pid = waitpid(Int_val(pid_req), &status, cv_flags);
  leave_blocking_section();
  if (pid == -1) uerror("waitpid", Nothing);
  return alloc_process_status(pid, status);
}
Esempio n. 29
0
CAMLprim value unix_sigsuspend(value vset)
{
  sigset_t set;
  int retcode;
  decode_sigset(vset, &set);
  enter_blocking_section();
  retcode = sigsuspend(&set);
  leave_blocking_section();
  if (retcode == -1 && errno != EINTR) uerror("sigsuspend", Nothing);
  return Val_unit;
}
Esempio n. 30
0
void worker_job_finish (LPWORKER lpWorker)
{
#ifdef DBUG
  dbug_print("Finishing call of worker %x", lpWorker);
#endif
  enter_blocking_section();
  WaitForSingleObject(lpWorker->hJobDone, INFINITE);
  leave_blocking_section();

  worker_push(lpWorker);
}