artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: Prepare for M2-Planet: posix.c.

Browse source 
* src/posix.c: Rewrite C constructs not supported by M2-Planet.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-04-20 19:47:10 +02:00
parent 988217e232
commit 188d80ffc4
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
1 changed files with 73 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

104
src/posix.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of GNU Mes.
*
@ -46,7 +46,7 @@ peekchar ()
SCM port = current_input_port ();
SCM string = STRING (port);
size_t length = LENGTH (string);
if (!length)
if (length == 0)
return -1;
char const *p = CSTRING (string);
return p[0];
@ -60,10 +60,11 @@ readchar ()
SCM port = current_input_port ();
SCM string = STRING (port);
size_t length = LENGTH (string);
if (!length)
if (length == 0)
return -1;
char const *p = CSTRING (string);
int c = *p++;
int c = p[0];
p = p + 1;
STRING (port) = make_string (p, length - 1);
return c;
}
@ -73,13 +74,13 @@ unreadchar (int c)
{
if (__stdin >= 0)
return fdungetc (c, __stdin);
if (c == EOF) // can't unread EOF
if (c == EOF) /* can't unread EOF */
return c;
SCM port = current_input_port ();
SCM string = STRING (port);
size_t length = LENGTH (string);
char *p = CSTRING (string);
p--;
p = p - 1;
string = make_string (p, length + 1);
p = CSTRING (string);
p[0] = c;
@ -113,7 +114,7 @@ peek_char ()
}
SCM
read_char (SCM port) ///((arity . n))
read_char (SCM port) /*:((arity . n)) */
{
int fd = __stdin;
if (TYPE (port) == TPAIR && TYPE (car (port)) == TNUMBER)
@ -131,14 +132,14 @@ unread_char (SCM i)
}
SCM
write_char (SCM i) ///((arity . n))
write_char (SCM i) /*:((arity . n)) */
{
write_byte (i);
return i;
}
SCM
write_byte (SCM x) ///((arity . n))
write_byte (SCM x) /*:((arity . n)) */
{
SCM c = car (x);
SCM p = cdr (x);
@ -148,7 +149,7 @@ write_byte (SCM x) ///((arity . n))
if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER && VALUE (CAR (p)) == 2)
fd = __stderr;
char cc = VALUE (c);
write (fd, (char *) &cc, 1);
write (fd, &cc, 1);
#if !__MESC__
assert (TYPE (c) == TNUMBER || TYPE (c) == TCHAR);
#endif
@ -156,17 +157,19 @@ write_byte (SCM x) ///((arity . n))
}
SCM
getenv_ (SCM s) ///((name . "getenv"))
getenv_ (SCM s) /*:((name . "getenv")) */
{
char *p;
p = getenv (CSTRING (s));
return p ? MAKE_STRING0 (p) : cell_f;
if (p != 0)
return MAKE_STRING0 (p);
return cell_f;
}
SCM
setenv_ (SCM s, SCM v) ///((name . "setenv"))
setenv_ (SCM s, SCM v) /*:((name . "setenv")) */
{
char buf[1024];
char *buf = __setenv_buf;
strcpy (buf, CSTRING (s));
setenv (buf, CSTRING (v), 1);
return cell_unspecified;
@ -175,7 +178,9 @@ setenv_ (SCM s, SCM v) ///((name . "setenv"))
SCM
access_p (SCM file_name, SCM mode)
{
return access (CSTRING (file_name), VALUE (mode)) == 0 ? cell_t : cell_f;
if (access (CSTRING (file_name), VALUE (mode)) == 0)
return cell_t;
return cell_f;
}
SCM
@ -211,7 +216,13 @@ set_current_input_port (SCM port)
{
SCM prev = current_input_port ();
if (TYPE (port) == TNUMBER)
__stdin = VALUE (port) ? VALUE (port) : STDIN;
{
int p = VALUE (port);
if (p != 0)
__stdin = p;
else
__stdin = STDIN;
}
else if (TYPE (port) == TPORT)
__stdin = PORT (port);
return prev;
@ -230,7 +241,7 @@ current_error_port ()
}
SCM
open_output_file (SCM x) ///((arity . n))
open_output_file (SCM x) /*:((arity . n)) */
{
SCM file_name = car (x);
x = cdr (x);
@ -243,19 +254,25 @@ open_output_file (SCM x) ///((arity . n))
SCM
set_current_output_port (SCM port)
{
__stdout = VALUE (port) ? VALUE (port) : STDOUT;
if (VALUE (port) != 0)
__stdout = VALUE (port);
else
__stdout = STDOUT;
return current_output_port ();
}
SCM
set_current_error_port (SCM port)
{
__stderr = VALUE (port) ? VALUE (port) : STDERR;
if (VALUE (port) != 0)
__stderr = VALUE (port);
else
__stderr = STDERR;
return current_error_port ();
}
SCM
chmod_ (SCM file_name, SCM mode) ///((name . "chmod"))
chmod_ (SCM file_name, SCM mode) /*:((name . "chmod")) */
{
chmod (CSTRING (file_name), VALUE (mode));
return cell_unspecified;
@ -264,7 +281,9 @@ chmod_ (SCM file_name, SCM mode) ///((name . "chmod"))
SCM
isatty_p (SCM port)
{
return isatty (VALUE (port)) ? cell_t : cell_f;
if (isatty (VALUE (port)) != 0)
return cell_t;
return cell_f;
}
SCM
@ -274,19 +293,21 @@ primitive_fork ()
}
SCM
execl_ (SCM file_name, SCM args) ///((name . "execl"))
execl_ (SCM file_name, SCM args) /*:((name . "execl")) */
{
char *c_argv[1000]; // POSIX minimum 4096
char **c_argv = __execl_c_argv;
int i = 0;
if (length__ (args) > 1000)
error (cell_symbol_system_error,
cons (file_name, cons (MAKE_STRING0 ("too many arguments"), cons (file_name, args))));
c_argv[i++] = CSTRING (file_name);
c_argv[i] = CSTRING (file_name);
i = i + 1;
while (args != cell_nil)
{
assert (TYPE (CAR (args)) == TSTRING);
c_argv[i++] = CSTRING (CAR (args));
c_argv[i] = CSTRING (CAR (args));
i = i + 1;
args = CDR (args);
if (g_debug > 2)
{
@ -317,9 +338,22 @@ waitpid_ (SCM pid, SCM options)
#define TIME_UNITS_PER_SECOND 1000
#endif
#if __M2_PLANET
struct timespec
{
long tv_sec;
long tv_nsec;
};
struct timeval
{
long tv_sec;
long tv_usec;
};
#endif
struct timespec g_start_time;
SCM
init_time (SCM a) ///((internal))
init_time (SCM a) /*:((internal)) */
{
clock_gettime (CLOCK_PROCESS_CPUTIME_ID, &g_start_time);
a = acons (cell_symbol_internal_time_units_per_second, MAKE_NUMBER (TIME_UNITS_PER_SECOND), a);
@ -332,11 +366,15 @@ current_time ()
}
SCM
gettimeofday_ () ///((name . "gettimeofday"))
gettimeofday_ () /*:((name . "gettimeofday")) */
{
#if __M2_PLANET__
return MAKE_NUMBER (0);
#else
struct timeval time;
gettimeofday (&time, 0);
return cons (MAKE_NUMBER (time.tv_sec), MAKE_NUMBER (time.tv_usec));
#endif
}
long
@ -348,28 +386,32 @@ seconds_and_nanoseconds_to_long (long s, long ns)
SCM
get_internal_run_time ()
{
#if __M2_PLANET__
return MAKE_NUMBER (0);
#else
struct timespec ts;
clock_gettime (CLOCK_PROCESS_CPUTIME_ID, &ts);
long time = seconds_and_nanoseconds_to_long (ts.tv_sec - g_start_time.tv_sec,
ts.tv_nsec - g_start_time.tv_nsec);
return MAKE_NUMBER (time);
#endif
}
SCM
getcwd_ () ///((name . "getcwd"))
getcwd_ () /*:((name . "getcwd")) */
{
char buf[PATH_MAX];
char *buf = __getcwd_buf;
return MAKE_STRING0 (getcwd (buf, PATH_MAX));
}
SCM
dup_ (SCM port) ///((name . "dup"))
dup_ (SCM port) /*:((name . "dup")) */
{
return MAKE_NUMBER (dup (VALUE (port)));
}
SCM
dup2_ (SCM old, SCM new) ///((name . "dup2"))
dup2_ (SCM old, SCM new) /*:((name . "dup2")) */
{
dup2 (VALUE (old), VALUE (new));
return cell_unspecified;