#include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include "scheme.h" static const struct utsname *get_global_uname(void) { static struct utsname buf; if (!buf.sysname[0]) { if (uname(&buf) == -1) { memset(&buf, 0, sizeof(buf)); } } return &buf; } const char *env_get_os_name(void) { return get_global_uname()->sysname; } static void push(value_t *tailp, value_t elt) { value_t new_tail; new_tail = cdr_(*tailp) = fl_cons(elt, FL_NIL); *tailp = new_tail; } static void push_pair(value_t *tailp, const char *name, value_t value) { push(tailp, fl_cons(symbol(name), value)); } static value_t envst_language(void) { value_t head, tail; head = tail = fl_cons(symbol("language"), FL_NIL); push_pair(&tail, "implementation-name", string_from_cstr("Up Scheme")); push_pair(&tail, "implementation-version", string_from_cstr("0.1.0")); return head; } static value_t envst_language_c(void) { value_t head, tail; head = tail = fl_cons(symbol("language"), FL_NIL); push_pair(&tail, "implementation-name", string_from_cstr(SCHEME_C_COMPILER_NAME)); push_pair(&tail, "implementation-version", string_from_cstr(SCHEME_C_COMPILER_VERSION)); return head; } static value_t envst_os(void) { value_t head, tail; head = tail = fl_cons(symbol("os"), FL_NIL); push_pair(&tail, "implementation-name", string_from_cstr(get_global_uname()->sysname)); push_pair(&tail, "implementation-version", string_from_cstr(get_global_uname()->release)); return head; } static const char endianness[] = #if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ "big-endian" #endif #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ "little-endian" #endif ; static value_t envst_computer(void) { value_t head, tail; head = tail = fl_cons(symbol("computer"), FL_NIL); push_pair(&tail, "architecture", string_from_cstr(get_global_uname()->machine)); push_pair(&tail, "cpu-bits", fixnum(sizeof(uintptr_t) * CHAR_BIT)); push_pair(&tail, "byte-order", symbol(endianness)); return head; } value_t builtin_environment_stack(value_t *args, uint32_t nargs) { value_t head, tail; (void)args; argcount("environment-stack", nargs, 0); head = tail = fl_cons(envst_language(), FL_NIL); push(&tail, envst_language_c()); push(&tail, envst_os()); push(&tail, envst_computer()); return head; }