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; }