static value result_fsync(struct job_fsync *job)
{
DWORD error = job->error_code;
if (error) {
lwt_unix_free_job(&job->job);
win32_maperr(error);
uerror("fsync", Nothing);
}
lwt_unix_free_job(&job->job);
return Val_unit;
}
CAMLprim value result_bytes_write(struct job_bytes_write *job)
{
value result;
DWORD error = job->error_code;
if (error) {
lwt_unix_free_job(&job->job);
win32_maperr(error);
uerror("bytes_write", Nothing);
}
result = Val_long(job->result);
lwt_unix_free_job(&job->job);
return result;
}
static value result_gethostbyname(struct job_gethostbyname *job)
{
if (job->ptr == NULL) {
lwt_unix_free_job(&job->job);
caml_raise_not_found();
} else {
value entry = alloc_host_entry(&job->entry);
#ifdef NON_R_GETHOSTBYNAME
hostent_free(job->ptr);
#endif
lwt_unix_free_job(&job->job);
return entry;
}
}
static value result_read(struct job_read *job)
{
value result;
DWORD error = job->error_code;
if (error) {
caml_remove_generational_global_root(&job->string);
lwt_unix_free_job(&job->job);
win32_maperr(error);
uerror("read", Nothing);
}
memcpy(String_val(job->string) + job->offset, job->buffer, job->result);
result = Val_long(job->result);
caml_remove_generational_global_root(&job->string);
lwt_unix_free_job(&job->job);
return result;
}
/* The function building the caml result. */
static value result_close(struct job_close* job)
{
/* Check for errors. */
if (job->result < 0) {
/* Save the value of errno so we can use it once the job has been freed. */
int error = job->errno_copy;
/* Free the job structure. */
lwt_unix_free_job(&job->job);
/* Raise the error. */
unix_error(error, "close", Nothing);
}
/* Free the job structure. */
lwt_unix_free_job(&job->job);
/* Return the result. */
return Val_unit;
}
static value result_write(struct job_write *job)
{
long result = job->result;
LWT_UNIX_CHECK_JOB(job, result < 0, "write");
lwt_unix_free_job(&job->job);
return Val_long(result);
}
/* The function building the caml result. */
static value result_access(struct job_access* job)
{
/* Check for errors. */
if (job->result < 0) {
/* Save the value of errno so we can use it once the job has been freed. */
int error = job->errno_copy;
/* Copy the contents of job->path into a caml string. */
value string_argument = caml_copy_string(job->path);
/* Free the job structure. */
lwt_unix_free_job(&job->job);
/* Raise the error. */
unix_error(error, "access", string_argument);
}
/* Free the job structure. */
lwt_unix_free_job(&job->job);
/* Return the result. */
return Val_unit;
}
/* The function building the caml result. */
static value result_lseek_64(struct job_lseek* job)
{
value result;
/* Check for errors. */
if (job->result == (off_t)-1) {
/* Save the value of errno so we can use it once the job has been freed. */
int error = job->errno_copy;
/* Free the job structure. */
lwt_unix_free_job(&job->job);
/* Raise the error. */
unix_error(error, "lseek", Nothing);
}
/* Build the caml result. */
result = caml_copy_int64(job->result);
/* Free the job structure. */
lwt_unix_free_job(&job->job);
/* Return the result. */
return result;
}
/* Runs in the main thread. This function is `static` for the same reason as
`worker_getcwd`. */
static value result_getcwd(struct job_getcwd *job)
{
/* This macro is defined in `lwt_unix.h`. The arguments are used as follows:
- The first argument is the name of the job variable.
- If the check in the second argument *succeeds*, the C call, and job,
failed (confusing!). Note that this check must *not* be based solely on
`job->error_code`; see comment in `worker_getcwd` above.
- The last argument is the name of the C call, used in a
`Unix.Unix_error` exception raised if the job failed.
If the check succeeds/job failed, this macro deallocates the job, raises
the exception, and does *not* "return" to the rest of `result_getcwd`.
Otherwise, if the job succeeded, the job is *not* deallocated, and
execution continues in the rest of `result_getcwd`.
`job->error_code` is used internally by the macro in creating the
`Unix.Unix_error`. If this is incorrect (i.e., some job does not set
`errno` on failure), it is necessary to replace the macro by its
expansion, and modify the behavior. */
LWT_UNIX_CHECK_JOB(job, job->result == NULL, "getcwd");
/* Convert the job result to an OCaml value.
In this case, create an OCaml string from the temporary buffer into
which `getcwd(3)` wrote the current directory. This copies the string.
Throughout Lwt, blocking C calls that run in worker threads can't write
directly into OCaml strings, because the OCaml garbage collector might
move the strings after the pointer has already been passed to the call,
but while the call is still blocked. Bigarrays don't have this problem,
so pointers into them are passed to blocking C calls, avoiding a copy.
In addition to worker threads not being able to write into OCaml strings,
they typically cannot *allocate* any OCaml strings (or other values)
either, because the worker threads do not try to take OCaml's global
runtime lock. This sometimes results in extra data copies. For an
example, see the implementation of `readdir_n`. At the time of this
writing, that implementation copied each string returned by `readdir`
twice.
For jobs that return integers or other kinds of values, it is necessary
to use the various `Int_val`, `Long_val` macros, etc. See
http://caml.inria.fr/pub/docs/manual-ocaml/intfc.html#sec415 */
value result = caml_copy_string(job->result);
/* Have to free the job manually! */
lwt_unix_free_job(&job->job);
return result;
}
static value result_system(struct job_system *job)
{
HANDLE handle = job->handle;
DWORD code;
DWORD err;
lwt_unix_free_job(&job->job);
if (!GetExitCodeProcess(handle, &code)) {
err = GetLastError();
CloseHandle(handle);
win32_maperr(err);
uerror("GetExitCodeProcess", Nothing);
}
CloseHandle(handle);
return Val_int(code);
}
static value result_wait_mincore(struct job_wait_mincore *job)
{
lwt_unix_free_job(&job->job);
return Val_unit;
}