CAMLprim value brlapiml_errorCode_of_error(value camlError)
{
CAMLparam1(camlError);
CAMLlocal1(result);
switch (Int_val(Field(camlError, 0))) {
case BRLAPI_ERROR_NOMEM: result = Val_int(0); break;
case BRLAPI_ERROR_TTYBUSY: result = Val_int(1); break;
case BRLAPI_ERROR_DEVICEBUSY: result = Val_int(2); break;
case BRLAPI_ERROR_UNKNOWN_INSTRUCTION: result = Val_int(3); break;
case BRLAPI_ERROR_ILLEGAL_INSTRUCTION: result = Val_int(4); break;
case BRLAPI_ERROR_INVALID_PARAMETER: result = Val_int(5); break;
case BRLAPI_ERROR_INVALID_PACKET: result = Val_int(6); break;
case BRLAPI_ERROR_CONNREFUSED: result = Val_int(7); break;
case BRLAPI_ERROR_OPNOTSUPP: result = Val_int(8); break;
case BRLAPI_ERROR_GAIERR: {
result = caml_alloc(1, 0);
Store_field(result, 0, Val_int(Field(camlError, 2)));
}; break;
case BRLAPI_ERROR_LIBCERR: {
result = caml_alloc(1, 1);
Store_field(result, 0, unix_error_of_code(Int_val(Field(camlError, 1))));
}; break;
case BRLAPI_ERROR_UNKNOWNTTY: result = Val_int(9); break;
case BRLAPI_ERROR_PROTOCOL_VERSION: result = Val_int(10); break;
case BRLAPI_ERROR_EOF: result = Val_int(11); break;
case BRLAPI_ERROR_EMPTYKEY: result = Val_int(12); break;
case BRLAPI_ERROR_DRIVERERROR: result = Val_int(13); break;
case BRLAPI_ERROR_AUTHENTICATION: result = Val_int(14); break;
default: {
result = caml_alloc(1, 2);
Store_field(result, 0, Val_int(Field(camlError, 0)));
}
}
CAMLreturn(result);
}
CAMLprim value stub_sem_wait(value sem) {
CAMLparam1(sem);
CAMLlocal2(result, perrno);
int rc, lerrno;
sem_t *s;
s = *Sem_val(sem);
if (NULL == s) {
lerrno = EINVAL;
goto ERROR;
}
caml_release_runtime_system();
rc = sem_wait(s);
lerrno = errno;
caml_acquire_runtime_system();
if (0 != rc) {
goto ERROR;
}
result = caml_alloc(1, 0); // Result.Ok
Store_field(result, 0, Val_unit);
goto END;
ERROR:
perrno = caml_alloc(2, 0);
Store_field(perrno, 0, eunix); // `EUnix
Store_field(perrno, 1, unix_error_of_code(lerrno));
result = caml_alloc(1, 1); // Result.Error
Store_field(result, 0, perrno);
END:
CAMLreturn(result);
}
CAMLprim value stub_sem_init(value c) {
CAMLparam1(c);
CAMLlocal2(result, perrno);
int rc, lerrno;
sem_t *s;
rc = -1;
caml_release_runtime_system();
if (NULL != (s = malloc(sizeof(sem_t)))) {
rc = sem_init(s, 0, Int_val(c));
lerrno = errno;
} else {
lerrno = ENOMEM;
free(s);
}
caml_acquire_runtime_system();
if (0 != rc) {
goto ERROR;
}
result = caml_alloc(1, 0); // Result.Ok
Store_field(result, 0, caml_copy_semaphore(s));
goto END;
ERROR:
perrno = caml_alloc(2, 0);
Store_field(perrno, 0, eunix); // `EUnix
Store_field(perrno, 1, unix_error_of_code(lerrno));
result = caml_alloc(1, 1); // Result.Error
Store_field(result, 0, perrno);
END:
CAMLreturn(result);
}
CAMLexport value
unix_getsockopt_aux(char * name,
enum option_type ty, int level, int option,
value socket)
{
union option_value optval;
socklen_param_type optsize;
switch (ty) {
case TYPE_BOOL:
case TYPE_INT:
case TYPE_UNIX_ERROR:
optsize = sizeof(optval.i); break;
case TYPE_LINGER:
optsize = sizeof(optval.lg); break;
case TYPE_TIMEVAL:
optsize = sizeof(optval.tv); break;
default:
unix_error(EINVAL, name, Nothing);
}
if (getsockopt(Socket_val(socket), level, option,
(void *) &optval, &optsize) == -1)
uerror(name, Nothing);
switch (ty) {
case TYPE_BOOL:
case TYPE_INT:
return Val_int(optval.i);
case TYPE_LINGER:
if (optval.lg.l_onoff == 0) {
return Val_int(0); /* None */
} else {
value res = alloc_small(1, 0); /* Some */
Field(res, 0) = Val_int(optval.lg.l_linger);
return res;
}
case TYPE_TIMEVAL:
return copy_double((double) optval.tv.tv_sec
+ (double) optval.tv.tv_usec / 1e6);
case TYPE_UNIX_ERROR:
if (optval.i == 0) {
return Val_int(0); /* None */
} else {
value err, res;
err = unix_error_of_code(optval.i);
Begin_root(err);
res = alloc_small(1, 0); /* Some */
Field(res, 0) = err;
End_roots();
return res;
}
default:
unix_error(EINVAL, name, Nothing);
return Val_unit; /* Avoid warning */
}
}
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 stub_sem_open(value path, value flags, value perm, value size) {
CAMLparam4(path, flags, perm, size);
CAMLlocal2(result, perrno);
int s, fs, lerrno;
mode_t mode;
char *p;
size_t plen;
sem_t *sem;
fs = convert_flag_list(flags, open_flag_table);
mode = Int_val(perm);
s = Int_val(size);
plen = caml_string_length(path);
#ifdef NOALLOCA
if (NULL == (p = malloc(msg_len + 1))) {
caml_raise_out_of_memory();
}
#else
p = alloca(plen + 1);
#endif
memcpy(p, String_val(path), plen);
p[plen] = '\0';
caml_release_runtime_system();
sem = sem_open(p, fs, mode, s);
lerrno = errno;
#ifdef NOALLOCA
free(p);
#endif
caml_acquire_runtime_system();
if (SEM_FAILED == sem) {
goto ERROR;
}
result = caml_alloc(1, 0); // Result.Ok
Store_field(result, 0, caml_copy_semaphore(sem));
goto END;
ERROR:
perrno = caml_alloc(2, 0);
Store_field(perrno, 0, eunix); // `EUnix
Store_field(perrno, 1, unix_error_of_code(lerrno));
result = caml_alloc(1, 1); // Result.Error
Store_field(result, 0, perrno);
END:
CAMLreturn(result);
}
static inline value mk_unix_error_exn(int errcode, char *cmdname, value cmdarg)
{
CAMLparam0();
CAMLlocal3(name, err, arg);
value res;
arg = cmdarg == Nothing ? caml_copy_string("") : cmdarg;
name = caml_copy_string(cmdname);
err = unix_error_of_code(errcode);
res = caml_alloc_small(4, 0);
Field(res, 0) = *unix_error_exn;
Field(res, 1) = err;
Field(res, 2) = name;
Field(res, 3) = arg;
CAMLreturn(res);
}
CAMLprim value stub_sem_unlink(value path) {
CAMLparam1(path);
CAMLlocal2(result, perrno);
int rc, lerrno;
char *p;
size_t plen;
plen = caml_string_length(path);
#ifdef NOALLOCA
if (NULL == (p = malloc(msg_len + 1))) {
caml_raise_out_of_memory();
}
#else
p = alloca(plen + 1);
#endif
memcpy(p, String_val(path), plen);
p[plen] = '\0';
caml_release_runtime_system();
rc = sem_unlink(p);
lerrno = errno;
#ifdef NOALLOCA
free(p);
#endif
caml_acquire_runtime_system();
if (0 != rc) {
goto ERROR;
}
result = caml_alloc(1, 0); // Result.Ok
Store_field(result, 0, Val_unit);
goto END;
ERROR:
perrno = caml_alloc(2, 0);
Store_field(perrno, 0, eunix); // `EUnix
Store_field(perrno, 1, unix_error_of_code(lerrno));
result = caml_alloc(1, 1); // Result.Error
Store_field(result, 0, perrno);
END:
CAMLreturn(result);
}
static void invoke_completion_callback
(long id, long len, long errCode, long action) {
CAMLlocal2 (err, name);
value args[4];
err = Val_long(0);
if (errCode != NO_ERROR) {
len = -1;
win32_maperr (errCode);
err = unix_error_of_code(errno);
}
name = copy_string (action_name[action]);
D(printf("Action %s completed: id %ld -> len %ld / err %d (errCode %ld)\n",
action_name[action], id, len, errno, errCode));
args[0] = Val_long(id);
args[1] = Val_long(len);
args[2] = err;
args[3] = name;
caml_callbackN(completionCallback, 4, args);
D(printf("Callback performed\n"));
}
void unix_error(int errcode, char *cmdname, value cmdarg)
{
value res;
value name = Val_unit, err = Val_unit, arg = Val_unit;
int errconstr;
Begin_roots3 (name, err, arg);
arg = cmdarg == Nothing ? copy_string("") : cmdarg;
name = copy_string(cmdname);
err = unix_error_of_code (errcode);
if (unix_error_exn == NULL) {
unix_error_exn = caml_named_value("Unix.Unix_error");
if (unix_error_exn == NULL)
invalid_argument("Exception Unix.Unix_error not initialized, please link unix.cma");
}
res = alloc_small(4, 0);
Field(res, 0) = *unix_error_exn;
Field(res, 1) = err;
Field(res, 2) = name;
Field(res, 3) = arg;
End_roots();
mlraise(res);
}
