posix.c

   1 /* -*-comment-start: "//";comment-end:""-*-
   2  * Mes --- Maxwell Equations of Software
   3  * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
   4  *
   5  * This file is part of Mes.
   6  *
   7  * Mes is free software; you can redistribute it and/or modify it
   8  * under the terms of the GNU General Public License as published by
   9  * the Free Software Foundation; either version 3 of the License, or (at
  10  * your option) any later version.
  11  *
  12  * Mes is distributed in the hope that it will be useful, but
  13  * WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  19  */
  20
  21 #include <fcntl.h>
  22
  23 SCM
  24 stderr_ (SCM x)
  25 {
  26   SCM display;
  27   if ((display = assq_ref_cache (cell_symbol_display, r0)) != cell_undefined)
  28     apply_env (assq_ref_cache (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0);
  29   else if (TYPE (x) == SPECIAL || TYPE (x) == STRING || TYPE (x) == SYMBOL)
  30     fprintf (stderr, string_to_cstring (x));
  31   else
  32     fprintf (stderr, "display: undefined\n");
  33   return cell_unspecified;
  34 }
  35
  36 SCM
  37 force_output (SCM p) ///((arity . n))
  38 {
  39   int fd = 1;
  40   if (TYPE (p) == PAIR && TYPE (car (p)) == NUMBER) fd = VALUE (car (p));
  41   FILE *f = fd == 1 ? stdout : stderr;
  42   fflush (f);
  43   return cell_unspecified;
  44 }
  45
  46 SCM
  47 open_input_file (SCM file_name)
  48 {
  49   return MAKE_NUMBER (open (string_to_cstring (file_name), O_RDONLY));
  50 }
  51
  52 SCM
  53 current_input_port ()
  54 {
  55   return MAKE_NUMBER (fileno (g_stdin));
  56 }
  57
  58 SCM
  59 set_current_input_port (SCM port)
  60 {
  61   g_stdin = VALUE (port) ? fdopen (VALUE (port), "r") : stdin;
  62   return current_input_port ();
  63 }