CAMLprim value win_check_connection (value socket, value kind, value idx) { CAMLparam3 (socket, kind, idx); WSANETWORKEVENTS evs; int res, err, i = Long_val(idx); D(printf("Check connection... %d\n", i)); if (WSAEnumNetworkEvents(Socket_val(socket), NULL, &evs)) { win32_maperr(WSAGetLastError ()); uerror("WSAEnumNetworkEvents", Nothing); } if (WSAEventSelect(Socket_val(socket), NULL, 0) == SOCKET_ERROR) { win32_maperr(WSAGetLastError ()); uerror("WSAEventSelect", Nothing); } if (!CloseHandle(events[i])) { win32_maperr(GetLastError ()); uerror("CloseHandle", Nothing); } err = evs.iErrorCode[(Long_val(kind) == 0) ? FD_CONNECT_BIT : FD_ACCEPT_BIT]; D(printf("Check connection: %ld, err %d\n", evs.lNetworkEvents, err)); if (err != 0) { win32_maperr(err); uerror("check_connection", Nothing); } CAMLreturn (Val_unit); }
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 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); } }
CAMLprim value w_create_process_native (value prog, value wprog, value wargs, value fd1, value fd2, value fd3) { int res, flags; PROCESS_INFORMATION pi; STARTUPINFOW si; wchar_t fullname [MAX_PATH]; HANDLE h; CAMLparam5(wprog, wargs, fd1, fd2, fd3); res = SearchPathW (NULL, (LPCWSTR) String_val(wprog), L".exe", MAX_PATH, fullname, NULL); if (res == 0) { win32_maperr (GetLastError ()); uerror("create_process", prog); } ZeroMemory(&si, sizeof(STARTUPINFO)); si.cb = sizeof(STARTUPINFO); si.dwFlags = STARTF_USESTDHANDLES; si.hStdInput = Handle_val(fd1); si.hStdOutput = Handle_val(fd2); si.hStdError = Handle_val(fd3); flags = GetPriorityClass (GetCurrentProcess ()); /* h = CreateFile ("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (h != INVALID_HANDLE_VALUE) CloseHandle (h); else { flags |= CREATE_NEW_CONSOLE; // si.dwFlags |= STARTF_USESHOWWINDOW; // si.wShowWindow = SW_MINIMIZE; } */ res = CreateProcessW (fullname, (LPWSTR) String_val(wargs), NULL, NULL, TRUE, flags, NULL, NULL, &si, &pi); if (res == 0) { win32_maperr (GetLastError ()); uerror("create_process", prog); } CloseHandle (pi.hThread); CAMLreturn (Val_long (pi.hProcess)); }
CAMLprim value unix_close(value fd) { if (Descr_kind_val(fd) == KIND_SOCKET) { if (closesocket(Socket_val(fd)) != 0) { win32_maperr(WSAGetLastError()); uerror("close", Nothing); } } else { if (! CloseHandle(Handle_val(fd))) { win32_maperr(GetLastError()); uerror("close", Nothing); } } return Val_unit; }
CAMLprim value win_findfirstw(value name) { HANDLE h; WIN32_FIND_DATAW fileinfo; CAMLparam1(name); CAMLlocal3(v, valname, valh); h = FindFirstFileW((LPCWSTR) String_val(name),&fileinfo); if (h == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); if ((err == ERROR_NO_MORE_FILES) || (err == ERROR_FILE_NOT_FOUND)) raise_end_of_file(); else { win32_maperr(err); uerror("opendir", Nothing); } } valname = copy_wstring(fileinfo.cFileName); valh = win_alloc_handle(h); v = alloc_small(2, 0); Field(v,0) = valname; Field(v,1) = valh; CAMLreturn (v); }
/* Free select data */ void select_data_free (LPSELECTDATA lpSelectData) { DWORD i; #ifdef DBUG dbug_print("Freeing data of %x", lpSelectData); #endif /* Free APC related data, if they exists */ if (lpSelectData->lpWorker != NULL) { worker_job_finish(lpSelectData->lpWorker); lpSelectData->lpWorker = NULL; }; /* Make sure results/queries cannot be accessed */ lpSelectData->nResultsCount = 0; lpSelectData->nQueriesCount = 0; if (!HeapLock(GetProcessHeap())) { win32_maperr(GetLastError()); uerror("select_data_free", Nothing); }; HeapFree(GetProcessHeap(), 0, lpSelectData); HeapUnlock(GetProcessHeap()); }
/* Create data associated with a select operation */ LPSELECTDATA select_data_new (LPSELECTDATA lpSelectData, SELECTTYPE EType) { /* Allocate the data structure */ LPSELECTDATA res; DWORD i; if (!HeapLock(GetProcessHeap())) { win32_maperr(GetLastError()); uerror("select", Nothing); } res = (LPSELECTDATA)HeapAlloc(GetProcessHeap(), 0, sizeof(SELECTDATA)); HeapUnlock(GetProcessHeap()); /* Init common data */ list_init((LPLIST)res); list_next_set((LPLIST)res, (LPLIST)lpSelectData); res->EType = EType; res->nResultsCount = 0; /* Data following are dedicated to APC like call, they will be initialized if required. For now they are set to invalid values. */ res->funcWorker = NULL; res->nQueriesCount = 0; res->EState = SELECT_STATE_NONE; res->nError = 0; res->lpWorker = NULL; return res; }
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); }
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 lwt_unix_read(value fd, value buf, value vofs, value vlen) { intnat ofs, len, written; DWORD numbytes, numwritten; DWORD err = 0; Begin_root (buf); ofs = Long_val(vofs); len = Long_val(vlen); written = 0; if (len > 0) { numbytes = len; if (Descr_kind_val(fd) == KIND_SOCKET) { int ret; SOCKET s = Socket_val(fd); ret = recv(s, &Byte(buf, ofs), numbytes, 0); if (ret == SOCKET_ERROR) err = WSAGetLastError(); numwritten = ret; } else { HANDLE h = Handle_val(fd); if (! ReadFile(h, &Byte(buf, ofs), numbytes, &numwritten, NULL)) err = GetLastError(); } if (err) { win32_maperr(err); uerror("write", Nothing); } written = numwritten; } End_roots(); return Val_long(written); }
CAMLprim value stub_ba_send(value fd, value val_buf, value val_ofs, value val_len) { CAMLparam4(fd, val_buf, val_ofs, val_len); int ret = 0; #ifdef WIN32 char *data = (char*)Caml_ba_data_val(val_buf) + Long_val(val_ofs); size_t c_len = Int_val(val_len); SOCKET s = Socket_val(fd); DWORD err = 0; caml_release_runtime_system(); ret = send(s, data, c_len, 0); if (ret == SOCKET_ERROR) err = WSAGetLastError(); caml_acquire_runtime_system(); if (err) { win32_maperr(err); uerror("read", Nothing); } #else caml_failwith("AF_HYPERV only available on Windows"); #endif CAMLreturn(Val_int(ret)); }
value onlyWin32_getFileInformationByHandle_ml(value handle_v) { HANDLE handle = (HANDLE)handle_v; BY_HANDLE_FILE_INFORMATION fileInfo; CAMLparam0 (); CAMLlocal1 (v); ULARGE_INTEGER size, index; if( !GetFileInformationByHandle(handle, &fileInfo) ){ DWORD err = GetLastError(); win32_maperr(err); uerror("GetFileInformationByHandle", Nothing); } size.HighPart = fileInfo.nFileSizeHigh; size.LowPart = fileInfo.nFileSizeLow; index.HighPart = fileInfo.nFileIndexHigh; index.LowPart = fileInfo.nFileIndexLow; v = caml_alloc (8, 0); Store_field(v,0, Val_int(fileInfo.dwFileAttributes)); Store_field(v, 1, caml_copy_double(FileTime_to_POSIX(fileInfo.ftCreationTime))); Store_field(v, 2, caml_copy_double(FileTime_to_POSIX(fileInfo.ftLastAccessTime))); Store_field(v, 3, caml_copy_double(FileTime_to_POSIX(fileInfo.ftLastWriteTime))); Store_field(v, 4, Val_int(fileInfo.dwVolumeSerialNumber)); Store_field(v, 5, caml_copy_int64(size.QuadPart)); Store_field(v, 6, Val_int(fileInfo.nNumberOfLinks)); Store_field(v, 7, caml_copy_int64(index.QuadPart)); CAMLreturn (v); }
CAMLprim value win_findfirst(value name) { HANDLE h; value v; WIN32_FIND_DATA fileinfo; value valname = Val_unit; value valh = Val_unit; caml_unix_check_path(name, "opendir"); Begin_roots2 (valname,valh); h = FindFirstFile(String_val(name),&fileinfo); if (h == INVALID_HANDLE_VALUE) { DWORD err = GetLastError(); if (err == ERROR_NO_MORE_FILES) raise_end_of_file(); else { win32_maperr(err); uerror("opendir", Nothing); } } valname = copy_string(fileinfo.cFileName); valh = win_alloc_handle(h); v = alloc_small(2, 0); Field(v,0) = valname; Field(v,1) = valh; End_roots(); return v; }
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 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); }
static void overlapped_action(long action, long id, HANDLE fd, char *buf, long len) { BOOL res; long err; completionData * d = GlobalAlloc(GPTR, sizeof(completionData)); if (d == NULL) { errno = ENOMEM; uerror(action_name[action], Nothing); } d->id = id; d->action = action; D(printf("Starting %s: id %ld, len %ld\n", action_name[action], id, len)); res = (action == READ_OVERLAPPED)? ReadFileEx(fd, buf, len, &(d->overlapped), overlapped_completion): WriteFileEx(fd, buf, len, &(d->overlapped), overlapped_completion); if (!res) { err = GetLastError (); if (err != ERROR_IO_PENDING) { win32_maperr (err); D(printf("Action %s failed: id %ld -> err %d (errCode %ld)\n", action_name[action], id, errno, err)); uerror("ReadFileEx", Nothing); } } }
static int convert_time(FILETIME* time, __time64_t* result, __time64_t def) { SYSTEMTIME sys; FILETIME local; if (time->dwLowDateTime || time->dwHighDateTime) { if (!FileTimeToLocalFileTime(time, &local) || !FileTimeToSystemTime(&local, &sys)) { win32_maperr(GetLastError()); return 0; } else { struct tm stamp = {sys.wSecond, sys.wMinute, sys.wHour, sys.wDay, sys.wMonth - 1, sys.wYear - 1900, 0, 0, 0}; *result = _mktime64(&stamp); } } else { *result = def; } return 1; }
LPWORKER worker_new (void) { LPWORKER lpWorker = NULL; if (!HeapLock(hWorkerHeap)) { win32_maperr(GetLastError()); uerror("worker_new", Nothing); }; lpWorker = (LPWORKER)HeapAlloc(hWorkerHeap, 0, sizeof(WORKER)); HeapUnlock(hWorkerHeap); list_init((LPLIST)lpWorker); lpWorker->hJobStarted = CreateEvent(NULL, TRUE, FALSE, NULL); lpWorker->hJobStop = CreateEvent(NULL, TRUE, FALSE, NULL); lpWorker->hJobDone = CreateEvent(NULL, TRUE, FALSE, NULL); lpWorker->lpJobUserData = NULL; lpWorker->hWorkerReady = CreateEvent(NULL, FALSE, FALSE, NULL); lpWorker->hCommandReady = CreateEvent(NULL, FALSE, FALSE, NULL); lpWorker->ECommand = WORKER_CMD_NONE; lpWorker->hThread = CreateThread( NULL, THREAD_WORKERS_MEM, worker_wait, (LPVOID)lpWorker, 0, NULL); return lpWorker; };
static void init_shared_globals(char* mem) { size_t page_size = getpagesize(); #ifdef _WIN32 if (!VirtualAlloc(mem, global_size_b + page_size + 2 * DEP_SIZE_B + HASHTBL_SIZE_B, MEM_COMMIT, PAGE_READWRITE)) { win32_maperr(GetLastError()); uerror("VirtualAlloc2", Nothing); } #endif /* Global storage initialization: * We store this at the start of the shared memory section as it never * needs to get saved (always reset after each typechecking run) */ global_storage = (value*)mem; // Initial size is zero global_storage[0] = 0; mem += global_size_b; /* BEGINNING OF THE SMALL OBJECTS PAGE * We keep all the small objects in this page. * They are on different cache lines because we modify them atomically. */ /* The pointer to the top of the heap. * We will atomically increment *heap every time we want to allocate. */ heap = (char**)mem; assert(CACHE_LINE_SIZE >= sizeof(char*)); // The number of elements in the hashtable hcounter = (int*)(mem + CACHE_LINE_SIZE); *hcounter = 0; counter = (uintptr_t*)(mem + 2*CACHE_LINE_SIZE); *counter = early_counter + 1; mem += page_size; // Just checking that the page is large enough. assert(page_size > CACHE_LINE_SIZE + (int)sizeof(int)); /* END OF THE SMALL OBJECTS PAGE */ /* Dependencies */ deptbl = (uint64*)mem; mem += DEP_SIZE_B; deptbl_bindings = (uint64*)mem; mem += DEP_SIZE_B; /* Hashtable */ hashtbl = (helt_t*)mem; mem += HASHTBL_SIZE_B; /* Heap */ heap_init = mem; *heap = mem; }
CAMLprim value win_findclose(value valh) { if (! FindClose(Handle_val(valh))) { win32_maperr(GetLastError()); uerror("closedir", Nothing); } return Val_unit; }
CAMLprim value win_utimes (value path, value wpath, value atime, value mtime) { HANDLE h; BOOL res; ULARGE_INTEGER iatime, imtime; FILETIME fatime, fmtime; CAMLparam4(path, wpath, atime, mtime); iatime.QuadPart = Double_val(atime); imtime.QuadPart = Double_val(mtime); /* http://www.filewatcher.com/p/Win32-UTCFileTime-1.44.tar.gz.93147/Win32-UTCFileTime-1.44/UTCFileTime.xs.html */ /* http://savannah.nongnu.org/bugs/?22781#comment0 */ if (iatime.QuadPart || imtime.QuadPart) { iatime.QuadPart += 11644473600ull; iatime.QuadPart *= 10000000ull; fatime.dwLowDateTime = iatime.LowPart; fatime.dwHighDateTime = iatime.HighPart; imtime.QuadPart += 11644473600ull; imtime.QuadPart *= 10000000ull; fmtime.dwLowDateTime = imtime.LowPart; fmtime.dwHighDateTime = imtime.HighPart; } else { GetSystemTimeAsFileTime (&fatime); fmtime = fatime; } h = CreateFileW ((LPWSTR) wpath, FILE_WRITE_ATTRIBUTES, FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING, 0, NULL); if (h == INVALID_HANDLE_VALUE) { win32_maperr (GetLastError ()); uerror("utimes", path); } res = SetFileTime (h, NULL, &fatime, &fmtime); if (res == 0) { win32_maperr (GetLastError ()); (void)CloseHandle (h); uerror("utimes", path); } res = CloseHandle (h); if (res == 0) { win32_maperr (GetLastError ()); uerror("utimes", path); } CAMLreturn (Val_unit); }
value lwt_unix_recv_notifications() { int ret, i, current_index; value result; #if !defined(LWT_ON_WINDOWS) sigset_t new_mask; sigset_t old_mask; int error; sigfillset(&new_mask); pthread_sigmask(SIG_SETMASK, &new_mask, &old_mask); #else DWORD error; #endif lwt_unix_mutex_lock(¬ification_mutex); /* Receive the signal. */ ret = notification_recv(); #if defined(LWT_ON_WINDOWS) if (ret == SOCKET_ERROR) { error = WSAGetLastError(); lwt_unix_mutex_unlock(¬ification_mutex); win32_maperr(error); uerror("recv_notifications", Nothing); } #else if (ret < 0) { error = errno; lwt_unix_mutex_unlock(¬ification_mutex); pthread_sigmask(SIG_SETMASK, &old_mask, NULL); unix_error(error, "recv_notifications", Nothing); } #endif do { /* release the mutex while calling caml_alloc, which may call gc and switch the thread, resulting in a classical deadlock, when thread in question tries another send */ current_index = notification_index; lwt_unix_mutex_unlock(¬ification_mutex); result = caml_alloc_tuple(current_index); lwt_unix_mutex_lock(¬ification_mutex); /* check that no new notifications appeared meanwhile (rare) */ } while (current_index != notification_index); /* Read all pending notifications. */ for (i = 0; i < notification_index; i++) Field(result, i) = Val_long(notifications[i]); /* Reset the index. */ notification_index = 0; lwt_unix_mutex_unlock(¬ification_mutex); #if !defined(LWT_ON_WINDOWS) pthread_sigmask(SIG_SETMASK, &old_mask, NULL); #endif return result; }
CAMLprim value netsys_unix_error_of_code(value n) { int e; e = Int_val(n); #ifdef _WIN32 win32_maperr(e); e = errno; #endif return(unix_error_of_code(e)); }
CAMLprim value win_rmdir(value path, value wpath) { CAMLparam2(path, wpath); if (!RemoveDirectoryW((LPWSTR)String_val(wpath))) { win32_maperr (GetLastError ()); uerror("rmdir", path); } CAMLreturn (Val_unit); }
CAMLprim value win_mkdir(value path, value wpath) { CAMLparam2(path, wpath); if (!CreateDirectoryW((LPWSTR)String_val(wpath), NULL)) { win32_maperr (GetLastError ()); uerror("mkdir", path); } CAMLreturn (Val_unit); }
CAMLprim value win_unlink(value path, value wpath) { CAMLparam2(path, wpath); if (!DeleteFileW((LPWSTR)String_val(wpath))) { win32_maperr (GetLastError ()); uerror("unlink", path); } CAMLreturn (Val_unit); }
CAMLprim value win_set_console_output_cp (value cp) { BOOL res; res = SetConsoleOutputCP (Int_val (cp)); if (res == 0) { win32_maperr (GetLastError ()); uerror("set_console_cp", Nothing); } return (Val_unit); }
CAMLprim value win_chdir (value path, value wpath) { CAMLparam2(path,wpath); if (!SetCurrentDirectoryW ((LPWSTR)wpath)) { win32_maperr(GetLastError()); uerror("chdir", path); } CAMLreturn (Val_unit); }
value win_pipe(long readMode, long writeMode) { CAMLparam0(); SECURITY_ATTRIBUTES attr; HANDLE readh, writeh; CHAR name[MAX_PATH]; CAMLlocal3(readfd, writefd, res); attr.nLength = sizeof(attr); attr.lpSecurityDescriptor = NULL; attr.bInheritHandle = TRUE; sprintf(name, "\\\\.\\Pipe\\UnisonAnonPipe.%08lx.%08lx", GetCurrentProcessId(), pipeSerial++); readh = CreateNamedPipeA (name, PIPE_ACCESS_INBOUND | readMode, PIPE_TYPE_BYTE | PIPE_WAIT, 1, UNIX_BUFFER_SIZE, UNIX_BUFFER_SIZE, 0, &attr); if (readh == INVALID_HANDLE_VALUE) { win32_maperr(GetLastError()); uerror("CreateNamedPipe", Nothing); return FALSE; } writeh = CreateFileA (name, GENERIC_WRITE, 0, &attr, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL | writeMode, NULL); if (writeh == INVALID_HANDLE_VALUE) { win32_maperr(GetLastError()); CloseHandle(readh); uerror("CreateFile", Nothing); return FALSE; } readfd = win_alloc_handle(readh); writefd = win_alloc_handle(writeh); res = alloc_small(2, 0); Store_field(res, 0, readfd); Store_field(res, 1, writefd); CAMLreturn (res); }