Add access?
[mes.git] / 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 #if _POSIX_SOURCE
91   char *p = getenv (string_to_cstring (s));
92   return p ? MAKE_STRING (cstring_to_list (p)) : cell_f;
93 #else
94   return cell_t;
95 #endif
96 }
97
98 SCM
99 open_input_file (SCM file_name)
100 {
101   return MAKE_NUMBER (open (string_to_cstring (file_name), O_RDONLY));
102 }
103
104 SCM
105 access_p (SCM file_name, SCM mode)
106 {
107   return access (string_to_cstring (file_name), VALUE (mode)) == 0 ? cell_t : cell_f;
108 }
109
110 SCM
111 current_input_port ()
112 {
113   return MAKE_NUMBER (g_stdin);
114 }
115
116 SCM
117 set_current_input_port (SCM port)
118 {
119   g_stdin = VALUE (port) ? VALUE (port) : STDIN;
120   return current_input_port ();
121 }
122
123 SCM
124 force_output (SCM p) ///((arity . n))
125 {
126   return cell_unspecified;
127 }