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); }
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); }
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); }
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); }
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); }
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; }
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; }
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); } }
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; }
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; }
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); }
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); }
CAMLprim value unix_sleep(value t) { enter_blocking_section(); sleep(Int_val(t)); leave_blocking_section(); return Val_unit; }
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); }
CAMLprim value caml_thread_delay(value val) { enter_blocking_section(); Sleep((DWORD)(Double_val(val)*1000)); /* milliseconds */ leave_blocking_section(); return Val_unit; }
CAMLprim value caml_thread_yield(value unit) { enter_blocking_section(); Sleep(0); leave_blocking_section(); return Val_unit; }
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 }
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); } }
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; }
CAMLprim value sdltimer_delay (value ms) { enter_blocking_section(); SDL_Delay(Int_val(ms)); leave_blocking_section(); return Val_unit; }
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(); }
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); }
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)); }
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); }
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; }
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; }
/* 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)); }
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); }
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; }
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); }