/* In the case of `Lwt_unix.getcwd`, the argument is `()`, which is represented
in C by one argument, which we conventually call `unit`. OCaml always passes
the same value for this argument, and we don't use it. */
CAMLprim value lwt_unix_getcwd_job(value unit)
{
/* Allocate the `job_getcwd` on the OCaml heap. Inside it, store its size,
and pointers to `worker_getcwd` and `result_getcwd`. Arguments must be
stored manually after the macro is called, but in the case of `getcwd`,
there are no arguments to initialize.
For an example of a job that has arguments, see `lwt_unix_read_job`.
The first argument is the name of the variable to be created to store
the pointer to the job `struct`, i.e.
struct job_getcwd *job = ...
The last argument is the number of bytes of storage to reserve in memory
immediately following the `struct`. This is for fields such as
`char data[]` at the end of the struct. It is typically zero. For an
example where it is not zero, see `lwt_unix_read_job` again.
If the additional data is stored inline in the job struct, it is
deallocated with `lwt_unix_free_job`. If the additional data is for
pointers to additional structure, you must remember to deallocate it
yourself. For an example of this, see `readdir_n`.*/
LWT_UNIX_INIT_JOB(job, getcwd, 0);
/* Allocate a corresponding object in the OCaml heap. `&job->job` is the
same numeric address as `job`, but has type `struct lwt_unix_job`. */
return lwt_unix_alloc_job(&job->job);
}
CAMLprim value lwt_unix_write_job(value val_fd, value val_string,
value val_offset, value val_length)
{
long length = Long_val(val_length);
LWT_UNIX_INIT_JOB(job, write, length);
job->fd = Int_val(val_fd);
job->length = length;
memcpy(job->buffer, String_val(val_string) + Long_val(val_offset), length);
return lwt_unix_alloc_job(&(job->job));
}
CAMLprim value lwt_unix_fsync_job(value val_fd)
{
struct filedescr *fd = (struct filedescr *)Data_custom_val(val_fd);
if (fd->kind != KIND_HANDLE) {
caml_invalid_argument("Lwt_unix.fsync");
} else {
LWT_UNIX_INIT_JOB(job, fsync, 0);
job->handle = fd->fd.handle;
job->error_code = 0;
return lwt_unix_alloc_job(&(job->job));
}
}
/* The stub creating the job structure. */
CAMLprim value lwt_unix_close_job(value fd)
{
/* Allocate a new job. */
struct job_close* job = lwt_unix_new(struct job_close);
/* Initializes function fields. */
job->job.worker = (lwt_unix_job_worker)worker_close;
job->job.result = (lwt_unix_job_result)result_close;
/* Copy the fd parameter. */
job->fd = Int_val(fd);
/* Wrap the structure into a caml value. */
return lwt_unix_alloc_job(&job->job);
}
CAMLprim value lwt_unix_bytes_read_job(value val_fd, value val_buffer, value val_offset, value val_length)
{
struct filedescr *fd = (struct filedescr *)Data_custom_val(val_fd);
LWT_UNIX_INIT_JOB(job, bytes_read, 0);
job->kind = fd->kind;
if (fd->kind == KIND_HANDLE)
job->fd.handle = fd->fd.handle;
else
job->fd.socket = fd->fd.socket;
job->buffer = (char*)Caml_ba_data_val(val_buffer) + Long_val(val_offset);
job->length = Long_val(val_length);
job->error_code = 0;
return lwt_unix_alloc_job(&(job->job));
}
/* The stub creating the job structure. */
CAMLprim value lwt_unix_tcflow_job(value fd, value action)
{
/* Allocate a new job. */
struct job_tcflow* job = lwt_unix_new(struct job_tcflow);
/* Initializes function fields. */
job->job.worker = (lwt_unix_job_worker)worker_tcflow;
job->job.result = (lwt_unix_job_result)result_tcflow;
/* Copy the fd parameter. */
job->fd = Int_val(fd);
/* Copy the action parameter. */
job->action = flow_action_table[Int_val(action)];
/* Wrap the structure into a caml value. */
return lwt_unix_alloc_job(&job->job);
}
CAMLprim value lwt_unix_write_job(value val_fd, value val_string, value val_offset, value val_length)
{
struct filedescr *fd = (struct filedescr *)Data_custom_val(val_fd);
long length = Long_val(val_length);
LWT_UNIX_INIT_JOB(job, write, length);
job->kind = fd->kind;
if (fd->kind == KIND_HANDLE)
job->fd.handle = fd->fd.handle;
else
job->fd.socket = fd->fd.socket;
memcpy(job->buffer, String_val(val_string) + Long_val(val_offset), length);
job->length = length;
job->error_code = 0;
return lwt_unix_alloc_job(&(job->job));
}
/* The stub creating the job structure. */
CAMLprim value lwt_unix_lseek_64_job(value fd, value offset, value whence)
{
/* Allocate a new job. */
struct job_lseek* job = lwt_unix_new(struct job_lseek);
/* Initializes function fields. */
job->job.worker = (lwt_unix_job_worker)worker_lseek;
job->job.result = (lwt_unix_job_result)result_lseek_64;
/* Copy the fd parameter. */
job->fd = Int_val(fd);
/* Copy the offset parameter. */
job->offset = Int64_val(offset);
/* Copy the whence parameter. */
job->whence = seek_command_table[Int_val(whence)];
/* Wrap the structure into a caml value. */
return lwt_unix_alloc_job(&job->job);
}
CAMLprim value lwt_unix_read_job(value val_fd, value val_string, value val_offset, value val_length)
{
struct filedescr *fd = (struct filedescr *)Data_custom_val(val_fd);
long length = Long_val(val_length);
LWT_UNIX_INIT_JOB(job, read, length);
job->kind = fd->kind;
if (fd->kind == KIND_HANDLE)
job->fd.handle = fd->fd.handle;
else
job->fd.socket = fd->fd.socket;
job->length = length;
job->error_code = 0;
job->string = val_string;
job->offset = Long_val(val_offset);
caml_register_generational_global_root(&(job->string));
return lwt_unix_alloc_job(&(job->job));
}
CAMLprim value lwt_unix_system_job(value cmdline)
{
STARTUPINFO si;
PROCESS_INFORMATION pi;
ZeroMemory(&si, sizeof(si));
ZeroMemory(&pi, sizeof(pi));
si.cb = sizeof(si);
if (!CreateProcess(NULL, String_val(cmdline), NULL, NULL, TRUE, 0, NULL, NULL, &si, &pi)) {
win32_maperr(GetLastError());
uerror("CreateProcess", Nothing);
} else {
LWT_UNIX_INIT_JOB(job, system, 0);
CloseHandle(pi.hThread);
job->handle = pi.hProcess;
return lwt_unix_alloc_job(&(job->job));
}
}
/* The stub creating the job structure. */
CAMLprim value lwt_unix_access_job(value path, value mode)
{
/* Get the length of the path parameter. */
mlsize_t len_path = caml_string_length(path) + 1;
/* Allocate a new job. */
struct job_access* job = lwt_unix_new_plus(struct job_access, len_path);
/* Set the offset of the path parameter inside the job structure. */
job->path = job->data;
/* Copy the path parameter inside the job structure. */
memcpy(job->path, String_val(path), len_path);
/* Initializes function fields. */
job->job.worker = (lwt_unix_job_worker)worker_access;
job->job.result = (lwt_unix_job_result)result_access;
/* Copy the mode parameter. */
job->mode = int_of_access_permissions(mode);
/* Wrap the structure into a caml value. */
return lwt_unix_alloc_job(&job->job);
}
CAMLprim value lwt_unix_gethostbyname_job(value name)
{
LWT_UNIX_INIT_JOB_STRING(job, gethostbyname, 0, name);
return lwt_unix_alloc_job(&(job->job));
}
CAMLprim value lwt_unix_fstat_job(value val_fd)
{
LWT_UNIX_INIT_JOB(job, fstat, 0);
job->fd = Int_val(val_fd);
return lwt_unix_alloc_job(&(job->job));
}
CAMLprim value lwt_unix_lstat_64_job(value name)
{
LWT_UNIX_INIT_JOB_STRING(job, lstat, 0, name);
job->job.result = (lwt_unix_job_result)result_lstat_64;
return lwt_unix_alloc_job(&(job->job));
}
CAMLprim value lwt_unix_wait_mincore_job(value val_buffer, value val_offset)
{
LWT_UNIX_INIT_JOB(job, wait_mincore, 0);
job->ptr = (char *)Caml_ba_data_val(val_buffer) + Long_val(val_offset);
return lwt_unix_alloc_job(&(job->job));
}
