2d483c9ab32a9108c265047ae906b7afdc055594
[mes.git] / src / posix.c
1 /* -*-comment-start: "//";comment-end:""-*-
2  * Mes --- Maxwell Equations of Software
3  * Copyright © 2016,2017,2018 Jan (janneke) 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 <sys/stat.h>
22 #include <fcntl.h>
23 #include <stdlib.h>
24 #include <unistd.h>
25
26 int readchar ();
27 int unreadchar ();
28
29 int
30 peekchar ()
31 {
32   if (g_stdin >= 0)
33     {
34       int c = readchar ();
35       unreadchar (c);
36       return c;
37     }
38   SCM port = current_input_port ();
39   return VALUE (CAR (STRING (port)));
40 }
41
42 int
43 readchar ()
44 {
45   if (g_stdin >= 0)
46     return  getchar ();
47   SCM port = current_input_port ();
48   SCM string = STRING (port);
49   if (string == cell_nil)
50     return -1;
51   int c = VALUE (CAR (string));
52   STRING (port) = CDR (string);
53   return c;
54 }
55
56 int
57 unreadchar (int c)
58 {
59   if (g_stdin >= 0)
60     return ungetc (c, g_stdin);
61   SCM port = current_input_port ();
62   STRING (port) = cons (MAKE_CHAR (c), STRING (port));
63   return c;
64 }
65
66 SCM
67 peek_byte ()
68 {
69   return MAKE_NUMBER (peekchar ());
70 }
71
72 SCM
73 read_byte ()
74 {
75   return MAKE_NUMBER (readchar ());
76 }
77
78 SCM
79 unread_byte (SCM i)
80 {
81   unreadchar (VALUE (i));
82   return i;
83 }
84
85 SCM
86 peek_char ()
87 {
88   return MAKE_CHAR (peekchar ());
89 }
90
91 SCM
92 read_char ()
93 {
94   return MAKE_CHAR (readchar ());
95 }
96
97 SCM
98 unread_char (SCM i)
99 {
100   unreadchar (VALUE (i));
101   return i;
102 }
103
104 SCM
105 write_char (SCM i) ///((arity . n))
106 {
107   write_byte (i);
108   return i;
109 }
110
111 SCM
112 read_string ()
113 {
114   SCM lst = cell_nil;
115   SCM c = read_char ();
116   while (VALUE (c) != -1)
117     {
118       lst = append2 (lst, cons (c, cell_nil));
119       c = read_char ();
120     }
121   return MAKE_STRING (lst);
122 }
123
124 SCM
125 write_byte (SCM x) ///((arity . n))
126 {
127   SCM c = car (x);
128   SCM p = cdr (x);
129   int fd = g_stdout;
130   if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER && VALUE (CAR (p)) != 1)
131     fd = VALUE (CAR (p));
132   char cc = VALUE (c);
133   write (fd, (char*)&cc, 1);
134 #if !__MESC__
135   assert (TYPE (c) == TNUMBER || TYPE (c) == TCHAR);
136 #endif
137   return c;
138 }
139
140 char string_to_cstring_buf[1024];
141 char const*
142 string_to_cstring (SCM s)
143 {
144   //static char buf[1024];
145   //char *p = buf;
146   char *p = string_to_cstring_buf;
147   s = STRING(s);
148   while (s != cell_nil)
149     {
150       *p++ = VALUE (car (s));
151       s = cdr (s);
152     }
153   *p = 0;
154   //return buf;
155   return string_to_cstring_buf;
156 }
157
158 SCM
159 getenv_ (SCM s) ///((name . "getenv"))
160 {
161   char *p;
162   p = getenv (string_to_cstring (s));
163   return p ? MAKE_STRING (cstring_to_list (p)) : cell_f;
164 }
165
166 SCM
167 setenv_ (SCM s, SCM v) ///((name . "setenv"))
168 {
169   char buf[1024];
170   strcpy (buf, string_to_cstring (s));
171   setenv (buf, string_to_cstring (v), 1);
172   return cell_unspecified;
173 }
174
175 SCM
176 access_p (SCM file_name, SCM mode)
177 {
178   return access (string_to_cstring (file_name), VALUE (mode)) == 0 ? cell_t : cell_f;
179 }
180
181 SCM
182 current_input_port ()
183 {
184   if (g_stdin >= 0)
185     return MAKE_NUMBER (g_stdin);
186   SCM x = g_ports;
187   while (x && PORT (CAR (x)) != g_stdin)
188     x = CDR (x);
189   return CAR (x);
190 }
191
192 SCM
193 open_input_file (SCM file_name)
194 {
195   return MAKE_NUMBER (open (string_to_cstring (file_name), O_RDONLY));
196 }
197
198 SCM
199 open_input_string (SCM string)
200 {
201   SCM port = MAKE_STRING_PORT (STRING (string));
202   g_ports = cons (port, g_ports);
203   return port;
204 }
205
206 SCM
207 set_current_input_port (SCM port)
208 {
209   SCM prev = current_input_port ();
210   if (TYPE (port) == TNUMBER)
211     g_stdin = VALUE (port) ? VALUE (port) : STDIN;
212   else if (TYPE (port) == TPORT)
213     g_stdin = PORT (port);
214   return prev;
215 }
216
217 SCM
218 current_output_port ()
219 {
220   return MAKE_NUMBER (g_stdout);
221 }
222
223 SCM
224 open_output_file (SCM x) ///((arity . n))
225 {
226   SCM file_name = car (x);
227   x = cdr (x);
228   int mode = S_IRUSR|S_IWUSR;
229   if (TYPE (x) == TPAIR && TYPE (car (x)) == TNUMBER)
230     mode = VALUE (car (x));
231   return MAKE_NUMBER (open (string_to_cstring (file_name), O_WRONLY|O_CREAT|O_TRUNC,mode));
232 }
233
234 SCM
235 set_current_output_port (SCM port)
236 {
237   g_stdout = VALUE (port) ? VALUE (port) : STDOUT;
238   return current_output_port ();
239 }
240
241 SCM
242 force_output (SCM p) ///((arity . n))
243 {
244   return cell_unspecified;
245 }
246
247 SCM
248 chmod_ (SCM file_name, SCM mode) ///((name . "chmod"))
249 {
250   chmod (string_to_cstring (file_name), VALUE (mode));
251   return cell_unspecified;
252 }
253
254 SCM
255 isatty_p (SCM port)
256 {
257   return isatty (VALUE (port)) ? cell_t : cell_f;
258 }