From 5012977d3249a0eab30f1dcf71daed8a9157b54d Mon Sep 17 00:00:00 2001
From: Lassi Kortela <lassi@lassi.io>
Date: Sun, 11 Aug 2019 23:27:38 +0300
Subject: [PATCH] Start environment-stack implementation

---
 c/env.h       |   2 +
 c/env_unix.c  | 101 ++++++++++++++++++++++++++++++++++++++++++++++++++
 c/libraries.c |   2 +
 3 files changed, 105 insertions(+)

diff --git a/c/env.h b/c/env.h
index 1608e04..fcd8b7d 100644
--- a/c/env.h
+++ b/c/env.h
@@ -1 +1,3 @@
 const char *env_get_os_name(void);
+
+value_t builtin_environment_stack(value_t *args, uint32_t nargs);
diff --git a/c/env_unix.c b/c/env_unix.c
index fa9e0f1..0f56502 100644
--- a/c/env_unix.c
+++ b/c/env_unix.c
@@ -1,7 +1,39 @@
+#include <sys/types.h>
+
+#include <sys/stat.h>
+#include <sys/time.h>
 #include <sys/utsname.h>
 
+#include <assert.h>
+#include <ctype.h>
+#include <errno.h>
+#include <limits.h>
+#include <math.h>
+#include <setjmp.h>
+#include <stdarg.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <stdlib.h>
 #include <string.h>
 
+#include "dtypes.h"
+#include "utils.h"
+#include "utf8.h"
+#include "ios.h"
+#include "socket.h"
+#include "timefuncs.h"
+#include "hashing.h"
+#include "htable.h"
+#include "htableh_inc.h"
+#include "bitvector.h"
+#include "fs.h"
+#include "random.h"
+#include "llt.h"
+
+#include "flisp.h"
+
+#include "argcount.h"
+
 static const struct utsname *get_global_uname(void)
 {
     static struct utsname buf;
@@ -15,3 +47,72 @@ static const struct utsname *get_global_uname(void)
 }
 
 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_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_os());
+    push(&tail, envst_computer());
+    return head;
+}
diff --git a/c/libraries.c b/c/libraries.c
index 2f439a8..93aafed 100644
--- a/c/libraries.c
+++ b/c/libraries.c
@@ -83,6 +83,8 @@ static struct builtin_procedure builtin_procedures[] = {
     { "string-reverse", fl_string_reverse, SRFI_13 | UP_2019 },
     { "substring", fl_string_sub, R7RS_BASE | UP_2019 },
 
+    { "environment-stack", builtin_environment_stack, UP_2019 },
+
     { 0, 0, 0 },
 };