src/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 int
  22 ungetchar (int c)
  23 {
  24   return ungetc (c, g_stdin);
  25 }
  26
  27 int
  28 peekchar ()
  29 {
  30   int c = getchar ();
  31   ungetchar (c);
  32   return c;
  33 }
  34
  35 SCM
  36 peek_byte ()
  37 {
  38   return MAKE_NUMBER (peekchar ());
  39 }
  40
  41 SCM
  42 read_byte ()
  43 {
  44   return MAKE_NUMBER (getchar ());
  45 }
  46
  47 SCM
  48 unread_byte (SCM i)
  49 {
  50   ungetchar (VALUE (i));
  51   return i;
  52 }
  53
  54 SCM
  55 write_byte (SCM x) ///((arity . n))
  56 {
  57   SCM c = car (x);
  58   SCM p = cdr (x);
  59   int fd = 1;
  60   if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
  61   char cc = VALUE (c);
  62   write (fd, (char*)&cc, 1);
  63 #if !__MESC__
  64   assert (TYPE (c) == TNUMBER || TYPE (c) == TCHAR);
  65 #endif
  66   return c;
  67 }
  68
  69 char string_to_cstring_buf[1024];
  70 char const*
  71 string_to_cstring (SCM s)
  72 {
  73   //static char buf[1024];
  74   //char *p = buf;
  75   char *p = string_to_cstring_buf;
  76   s = STRING(s);
  77   while (s != cell_nil)
  78     {
  79       *p++ = VALUE (car (s));
  80       s = cdr (s);
  81     }
  82   *p = 0;
  83   //return buf;
  84   return string_to_cstring_buf;
  85 }
  86
  87 SCM
  88 getenv_ (SCM s) ///((name . "getenv"))
  89 {
  90   char *p;
  91   p = getenv (string_to_cstring (s));
  92   return p ? MAKE_STRING (cstring_to_list (p)) : cell_f;
  93 }
  94
  95 SCM
  96 open_input_file (SCM file_name)
  97 {
  98   return MAKE_NUMBER (open (string_to_cstring (file_name), O_RDONLY));
  99 }
 100
 101 SCM
 102 access_p (SCM file_name, SCM mode)
 103 {
 104   return access (string_to_cstring (file_name), VALUE (mode)) == 0 ? cell_t : cell_f;
 105 }
 106
 107 SCM
 108 current_input_port ()
 109 {
 110   return MAKE_NUMBER (g_stdin);
 111 }
 112
 113 SCM
 114 set_current_input_port (SCM port)
 115 {
 116   g_stdin = VALUE (port) ? VALUE (port) : STDIN;
 117   return current_input_port ();
 118 }
 119
 120 SCM
 121 force_output (SCM p) ///((arity . n))
 122 {
 123   return cell_unspecified;
 124 }