andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

* src/lib.c: Rewrite C constructs not supported by M2-Planet.
This commit is contained in:
Jan Nieuwenhuizen 2019-10-20 13:25:32 +02:00
parent eccf7ab6d4
commit 4cdd2eb059
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
1 changed files with 35 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
src/lib.c
View File

@ -37,7 +37,7 @@ display_helper (SCM x, int cont, char *sep, int fd, int write_p)
int t = TYPE (x);
if (t == TCHAR)
{
if (!write_p)
if (write_p == 0)
fdputc (VALUE (x), fd);
else
{
@ -100,15 +100,16 @@ display_helper (SCM x, int cont, char *sep, int fd, int write_p)
}
else if (t == TPAIR)
{
if (!cont)
if (cont == 0)
fdputs ("(", fd);
if (CAR (x) == cell_circular && CADR (x) != cell_closure)
{
fdputs ("(*circ* . ", fd);
int i = 0;
x = CDR (x);
while (x != cell_nil && i++ < 10)
while (x != cell_nil && i < 10)
{
i = i + 1;
fdisplay_ (CAAR (x), fd, write_p);
fdputs (" ", fd);
x = CDR (x);
@ -128,7 +129,7 @@ display_helper (SCM x, int cont, char *sep, int fd, int write_p)
fdisplay_ (CDR (x), fd, write_p);
}
}
if (!cont)
if (cont == 0)
fdputs (")", fd);
}
else if (t == TKEYWORD || t == TPORT || t == TSPECIAL || t == TSTRING || t == TSYMBOL)
@ -145,15 +146,13 @@ display_helper (SCM x, int cont, char *sep, int fd, int write_p)
if ((write_p && t == TSTRING) || t == TPORT)
fdputc ('"', fd);
char const *s = CSTRING (x);
#if 0
s += START (x);
size_t length = LEN (x);
#else
size_t length = LENGTH (x);
#endif
for (size_t i = 0; i < length; i++)
size_t i;
for (i = 0; i < length; i = i + 1)
{
long v = write_p ? s[i] : -1;
long v = -1;
if (write_p != 0)
v = s[i];
if (v == '\0')
fdputs ("\\0", fd);
else if (v == '\a')
@ -207,7 +206,8 @@ display_helper (SCM x, int cont, char *sep, int fd, int write_p)
fdisplay_ (STRUCT (x), fd, write_p);
SCM t = CAR (x);
long size = LENGTH (x);
for (long i = 2; i < size; i++)
long i;
for (i = 2; i < size; i = i + 1)
{
fdputc (' ', fd);
fdisplay_ (STRUCT (x) + i, fd, write_p);
@ -219,9 +219,10 @@ display_helper (SCM x, int cont, char *sep, int fd, int write_p)
{
fdputs ("#(", fd);
SCM t = CAR (x);
for (long i = 0; i < LENGTH (x); i++)
long i;
for (i = 0; i < LENGTH (x); i = i + 1)
{
if (i)
if (i != 0)
fdputc (' ', fd);
fdisplay_ (VECTOR (x) + i, fd, write_p);
}
@ -281,14 +282,14 @@ write_port_ (SCM x, SCM p)
}
SCM
fdisplay_ (SCM x, int fd, int write_p) /**((internal))*/
fdisplay_ (SCM x, int fd, int write_p) /*:((internal)) */
{
g_depth = 5;
return display_helper (x, 0, "", fd, write_p);
}
SCM
exit_ (SCM x) /**((name . "exit"))*/
exit_ (SCM x) /*:((name . "exit")) */
{
assert (TYPE (x) == TNUMBER);
exit (VALUE (x));
@ -306,7 +307,7 @@ frame_printer (SCM frame)
}
SCM
make_frame_type () /**((internal))*/
make_frame_type () /*:((internal)) */
{
SCM record_type = cell_symbol_record_type; // FIXME
SCM fields = cell_nil;
@ -322,7 +323,7 @@ make_frame (SCM stack, long index)
SCM frame_type = make_frame_type ();
long array_index = (STACK_SIZE - (index * FRAME_SIZE));
SCM procedure = g_stack_array[array_index + FRAME_PROCEDURE];
if (!procedure)
if (procedure == 0)
procedure = cell_f;
SCM values = cell_nil;
values = cons (procedure, values);
@ -331,7 +332,7 @@ make_frame (SCM stack, long index)
}
SCM
make_stack_type () /**((internal))*/
make_stack_type () /*:((internal)) */
{
SCM record_type = cell_symbol_record_type; // FIXME
SCM fields = cell_nil;
@ -342,12 +343,13 @@ make_stack_type () /**((internal))*/
}
SCM
make_stack (SCM stack) /**((arity . n))*/
make_stack (SCM stack) /*:((arity . n)) */
{
SCM stack_type = make_stack_type ();
long size = (STACK_SIZE - g_stack) / FRAME_SIZE;
SCM frames = make_vector__ (size);
for (long i = 0; i < size; i++)
long i;
for (i = 0; i < size; i = i + 1)
{
SCM frame = make_frame (stack, i);
vector_set_x_ (frames, i, frame);
@ -373,11 +375,13 @@ stack_ref (SCM stack, SCM index)
}
SCM
xassq (SCM x, SCM a) ///for speed in core only
xassq (SCM x, SCM a) /* For speed in core. */
{
while (a != cell_nil && x != CDAR (a))
a = CDR (a);
return a != cell_nil ? CAR (a) : cell_f;
if (a != cell_nil)
return CAR (a);
return cell_f;
}
SCM
@ -398,7 +402,9 @@ memq (SCM x, SCM a)
else
while (a != cell_nil && x != CAR (a))
a = CDR (a);
return a != cell_nil ? a : cell_f;
if (a != cell_nil)
return a;
return cell_f;
}
SCM
@ -423,7 +429,8 @@ equal2:
{
if (LENGTH (a) != LENGTH (b))
return cell_f;
for (long i = 0; i < LENGTH (a); i++)
long i;
for (i = 0; i < LENGTH (a); i = i + 1)
{
SCM ai = VECTOR (a) + i;
SCM bi = VECTOR (b) + i;
@ -450,5 +457,7 @@ last_pair (SCM x)
SCM
pair_p (SCM x)
{
return TYPE (x) == TPAIR ? cell_t : cell_f;
if (TYPE (x) == TPAIR)
return cell_t;
return cell_f;
}