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 ddc495916b
commit a5693d5066
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
1 changed files with 35 additions and 26 deletions

View File

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