core: Add current-output-port, open-output-file, set-current-output-port.

* libc/include/fcntl.h: Declare it.  Add some fcntl defines.
* libc/include/stdio.h: Remove fcntl defines, Declare g_stdout.
* module/language/c99/compiler.mes (c99-input->ast): Define O_WRONLY, O_RDWR.
* module/mes/guile.mes (with-output-to-file, with-output-to-port): New functions.
* src/posix.c (current_output_port, open_output_file,
  set_current_output_port): New functions.
* libc/mlibc.c (open): Add optional mode parameter.
* module/mes/libc-i386.mes (i386:open): Forward third parameter.
* scaffold/mini-mes.c (main): Init g_stdout.
* src/mes.c (main): Likewise.

libc/include/fcntl.h

@@ -28,7 +28,16 @@
 
 #else // ! (__GNUC__ && POSIX)
 #define O_RDONLY 0
-int open (char const *s, int mode);
+#define O_WRONLY 1
+#define O_RDWR 2
+#define O_CREAT 64
+#define O_TRUNC 512
+
+#define S_IRWXU 00700
+#define S_IXUSR 00100
+#define S_IWUSR 00200
+#define S_IRUSR 00400
+int open (char const *s, int flags, ...);
 #endif // ! (__GNUC__ && POSIX)
 
 #endif // __FCNTL_H

libc/include/stdio.h

@@ -22,6 +22,7 @@
 
 char **g_environment;
 int g_stdin;
+int g_stdout;
 
 #define EOF -1
 #define NULL 0

libc/mlibc.c

@@ -84,19 +84,29 @@ write (int fd, char const* s, int n)
 }
 
 int
-open (char const *s, int mode)
+open (char const *s, int flags, ...)
 {
+  int mode;
+  asm (
+       "mov %%ebp,%%eax\n\t"
+       "add $0x10,%%eax\n\t"
+       "mov (%%eax),%%eax\n\t"
+       "mov %%eax,%0\n\t"
+       : "=mode" (mode)
+       : //no inputs ""
+       );
   int r;
   //syscall (SYS_open, mode));
   asm (
        "mov %1,%%ebx\n\t"
        "mov %2,%%ecx\n\t"
+       "mov %3,%%edx\n\t"
        "mov $0x5,%%eax\n\t"
        "int $0x80\n\t"
        "mov %%eax,%0\n\t"
        : "=r" (r)
-       : "" (s), "" (mode)
+       : "" (s), "" (flags), "" (mode)
-       : "eax", "ebx", "ecx"
+       : "eax", "ebx", "ecx", "edx"
        );
   return r;
 }

module/language/c99/compiler.mes

@@ -67,7 +67,6 @@
                 "STDIN=0"
                 "STDOUT=1"
                 "STDERR=2"
-                "O_RDONLY=0"
 
                 "INT_MIN=-2147483648"
                 "INT_MAX=2147483647"

module/mes/guile.mes

@@ -85,6 +85,23 @@
           (set-current-input-port save)
           r))))
 
+(define (with-output-to-file file thunk)
+  (let ((port (open-output-file file)))
+    (if (= port -1)
+        (error 'cannot-open file)
+        (let* ((save (current-output-port))
+               (foo (set-current-output-port port))
+               (r (thunk)))
+          (set-current-output-port save)
+          r))))
+
+(define (with-output-to-port port thunk)
+  (let* ((save (current-output-port))
+         (foo (set-current-output-port port))
+         (r (thunk)))
+    (set-current-output-port save)
+    r))
+
 (define open-input-string
   (let ((save-set-current-input-port #f)
         (string-port #f))

module/mes/libc-i386.mes

@@ -71,6 +71,7 @@
 
     #x8b #x5d #x08                      ; mov    0x8(%ebp),%ebx
     #x8b #x4d #x0c                      ; mov    0xc(%ebp),%ecx
+    #x8b #x55 #x10                      ; mov    0x10(%ebp),%edx
 
     #xb8 #x05 #x00 #x00 #x00            ; mov    $0x5,%eax
     #xcd #x80                           ; int    $0x80

module/mes/posix.mes

@@ -23,3 +23,5 @@
 ;;; Code:
 
 (define R_OK 0)
+(define S_IRWXU #o700)
+

scaffold/mini-mes.c

@@ -1204,6 +1204,7 @@ main (int argc, char *argv[])
   if (p = getenv ("MES_ARENA")) ARENA_SIZE = atoi (p);
   if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("Usage: mes [--dump|--load] < FILE\n");
   if (argc > 1 && !strcmp (argv[1], "--version")) {puts ("Mes ");puts (VERSION);puts ("\n");return 0;};
+  g_stdout = STDOUT;
   r0 = mes_environment ();
 
   SCM program = bload_env (r0);

src/mes.c

@@ -1338,6 +1338,7 @@ main (int argc, char *argv[])
   if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("Usage: mes [--dump|--load] < FILE\n");
   if (argc > 1 && !strcmp (argv[1], "--version")) {puts ("Mes ");puts (VERSION);puts ("\n");return 0;};
   g_stdin = STDIN;
+  g_stdout = STDOUT;
   r0 = mes_environment ();
 
 #if __MESC__

src/posix.c

@@ -58,8 +58,9 @@ write_byte (SCM x) ///((arity . n))
 {
   SCM c = car (x);
   SCM p = cdr (x);
-  int fd = 1;
+  int fd = g_stdout;
-  if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
+  if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER && VALUE (CAR (p)) != 1)
+    fd = VALUE (CAR (p));
   char cc = VALUE (c);
   write (fd, (char*)&cc, 1);
 #if !__MESC__
@@ -94,12 +95,6 @@ getenv_ (SCM s) ///((name . "getenv"))
   return p ? MAKE_STRING (cstring_to_list (p)) : cell_f;
 }
 
-SCM
-open_input_file (SCM file_name)
-{
-  return MAKE_NUMBER (open (string_to_cstring (file_name), O_RDONLY));
-}
-
 SCM
 access_p (SCM file_name, SCM mode)
 {
@@ -112,6 +107,12 @@ current_input_port ()
   return MAKE_NUMBER (g_stdin);
 }
 
+SCM
+open_input_file (SCM file_name)
+{
+  return MAKE_NUMBER (open (string_to_cstring (file_name), O_RDONLY));
+}
+
 SCM
 set_current_input_port (SCM port)
 {
@@ -119,6 +120,29 @@ set_current_input_port (SCM port)
   return current_input_port ();
 }
 
+SCM
+current_output_port ()
+{
+  return MAKE_NUMBER (g_stdout);
+}
+
+SCM
+open_output_file (SCM x) ///((arity . n))
+{
+  SCM file_name = car (x);
+  x = cdr (x);
+  int mode = S_IRUSR|S_IWUSR;
+  if (TYPE (x) == TPAIR && TYPE (car (x)) == TNUMBER) mode = VALUE (car (x));
+  return MAKE_NUMBER (open (string_to_cstring (file_name), O_WRONLY|O_CREAT|O_TRUNC,mode));
+}
+
+SCM
+set_current_output_port (SCM port)
+{
+  g_stdout = VALUE (port) ? VALUE (port) : STDOUT;
+  return current_output_port ();
+}
+
 SCM
 force_output (SCM p) ///((arity . n))
 {