mescc: Add missing defines.
[mes.git] / 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 //MINI_MES
24 // SCM
25 // write_byte (SCM x) ///((arity . n))
26 // {
27 //   SCM c = car (x);
28 //   SCM p = cdr (x);
29 //   int fd = 1;
30 //   if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
31 //   FILE *f = fd == 1 ? stdout : stderr;
32 //   assert (TYPE (c) == TNUMBER || TYPE (c) == TCHAR);
33 //   fputc (VALUE (c), f);
34 //   return c;
35 // }
36
37 char const* string_to_cstring (SCM);
38
39 // SCM
40 // stderr_ (SCM x)
41 // {
42 //   SCM write;
43 //   if (TYPE (x) == TSTRING)
44 //     fprintf (stderr, string_to_cstring (x));
45 //   else if ((write = assq_ref_env (cell_symbol_write, r0)) != cell_undefined)
46 //     apply (assq_ref_env (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0);
47 //   else if (TYPE (x) == TSPECIAL || TYPE (x) == TSTRING || TYPE (x) == TSYMBOL)
48 //     fprintf (stderr, string_to_cstring (x));
49 //   else if (TYPE (x) == TNUMBER)
50 //     fprintf (stderr, "%d", VALUE (x));
51 //   else
52 //     fprintf (stderr, "display: undefined\n");
53 //   return cell_unspecified;
54 // }
55
56 SCM
57 getenv_ (SCM s) ///((name . "getenv"))
58 {
59   char *p = getenv (string_to_cstring (s));
60   return p ? MAKE_STRING (cstring_to_list (p)) : cell_f;
61 }
62
63 // MINI_MES
64 // int
65 // getchar ()
66 // {
67 //   return getc (g_stdin);
68 // }
69
70 // int
71 // ungetchar (int c)
72 // {
73 //   return ungetc (c, g_stdin);
74 // }
75
76 // int
77 // peekchar ()
78 // {
79 //   int c = getchar ();
80 //   ungetchar (c);
81 //   return c;
82 // }
83
84 // SCM
85 // peek_byte ()
86 // {
87 //   return MAKE_NUMBER (peekchar ());
88 // }
89
90 // SCM
91 // read_byte ()
92 // {
93 //   return MAKE_NUMBER (getchar ());
94 // }
95
96 // SCM
97 // unread_byte (SCM i)
98 // {
99 //   ungetchar (VALUE (i));
100 //   return i;
101 // }
102
103 SCM
104 force_output (SCM p) ///((arity . n))
105 {
106   int fd = 1;
107   if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER) fd = VALUE (car (p));
108   FILE *f = fd == 1 ? stdout : stderr;
109   fflush (f);
110   return cell_unspecified;
111 }
112
113 SCM
114 open_input_file (SCM file_name)
115 {
116   return MAKE_NUMBER (open (string_to_cstring (file_name), O_RDONLY));
117 }
118
119 SCM
120 current_input_port ()
121 {
122   return MAKE_NUMBER (fileno (g_stdin));
123 }
124
125 SCM
126 set_current_input_port (SCM port)
127 {
128   g_stdin = VALUE (port) ? fdopen (VALUE (port), "r") : stdin;
129   return current_input_port ();
130 }