core: Add current-output-port, open-output-file, set-current-output-port.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 19 May 2017 04:56:47 +0000 (06:56 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 19 May 2017 04:56:47 +0000 (06:56 +0200)
* 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
libc/include/stdio.h
libc/mlibc.c
module/language/c99/compiler.mes
module/mes/guile.mes
module/mes/libc-i386.mes
module/mes/posix.mes
scaffold/mini-mes.c
src/mes.c
src/posix.c

index 18e73f6f9ff8428315e4cf4cb94fe34925b4a151..5a7cc5759e63956dfa9f00d0b161e3217cfa9dd3 100644 (file)
 
 #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
index 40817e4c9ad31ac9350e15c495b57e2c01776bda..608e28a04c96f83cd1bab79bf26f7ebc2d372649 100644 (file)
@@ -22,6 +22,7 @@
 
 char **g_environment;
 int g_stdin;
+int g_stdout;
 
 #define EOF -1
 #define NULL 0
index fd9ee0a9d1f308ad4c156e8c57e553c62041deb0..620742ba6f2572be0e6d64e176c72d137529a310 100644 (file)
@@ -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)
-       : "eax", "ebx", "ecx"
+       : "" (s), "" (flags), "" (mode)
+       : "eax", "ebx", "ecx", "edx"
        );
   return r;
 }
index 0c946e548bfb9d4a546392587fd24587dc244b95..e461004fdba4b8602db028d9c4e47526957f5b69 100644 (file)
@@ -67,7 +67,6 @@
                 "STDIN=0"
                 "STDOUT=1"
                 "STDERR=2"
-                "O_RDONLY=0"
 
                 "INT_MIN=-2147483648"
                 "INT_MAX=2147483647"
index 6bd87d7ff4b73a01b7acdd1df1ff50a58ed4a70f..6aadff3ad7d9e2a6a5c4a502a890a3bbd795dd3a 100644 (file)
           (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))
index 905caeac5f1e4231add7933f5e62947edf981661..6f72f54b1cf6dcc84973131d202b8804227ce43a 100644 (file)
@@ -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
index e6d5bd0b6551a6f85f403a014ff7a6105a7bdd56..3482e55dcb4b231b2025afa6ca9722f375f9ce0e 100644 (file)
@@ -23,3 +23,5 @@
 ;;; Code:
 
 (define R_OK 0)
+(define S_IRWXU #o700)
+
index ef6415bcbed23b80157fc141764c4ea0049b9062..7c33fe9f296a879a41d77592b87530acd4ebb1f2 100644 (file)
@@ -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);
index c2801512bebae602eaa4103ea4d6a1bf99a8db9a..0c353a93cfb76807d795605d1bc53e5814715bb6 100644 (file)
--- a/src/mes.c
+++ b/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__
index abb4ac705d220e7820c342b8ffca83a7452aa8cc..63a5ccc26f27b5b9e9179bf691f7a798e49ec949 100644 (file)
@@ -58,8 +58,9 @@ write_byte (SCM x) ///((arity . n))
 {
   SCM c = car (x);
   SCM p = cdr (x);
-  int fd = 1;
-  if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
+  int fd = g_stdout;
+  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))
 {