mescc: Add getenv.

* module/mes/libc-i386.mes (i386:_start): Push environment pointer.
* module/mes/libc.mes (g_environment): New global.
  (_env): New function.
  (_start): Use it to set g_environment.
  (getenv): New function.
* lib/mlibc.c (strncmp): New function.
  (getenv): Implement.
* lib/mstart.c (_start): Set g_environment.
* module/mes/libc.mes (strncmp): New function.
  (libc): Add it.
* scaffold/t.c: (array_ref): Test it.

GNUmakefile

@@ -1,4 +1,5 @@
 SHELL:=bash
+export SHELL
 QUIET:=@
 
 default: all

libc/mlibc.c

@@ -18,6 +18,7 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+char **g_environment = 0;
 int g_stdin = 0;
 
 #define EOF -1
@@ -51,12 +52,6 @@ exit (int code)
   exit (0);
 }
 
-char const*
-getenv (char const* p)
-{
-  return 0;
-}
-
 int
 read (int fd, void* buf, size_t n)
 {
@@ -290,6 +285,28 @@ ungetc (int c, int fd)
   return c;
 }
 
+char const* itoa (int);
+
+int
+strncmp (char const* a, char const* b, int length)
+{
+  while (*a && *b && *a == *b && --length) {a++;b++;}
+  return *a - *b;
+}
+
+char const*
+getenv (char const* s)
+{
+  char **p = g_environment;
+  int length = strlen (s);
+  while (*p)
+    {
+      if (!strncmp (s, *p, length) && *(*p + length) == '=') return (*p + length + 1);
+      p++;
+    }
+  return 0;
+}
+
 int
 isdigit (int c)
 {

libc/mstart.c

@@ -22,6 +22,18 @@
 void
 _start ()
 {
+  //  char **;
+  asm (
+       "mov     %%ebp,%%eax\n\t"
+       "addl    $4,%%eax\n\t"
+       "movzbl  (%%eax),%%eax\n\t"
+       "addl    $3,%%eax\n\t"
+       "shl     $2,%%eax\n\t"
+       "add     %%ebp,%%eax\n\t"
+       "movl    %%eax,%0\n\t"
+       : "=g_environment" (g_environment)
+       : //no inputs ""
+       );
   int r;
   asm (
        "mov     %%ebp,%%eax\n\t"
@@ -36,7 +48,7 @@ _start ()
        "call    main\n\t"
        "movl    %%eax,%0\n\t"
        : "=r" (r)
-       : //no inputs "" (&main)
+       : //no inputs ""
        );
   exit (r);
 }

module/language/c99/compiler.mes

@@ -377,14 +377,13 @@
           (if global
               (let ((ptr (ident->pointer info o)))
                 (case ptr
-                  ((10)
-                   (list (lambda (f g ta t d)
-                           (i386:global->accu (+ (data-offset o g) d)))))
+                  ;; ((1)
+                  ;;  (list (lambda (f g ta t d)
+                  ;;          (i386:global->accu (+ (data-offset o g) d)))))
                   (else (list (lambda (f g ta t d)
                                 (append (i386:value->accu (+ (data-offset o g) d))))))))
               (error "TODO ident-address->accu" o))))))
 
-
 (define (ident-address->base info)
   (lambda (o)
     (let ((local (assoc-ref (.locals info) o))

module/mes/libc-i386.mes

@@ -125,10 +125,19 @@
                 " 0x89 0xe8"      ; mov    %ebp,%eax
                 " 0x83 0xc0 0x08" ; add    $0x8,%eax
                 " 0x50"           ; push   %eax
+
                 " 0x89 0xe8"      ; mov    %ebp,%eax
                 " 0x83 0xc0 0x04" ; add    $0x4,%eax
                 " 0x0f 0xb6 0x00" ; movzbl (%eax),%eax
                 " 0x50"           ; push   %eax
+
+                " 0x89 0xe8"            ; mov    %ebp,%eax
+                " 0x83 0xc0 0x04"       ; add    $0x4,%eax
+                " 0x0f 0xb6 0x00"       ; movzbl (%eax),%eax
+                " 0x83 0xc0 0x03"       ; add    $0x3,%eax
+                " 0xc1 0xe0 0x02"       ; shl    $0x2,%eax
+                " 0x01 0xe8"            ; add    %ebp,%eax
+                " 0x50"                 ; push   %eax
                 ))
 
 (define i386:libc

module/mes/libc.mes

@@ -34,7 +34,24 @@
 (define _start
   (let* ((argc-argv (i386:_start))
          (ast (with-input-from-string
-                  (string-append "int _start () {int i;asm(\"" argc-argv "\");i=main ();exit (i);}")
+                  (string-append "
+char **g_environment;
+char **
+_env (char **e)
+{
+  return e;
+}
+
+int
+_start ()
+{
+  asm(\"" argc-argv "\");
+  g_environment = _env ();
+  asm (\".byte 0x58\");
+  int r = main ();
+  exit (r);
+}
+")
                 parse-c99)))
     ast))
 
@@ -306,6 +323,43 @@ realloc (int *p, int size)
                 parse-c99)))
     ast))
 
+(define strncmp
+  (let* ((ast (with-input-from-string
+                  "
+int
+strncmp (char const* a, char const* b, int length)
+{
+  while (*a && *b && *a == *b && --length) {a++;b++;}
+  return *a - *b;
+}
+"
+;;paredit:"
+                parse-c99)))
+    ast))
+
+(define c:getenv
+  (let* ((ast (with-input-from-string
+                  "
+char **g_environment;
+char const*
+getenv (char const* s)
+{
+  char **p = g_environment;
+  p = *g_environment;
+  int length = strlen (s);
+  while (*p)
+    {
+      if (!strncmp (s, *p, length) && *(*p + length) == '=') return (*p + length + 1);
+      p++;
+    }
+  return 0;
+}
+"
+;;paredit:"
+                parse-c99)))
+    ast))
+
+
 (define libc
   (list
    strlen
@@ -322,4 +376,6 @@ realloc (int *p, int size)
    isdigit
    malloc
    realloc
+   strncmp
+   c:getenv
    ))

scaffold/cons-mes.c

@@ -23,6 +23,7 @@
 #endif
 
 #if  __MESC__
+char **g_environment;
 int g_stdin = 0;
 #define assert(x) ((x) ? (void)0 : assert_fail (#x))
 #endif

scaffold/hello.c

@@ -18,6 +18,12 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#if  __MESC__
+char **g_environment;
+int g_stdin = 0;
+#define assert(x) ((x) ? (void)0 : assert_fail (#x))
+#endif
+
 #if !__MESC__
 #include "mlibc.c"
 #endif

scaffold/m.c

@@ -18,6 +18,12 @@
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#if  __MESC__
+char **g_environment;
+int g_stdin = 0;
+#define assert(x) ((x) ? (void)0 : assert_fail (#x))
+#endif
+
 #if !__MESC__
 #include "mlibc.c"
 #endif

scaffold/micro-mes.c

@@ -22,6 +22,12 @@
 #error "POSIX not supported"
 #endif
 
+#if  __MESC__
+char **g_environment;
+int g_stdin = 0;
+#define assert(x) ((x) ? (void)0 : assert_fail (#x))
+#endif
+
 #if !__MESC__
 #include "mlibc.c"
 #endif

scaffold/mini-mes.c

@@ -23,6 +23,7 @@
 #endif
 
 #if  __MESC__
+char **g_environment;
 int g_stdin = 0;
 #define assert(x) ((x) ? (void)0 : assert_fail (#x))
 #endif

scaffold/scaffold.make

@@ -42,8 +42,8 @@ include make/check.make
 TARGET:=hello.mlibc
 C_FILES:=$(DIR)/hello.c
 INCLUDES:=libc
-C_FLAGS:=-nostdinc
-LD_FLAGS:=-nostdlib
+C_FLAGS:=-nostdinc -g
+LD_FLAGS:=-nostdlib -g
 CROSS:=$(CC32:%gcc=%)
 include make/bin.make
 

scaffold/t.c

@@ -245,6 +245,9 @@ array_test (char **e)
   puts ("t: *(p + 1)\n");
   if (*(*p + 1) != 'e') return 1;
 
+  puts ("t: getenv ()");
+  if (!getenv ("SHELL")) return 1;
+
   return read_test ();
 }
 

scaffold/tiny-mes.c

@@ -22,6 +22,12 @@
 #error "POSIX not supported"
 #endif
 
+#if  __MESC__
+char **g_environment;
+int g_stdin = 0;
+#define assert(x) ((x) ? (void)0 : assert_fail (#x))
+#endif
+
 #if !__MESC__
 #include "mlibc.c"
 #endif

src/mes.c

@@ -19,6 +19,7 @@
  */
 
 #if  __MESC__
+char **g_environment;
 int g_stdin = 0;
 #define assert(x) ((x) ? (void)0 : assert_fail (#x))
 #endif

src/posix.c

@@ -87,12 +87,9 @@ string_to_cstring (SCM s)
 SCM
 getenv_ (SCM s) ///((name . "getenv"))
 {
-#if _POSIX_SOURCE
-  char *p = getenv (string_to_cstring (s));
+  char *p;
+  p = getenv (string_to_cstring (s));
   return p ? MAKE_STRING (cstring_to_list (p)) : cell_f;
-#else
-  return cell_t;
-#endif
 }
 
 SCM