Val _lib7_netdb_get_protocol_by_number (Task* task, Val arg) {
//==================================
//
// Mythryl type: Int -> Null_Or( (String, List(String), Int) )
//
// This fn gets bound as get_prot_by_number' in:
//
// src/lib/std/src/socket/net-protocol-db.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int number = TAGGED_INT_TO_C_INT( arg ); // Last use of 'arg'.
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
struct protoent* pentry = getprotobynumber( number );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
if (pentry == NULL) return OPTION_NULL;
Val name = make_ascii_string_from_c_string__may_heapclean (task, pentry->p_name, NULL ); Roots roots1 = { &name, NULL };
Val aliases = make_ascii_strings_from_vector_of_c_strings__may_heapclean(task, pentry->p_aliases, &roots1 );
Val result = make_three_slot_record( task, name, aliases, TAGGED_INT_FROM_C_INT(pentry->p_proto) );
result = OPTION_THE( task, result );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _util_NetDB_mkservent (Task* task, struct servent* sentry) {
//=====================
//
// Mythryl type:
//
// Allocate an Lib7 value of type:
// Null_Or( (String, List(String), Int, String) )
// to represent a struct servent value. Note that the port number is returned
// in network byteorder, so we need to map it to host order.
if (sentry == NULL) return OPTION_NULL;
// If our agegroup0 buffer is more than half full,
// empty it by doing a heapcleaning. This is very
// conservative -- which is the way I like it. :-)
//
if (agegroup0_freespace_in_bytes( task )
< agegroup0_usedspace_in_bytes( task )
){
call_heapcleaner( task, 0 );
}
// Build the return result:
Val name = make_ascii_string_from_c_string__may_heapclean( task, sentry->s_name, NULL ); Roots roots1 = { &name, NULL };
Val aliases = make_ascii_strings_from_vector_of_c_strings__may_heapclean( task, sentry->s_aliases, &roots1); Roots roots2 = { &aliases, &roots1 };
Val proto = make_ascii_string_from_c_string__may_heapclean( task, sentry->s_proto, &roots2); // Roots roots3 = { &proto, &roots2 };
Val port = TAGGED_INT_FROM_C_INT( ntohs(sentry->s_port) );
Val result = make_four_slot_record(task, name, aliases, port, proto);
return OPTION_THE( task, result );
}
Val _util_NetDB_mknetent (Task *task, struct netent* nentry) {
//====================
//
// Allocate a Mythryl value of type
// Null_Or( (String, List(String), Addr_Family, Sysword) )
// to represent a struct netent value.
if (nentry == NULL) return OPTION_NULL;
// Build the return result:
// If our agegroup0 buffer is more than half full,
// empty it by doing a heapcleaning. This is very
// conservative -- which is the way I like it. :-)
//
if (agegroup0_freespace_in_bytes( task )
< agegroup0_usedspace_in_bytes( task )
){
call_heapcleaner( task, 0 );
}
Val name = make_ascii_string_from_c_string__may_heapclean( task, nentry->n_name, NULL ); Roots roots1 = { &name, NULL };
Val aliases = make_ascii_strings_from_vector_of_c_strings__may_heapclean( task, nentry->n_aliases, &roots1 ); Roots roots2 = { &aliases, &roots1 };
Val af = make_system_constant__may_heapclean( task, &_Sock_AddrFamily, nentry->n_addrtype, &roots2 ); // Roots roots3 = { &af, &roots2 };
Val net = make_one_word_unt( task, (Vunt) (nentry->n_net) ); // Roots roots4 = { &net, &roots3 };
Val result = make_four_slot_record( task, name, aliases, af, net );
return OPTION_THE( task, result );
}
Val _lib7_netdb_get_protocol_by_name (Task* task, Val arg) {
//================================
//
// Mythryl type: String -> Null_Or( (String, List(String), Int) )
//
// This fn gets bound as get_prot_by_name' in:
//
// src/lib/std/src/socket/net-protocol-db.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
struct protoent* pentry;
char* heap_name = HEAP_STRING_AS_C_STRING( arg ); // Last use of 'arg'.
// We cannot reference anything on the Mythryl
// heap between RELEASE_MYTHRYL_HEAP and RECOVER_MYTHRYL_HEAP
// because garbage collection might be moving
// it around, so copy heap_name into C storage:
//
Mythryl_Heap_Value_Buffer name_buf;
//
{ char* c_name = buffer_mythryl_heap_value( &name_buf, (void*) heap_name, strlen( heap_name ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
pentry = getprotobyname( c_name );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
unbuffer_mythryl_heap_value( &name_buf );
}
if (pentry == NULL) return OPTION_NULL;
Val name = make_ascii_string_from_c_string__may_heapclean (task, pentry->p_name, NULL ); Roots roots1 = { &name, NULL };
Val aliases = make_ascii_strings_from_vector_of_c_strings__may_heapclean (task, pentry->p_aliases, &roots1 );
Val result
=
make_three_slot_record( task, name, aliases, TAGGED_INT_FROM_C_INT(pentry->p_proto) );
result = OPTION_THE( task, result );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_U_Dynload_dlerror (Task* task, Val lib7_handle) { // : Void -> Null_Or(String)
//=======================
//
// Extract error after unsuccessful dlopen/dlsym/dlclose.
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
const char* e = dlerror ();
Val result;
if (e == NULL) result = OPTION_NULL;
else result = OPTION_THE( task, make_ascii_string_from_c_string__may_heapclean(task, e, NULL) );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
/* _lib7_win32_PS_get_environment_variable : String -> String option
* var
*
*/
Val _lib7_win32_PS_get_environment_variable(Task *task, Val arg)
{
#define GEV_BUF_SZ 4096
char buf[GEV_BUF_SZ];
int ret = GetEnvironmentVariable(HEAP_STRING_AS_C_STRING(arg),buf,GEV_BUF_SZ);
Val ml_s,res = OPTION_NULL;
if (ret > GEV_BUF_SZ) {
return RAISE_SYSERR(task,-1);
}
if (ret > 0) {
ml_s = make_ascii_string_from_c_string(task,buf);
OPTION_THE(task,res,ml_s);
}
return res;
#undef GEV_BUF_SZ
}
/* _lib7_win32_PS_get_environment_variable : String -> String option
* var
*
*/
Val _lib7_win32_PS_get_environment_variable(Task *task, Val arg)
{
#define GEV_BUF_SZ 4096
char buf[GEV_BUF_SZ];
int ret = GetEnvironmentVariable(HEAP_STRING_AS_C_STRING(arg),buf,GEV_BUF_SZ);
Val ml_s;
if (ret > GEV_BUF_SZ) {
return RAISE_SYSERR__MAY_HEAPCLEAN(task,-1,NULL);
}
if (ret > 0) {
ml_s = make_ascii_string_from_c_string__may_heapclean(task,buf,NULL);
return OPTION_THE( task, ml_s );
}
return OPTION_NULL;
#undef GEV_BUF_SZ
}
Val _lib7_P_ProcEnv_getenv (Task* task, Val arg) {
//======================
//
// Mythryl type: String -> Null_Or(String)
//
// Return value for environment name
//
// This fn gets bound as getenv in:
//
// src/lib/std/src/posix-1003.1b/posix-id.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_P_ProcEnv_getenv");
char* status;
// We cannot reference anything on the Mythryl
// heap between RELEASE_MYTHRYL_HEAP and RECOVER_MYTHRYL_HEAP
// because garbage collection might be moving
// it around, so copy heap_path into C storage:
//
Mythryl_Heap_Value_Buffer key_buf;
{
char* heap_key = HEAP_STRING_AS_C_STRING( arg );
char* c_key
=
buffer_mythryl_heap_value( &key_buf, (void*) heap_key, strlen( heap_key ) +1 ); // '+1' for terminal NUL on string.
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_P_ProcEnv_getenv", NULL );
//
status = getenv( c_key );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_P_ProcEnv_getenv" );
unbuffer_mythryl_heap_value( &key_buf );
}
if (status == NULL) return OPTION_NULL;
Val s = make_ascii_string_from_c_string__may_heapclean( task, status, NULL); // make_ascii_string_from_c_string__may_heapclean def in src/c/heapcleaner/make-strings-and-vectors-etc.c
return OPTION_THE( task, s );
}
Val _lib7_win32_PS_wait_for_single_chunk(Task *task, Val arg)
{
HANDLE hProcess = (HANDLE) WORD_LIB7toC (arg);
DWORD exit_code;
int res;
Val p;
res = WaitForSingleChunkect (hProcess,0);
if (res==WAIT_TIMEOUT || res==WAIT_FAILED) {
/* information is not ready, or error */
return OPTION_NULL;
} else {
/* WAIT_CHUNKECT_0 ... done, finished */
/* get info and return THE(exit_status) */
GetExitCodeProcess (hProcess,&exit_code);
CloseHandle (hProcess); /* decrease ref count */
p = make_one_word_unt(task, (Vunt) exit_code );
return OPTION_THE( task, p );
}
}
static Val do_get_script_name (Task* task, Val arg) {
// ==================
//
// Mythryl type: Void -> Null_Or( String )
//
// If MYTHRYL_SCRIPT was set in the Posix "environment"
// when the Mythryl C runtime started up, this call will
// return its string value, otherwise NULL.
//
// The C runtime removes MYTHRYL_SCRIPT from the environment
// immediately after checking for it (and caching its value)
// because if it is left in the environment and then inherited
// by a spawned subprocess it can cause totally unexpected
// behavior in violent violation of the Principle of Least
// Surprise. (Hue White encountered this.)
//
// The MYTHRYL_SCRIPT thing remains an unholy kludge, but
// this at least minimizes the kludges window of opportunity
// to cause mayhem.
//
// This fn gets bound to 'get_script_name' in:
//
// src/lib/src/kludge.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
if (!mythryl_script__global) { // mythryl_script__global is from src/c/main/runtime-main.c
//
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return OPTION_NULL; // OPTION_NULL is from src/c/h/make-strings-and-vectors-etc.h
}
Val script_name
=
make_ascii_string_from_c_string__may_heapclean( task, mythryl_script__global, NULL );
Val result = OPTION_THE(task, script_name);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
Val _lib7_NetDB_getrpcbynum (Task* task, Val arg) {
//=======================
//
// Mythryl type: Int -> Null_Or( (String, List(String), Int) )
//
// This fn is NOWHERE INVOKED. Nor listed in src/c/lib/socket/cfun-list.h Presumably should be either called or deleted: XXX BUGGO FIXME.
struct rpcent* rentry
=
getrpcbynumber( TAGGED_INT_TO_C_INT( arg ));
if (rentry == NULL) return OPTION_NULL;
Val name = make_ascii_string_from_c_string( task, rentry->r_name );
Val aliases = make_ascii_strings_from_vector_of_c_strings( task, rentry->r_aliases);
Val result;
REC_ALLOC3( task, result, name, aliases, TAGGED_INT_FROM_C_INT(rentry->r_number));
OPTION_THE( task, result, result);
return result;
}
Val _lib7_P_ProcEnv_getenv (Task* task, Val arg) {
//======================
//
// Mythryl type: String -> Null_Or(String)
//
// Return value for environment name
//
// This fn gets bound as getenv in:
//
// src/lib/std/src/posix-1003.1b/posix-id.pkg
char* status = getenv( HEAP_STRING_AS_C_STRING(arg) );
if (status == NULL) return OPTION_NULL;
Val s = make_ascii_string_from_c_string( task, status); // make_ascii_string_from_c_string def in src/c/heapcleaner/make-strings-and-vectors-etc.c
Val result;
OPTION_THE(task, result, s);
return result;
}
Val raise_error__may_heapclean (
//==========================
//
Task* task,
const char* altMsg,
const char* at, // C sourcefile and line number raising this error: "<foo.c:37>"
Roots* extra_roots
) {
// Raise the Mythryl exception RUNTIME_EXCEPTION, which is defined as:
//
// exception RUNTIME_EXCEPTION (String, Null_Or(System_Error) );
//
// We normally get invoked via either the
// RAISE_SYSERR__MAY_HEAPCLEAN or RAISE_ERROR__MAY_HEAPCLEAN macro from
//
// src/c/lib/raise-error.h
//
// For the time being, we use the errno value as the System_Error; eventually that
// will be represented by an (Int, String) pair. If alt_msg is non-zero,
// then use it as the error string and use NULL for the System_Error.
int error_number = errno; // Various calls can trash this value so preserve it early.
const char* msg;
char buf[32];
Val null_or_errno;
if (altMsg != NULL) {
//
msg = altMsg;
null_or_errno = OPTION_NULL;
} else if ((msg = strerror(error_number)) != NULL) {
null_or_errno = OPTION_THE( task, TAGGED_INT_FROM_C_INT(error_number) );
} else {
sprintf(buf, "<unknown error %d>", error_number);
msg = buf;
null_or_errno = OPTION_THE( task, TAGGED_INT_FROM_C_INT(error_number) );
}
#if (defined(DEBUG_OS_INTERFACE) || defined(DEBUG_TRACE_CCALL))
debug_say ("RaiseSysError: errno = %d, msg = \"%s\"\n",
(altMsg != NULL) ? -1 : error_number, msg);
#endif
Roots roots1 = { &null_or_errno, extra_roots };
Val errno_string = make_ascii_string_from_c_string__may_heapclean (task, msg, &roots1 );
Val at_list; // [] or [ "<foo.c:187>" ].
//
if (at != NULL) {
//
Roots roots2 = { &errno_string, &roots1 };
Val at_cstring
=
make_ascii_string_from_c_string__may_heapclean (task, at, &roots2 );
at_list = LIST_CONS(task, at_cstring, LIST_NIL);
} else {
at_list = LIST_NIL;
}
Val arg = make_two_slot_record( task, errno_string, null_or_errno);
Val syserr_exception = MAKE_EXCEPTION(task, PTR_CAST( Val, RUNTIME_EXCEPTION__GLOBAL), arg, at_list);
// Modify the task state so that 'syserr_exception'
// will be raised when Mythryl execution resumes:
//
raise_mythryl_exception( task, syserr_exception ); // raise_mythryl_exception is from src/c/main/run-mythryl-code-and-runtime-eventloop.c
return syserr_exception;
} // fun raise_error__may_heapclean
Val get_or_set_socket_linger_option (Task* task, Val arg) {
//===============================
//
// Mythryl type: (Socket_Fd, Null_Or(Null_Or(Int))) -> Null_Or(Int)
//
// Set/get the SO_LINGER option as follows:
// NULL => get current setting
// THE(NULL) => disable linger
// THE(THE t) => enable linger with timeout t.
//
// This function gets bound as ctl_linger in:
//
// src/lib/std/src/socket/socket-guts.pkg
//
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int socket = GET_TUPLE_SLOT_AS_INT( arg, 0 );
Val ctl = GET_TUPLE_SLOT_AS_VAL( arg, 1 ); // Last use of 'arg'.
struct linger optVal;
int status;
if (ctl == OPTION_NULL) {
//
socklen_t optSz = sizeof( struct linger );
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
status = getsockopt( socket, SOL_SOCKET, SO_LINGER, (sockoptval_t)&optVal, &optSz );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
ASSERT( status < 0 || optSz == sizeof( struct linger ));
//
} else {
//
ctl = OPTION_GET(ctl);
if (ctl == OPTION_NULL) {
optVal.l_onoff = 0; // Argument is THE(NULL); disable linger.
} else {
optVal.l_onoff = 1; // argument is THE t; enable linger.
optVal.l_linger = TAGGED_INT_TO_C_INT(OPTION_GET(ctl));
}
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL );
//
status = setsockopt (socket, SOL_SOCKET, SO_LINGER, (sockoptval_t)&optVal, sizeof(struct linger));
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
}
if (status < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL);
if (optVal.l_onoff == 0) return OPTION_NULL;
Val result = OPTION_THE( task, TAGGED_INT_FROM_C_INT( optVal.l_linger ) );
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
