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

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

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

41
src/string.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*- /* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software * 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. * This file is part of GNU Mes.
* *
@ -50,11 +50,13 @@ list_to_cstring (SCM list, size_t *size)
{ {
if (i > MAX_STRING) if (i > MAX_STRING)
assert_max_string (i, "list_to_string", g_buf); assert_max_string (i, "list_to_string", g_buf);
g_buf[i++] = VALUE (car (list)); g_buf[i] = VALUE (car (list));
i = i + 1;
list = cdr (list); list = cdr (list);
} }
g_buf[i] = 0; g_buf[i] = 0;
*size = i; size[0] = i;
return g_buf; return g_buf;
} }
@ -71,11 +73,17 @@ make_bytes (char const *s, size_t length)
SCM x = alloc (size); SCM x = alloc (size);
TYPE (x) = TBYTES; TYPE (x) = TBYTES;
LENGTH (x) = length; LENGTH (x) = length;
char *p = (char *) &g_cells[x].cdr; #if __M2_PLANET__
if (!length) char *p = &g_cells[x];
*(char *) p = 0; p = p + 2 * sizeof (SCM);
#else
char *p = &CDR (x);
#endif
if (length == 0)
p[0] = 0;
else else
memcpy (p, s, length + 1); memcpy (p, s, length + 1);
return x; return x;
} }
@ -83,7 +91,7 @@ SCM
make_string (char const *s, size_t length) make_string (char const *s, size_t length)
{ {
if (length > MAX_STRING) if (length > MAX_STRING)
assert_max_string (length, "make_string", (char *) s); assert_max_string (length, "make_string", s);
SCM x = make_cell__ (TSTRING, length, 0); SCM x = make_cell__ (TSTRING, length, 0);
SCM v = make_bytes (s, length); SCM v = make_bytes (s, length);
CDR (x) = v; CDR (x) = v;
@ -91,7 +99,7 @@ make_string (char const *s, size_t length)
} }
SCM SCM
string_equal_p (SCM a, SCM b) ///((name . "string=?")) string_equal_p (SCM a, SCM b) /*:((name . "string=?")) */
{ {
if (!((TYPE (a) == TSTRING && TYPE (b) == TSTRING) || (TYPE (a) == TKEYWORD || TYPE (b) == TKEYWORD))) if (!((TYPE (a) == TSTRING && TYPE (b) == TSTRING) || (TYPE (a) == TKEYWORD || TYPE (b) == TKEYWORD)))
{ {
@ -111,9 +119,10 @@ string_equal_p (SCM a, SCM b) ///((name . "string=?"))
} }
if (a == b if (a == b
|| STRING (a) == STRING (b) || STRING (a) == STRING (b)
|| (!LENGTH (a) && !LENGTH (b)) || (LENGTH (a) == 0 && LENGTH (b) == 0)
|| (LENGTH (a) == LENGTH (b) && !memcmp (CSTRING (a), CSTRING (b), LENGTH (a)))) || (LENGTH (a) == LENGTH (b) && !memcmp (CSTRING (a), CSTRING (b), LENGTH (a))))
return cell_t; return cell_t;
return cell_f; return cell_f;
} }
@ -156,8 +165,9 @@ SCM
bytes_to_list (char const *s, size_t i) bytes_to_list (char const *s, size_t i)
{ {
SCM p = cell_nil; SCM p = cell_nil;
while (i--) while (i != 0)
{ {
i = i - 1;
int c = (0x100 + s[i]) % 0x100; int c = (0x100 + s[i]) % 0x100;
p = cons (MAKE_CHAR (c), p); p = cons (MAKE_CHAR (c), p);
} }
@ -192,7 +202,7 @@ list_to_string (SCM list)
} }
SCM SCM
read_string (SCM port) ///((arity . n)) read_string (SCM port) /*:((arity . n)) */
{ {
int fd = __stdin; int fd = __stdin;
if (TYPE (port) == TPAIR && TYPE (car (port)) == TNUMBER) if (TYPE (port) == TPAIR && TYPE (car (port)) == TNUMBER)
@ -203,7 +213,8 @@ read_string (SCM port) ///((arity . n))
{ {
if (i > MAX_STRING) if (i > MAX_STRING)
assert_max_string (i, "read_string", g_buf); assert_max_string (i, "read_string", g_buf);
g_buf[i++] = c; g_buf[i] = c;
i = i + 1;
c = readchar (); c = readchar ();
} }
g_buf[i] = 0; g_buf[i] = 0;
@ -212,7 +223,7 @@ read_string (SCM port) ///((arity . n))
} }
SCM SCM
string_append (SCM x) ///((arity . n)) string_append (SCM x) /*:((arity . n)) */
{ {
char *p = g_buf; char *p = g_buf;
g_buf[0] = 0; g_buf[0] = 0;
@ -222,8 +233,8 @@ string_append (SCM x) ///((arity . n))
SCM string = CAR (x); SCM string = CAR (x);
assert (TYPE (string) == TSTRING); assert (TYPE (string) == TSTRING);
memcpy (p, CSTRING (string), LENGTH (string) + 1); memcpy (p, CSTRING (string), LENGTH (string) + 1);
p += LENGTH (string); p = p + LENGTH (string);
size += LENGTH (string); size = size + LENGTH (string);
if (size > MAX_STRING) if (size > MAX_STRING)
assert_max_string (size, "string_append", g_buf); assert_max_string (size, "string_append", g_buf);
x = CDR (x); x = CDR (x);