1 /* -*-comment-start: "//";comment-end:""-*-
2 * Mes --- Maxwell Equations of Software
3 * Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
5 * This file is part of Mes.
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.
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.
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/>.
39 SCM port = current_input_port ();
40 return VALUE (CAR (STRING (port)));
48 SCM port = current_input_port ();
49 SCM string = STRING (port);
50 if (string == cell_nil)
52 int c = VALUE (CAR (string));
53 STRING (port) = CDR (string);
61 return ungetc (c, g_stdin);
62 SCM port = current_input_port ();
63 STRING (port) = cons (MAKE_CHAR (c), STRING (port));
70 return MAKE_NUMBER (peekchar ());
76 return MAKE_NUMBER (readchar ());
82 unreadchar (VALUE (i));
89 return MAKE_CHAR (peekchar ());
95 return MAKE_CHAR (readchar ());
101 unreadchar (VALUE (i));
106 write_char (SCM i) ///((arity . n))
116 SCM c = read_char ();
117 while (VALUE (c) != -1)
119 lst = append2 (lst, cons (c, cell_nil));
122 return MAKE_STRING (lst);
126 write_byte (SCM x) ///((arity . n))
131 if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER && VALUE (CAR (p)) != 1)
132 fd = VALUE (CAR (p));
134 write (fd, (char*)&cc, 1);
136 assert (TYPE (c) == TNUMBER || TYPE (c) == TCHAR);
141 char string_to_cstring_buf[4096];
143 string_to_cstring_ (SCM s, char *buf)
147 while (s != cell_nil)
149 *p++ = VALUE (car (s));
157 string_to_cstring (SCM s)
159 return string_to_cstring_ (s, string_to_cstring_buf);
163 getenv_ (SCM s) ///((name . "getenv"))
166 p = getenv (string_to_cstring (s));
167 return p ? MAKE_STRING (cstring_to_list (p)) : cell_f;
171 setenv_ (SCM s, SCM v) ///((name . "setenv"))
174 strcpy (buf, string_to_cstring (s));
175 setenv (buf, string_to_cstring (v), 1);
176 return cell_unspecified;
180 access_p (SCM file_name, SCM mode)
182 return access (string_to_cstring (file_name), VALUE (mode)) == 0 ? cell_t : cell_f;
186 current_input_port ()
189 return MAKE_NUMBER (g_stdin);
191 while (x && PORT (CAR (x)) != g_stdin)
197 open_input_file (SCM file_name)
199 return MAKE_NUMBER (open (string_to_cstring (file_name), O_RDONLY));
203 open_input_string (SCM string)
205 SCM port = MAKE_STRING_PORT (STRING (string));
206 g_ports = cons (port, g_ports);
211 set_current_input_port (SCM port)
213 SCM prev = current_input_port ();
214 if (TYPE (port) == TNUMBER)
215 g_stdin = VALUE (port) ? VALUE (port) : STDIN;
216 else if (TYPE (port) == TPORT)
217 g_stdin = PORT (port);
222 current_output_port ()
224 return MAKE_NUMBER (g_stdout);
228 open_output_file (SCM x) ///((arity . n))
230 SCM file_name = car (x);
232 int mode = S_IRUSR|S_IWUSR;
233 if (TYPE (x) == TPAIR && TYPE (car (x)) == TNUMBER)
234 mode = VALUE (car (x));
235 return MAKE_NUMBER (open (string_to_cstring (file_name), O_WRONLY|O_CREAT|O_TRUNC,mode));
239 set_current_output_port (SCM port)
241 g_stdout = VALUE (port) ? VALUE (port) : STDOUT;
242 return current_output_port ();
246 force_output (SCM p) ///((arity . n))
248 return cell_unspecified;
252 chmod_ (SCM file_name, SCM mode) ///((name . "chmod"))
254 chmod (string_to_cstring (file_name), VALUE (mode));
255 return cell_unspecified;
261 return isatty (VALUE (port)) ? cell_t : cell_f;
267 return MAKE_NUMBER (fork ());
271 execl_ (SCM file_name, SCM args) ///((name . "execl"))
276 c_argv[i++] = string_to_cstring_ (file_name, string_to_cstring_buf+n);
277 n += length__ (STRING (file_name)) + 1;
278 while (args != cell_nil)
280 assert (TYPE (CAR (args)) == TSTRING);
282 c_argv[i++] = string_to_cstring_ (CAR (args), string_to_cstring_buf+n);
283 n += length__ (STRING (CAR (args))) + 1;
287 return MAKE_NUMBER (execve (c_argv[0], c_argv, g_environment));
291 waitpid_ (SCM pid, SCM options)
294 int child = waitpid (VALUE (pid), &status, VALUE (options));
295 return cons (MAKE_NUMBER (child), MAKE_NUMBER (status));