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

core: Prepare for M2-Planet 1.7.0.

Browse source 
* src/eval-apply.c (expand_variable_, apply_builtin): Declare variables
at toplevel.
* src/gc.c (gc_cellcpy, gc_loop, gc_dump_arena): Likewise.
* src/hash.c (hash_table_printer): Likewise.
* src/lib.c (equal2_p): Likewise.
* src/math.c (greater_p, less_p, is_p, minus, plus, divide, multiply,
logand, logior, logxor): Likewise.
* src/posix.c (current_input_port, execl_): Likewise.
* src/reader.c (reader_read_string): Likewise.
* src/stack.c (make_stack): Likewise.
* src/string.c (list_to_cstring, bytes_to_list, string_append):
Likewise.
* src/struct.c (make_struct): Likewise.
* src/vector.c (vector_to_list): Likewise.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-12-29 13:38:38 +01:00
parent 41c126759e
commit 795225ec29
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
12 changed files with 116 additions and 68 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
src/eval-apply.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,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
* *
@ -230,19 +230,22 @@ formal_p (struct scm *x, struct scm *formals) /*:((internal)) */
struct scm * struct scm *
expand_variable_ (struct scm *x, struct scm *formals, int top_p) /*:((internal)) */ expand_variable_ (struct scm *x, struct scm *formals, int top_p) /*:((internal)) */
{ {
struct scm *a;
struct scm *f;
struct scm *v;
while (x->type == TPAIR) while (x->type == TPAIR)
{ {
struct scm *a = x->car; a = x->car;
if (a->type == TPAIR) if (a->type == TPAIR)
{ {
if (a->car == cell_symbol_lambda) if (a->car == cell_symbol_lambda)
{ {
struct scm *f = a->cdr->car; f = a->cdr->car;
formals = add_formals (formals, f); formals = add_formals (formals, f);
} }
else if (a->car == cell_symbol_define || a->car == cell_symbol_define_macro) else if (a->car == cell_symbol_define || a->car == cell_symbol_define_macro)
{ {
struct scm *f = a->cdr->car; f = a->cdr->car;
formals = add_formals (formals, f); formals = add_formals (formals, f);
} }
if (a->car != cell_symbol_quote) if (a->car != cell_symbol_quote)
@ -252,13 +255,13 @@ expand_variable_ (struct scm *x, struct scm *formals, int top_p) /*:((int
{ {
if (a == cell_symbol_lambda) if (a == cell_symbol_lambda)
{ {
struct scm *f = x->cdr->car; f = x->cdr->car;
formals = add_formals (formals, f); formals = add_formals (formals, f);
x = x->cdr; x = x->cdr;
} }
else if (a == cell_symbol_define || a == cell_symbol_define_macro) else if (a == cell_symbol_define || a == cell_symbol_define_macro)
{ {
struct scm *f = x->cdr->car; f = x->cdr->car;
if (top_p != 0 && f->type == TPAIR) if (top_p != 0 && f->type == TPAIR)
f = f->cdr; f = f->cdr;
formals = add_formals (formals, f); formals = add_formals (formals, f);
@ -272,7 +275,7 @@ expand_variable_ (struct scm *x, struct scm *formals, int top_p) /*:((int
&& a != cell_symbol_primitive_load && a != cell_symbol_primitive_load
&& formal_p (x->car, formals) == 0) && formal_p (x->car, formals) == 0)
{ {
struct scm *v = module_variable (R0, a); v = module_variable (R0, a);
if (v != cell_f) if (v != cell_f)
x->car = make_variable_ (v); x->car = make_variable_ (v);
} }
@ -293,17 +296,18 @@ struct scm *
apply_builtin (struct scm *fn, struct scm *x) /*:((internal)) */ apply_builtin (struct scm *fn, struct scm *x) /*:((internal)) */
{ {
struct scm *a = builtin_arity (fn); struct scm *a = builtin_arity (fn);
struct scm *d;
int arity = a->value; int arity = a->value;
if ((arity > 0 || arity == -1) && x != cell_nil) if ((arity > 0 || arity == -1) && x != cell_nil)
{ {
struct scm *a = x->car; a = x->car;
if (a->type == TVALUES) if (a->type == TVALUES)
x = cons (a->cdr->car, x->cdr); x = cons (a->cdr->car, x->cdr);
} }
if ((arity > 1 || arity == -1) && x != cell_nil) if ((arity > 1 || arity == -1) && x != cell_nil)
{ {
struct scm *a = x->car; a = x->car;
struct scm *d = x->cdr; d = x->cdr;
if (d->type == TPAIR) if (d->type == TPAIR)
if (d->car->type == TVALUES) if (d->car->type == TVALUES)
x = cons (a, cons (d->car->cdr->car, d)); x = cons (a, cons (d->car->cdr->car, d));

37
src/gc.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,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
* *
@ -361,11 +361,16 @@ gc_cellcpy (struct scm *dest, struct scm *src, size_t n)
void *p = src; void *p = src;
void *q = dest; void *q = dest;
long dist = p - q; long dist = p - q;
long t;
long a;
long d;
int i;
int c;
while (n != 0) while (n != 0)
{ {
long t = src->type; t = src->type;
long a = src->car_value; a = src->car_value;
long d = src->cdr_value; d = src->cdr_value;
dest->type = t; dest->type = t;
if (t == TBROKEN_HEART) if (t == TBROKEN_HEART)
assert_msg (0, "gc_cellcpy: broken heart"); assert_msg (0, "gc_cellcpy: broken heart");
@ -412,9 +417,9 @@ gc_cellcpy (struct scm *dest, struct scm *src, size_t n)
eputs (cell_bytes (dest)); eputs (cell_bytes (dest));
eputs ("\n"); eputs ("\n");
} }
int i = bytes_cells (a); i = bytes_cells (a);
n = n - i; n = n - i;
int c = i * M2_CELL_SIZE; c = i * M2_CELL_SIZE;
dest = dest + c; dest = dest + c;
src = src + c; src = src + c;
} }
@ -519,9 +524,10 @@ gc_loop (struct scm *scan)
{ {
struct scm *car; struct scm *car;
struct scm *cdr; struct scm *cdr;
long t;
while (scan < g_free) while (scan < g_free)
{ {
long t = scan->type; t = scan->type;
if (t == TBROKEN_HEART) if (t == TBROKEN_HEART)
assert_msg (0, "gc_loop: broken heart"); assert_msg (0, "gc_loop: broken heart");
/* *INDENT-OFF* */ /* *INDENT-OFF* */
@ -739,6 +745,12 @@ gc_dump_arena (struct scm *cells, long size)
{ {
struct scm *end = g_cells + (size * M2_CELL_SIZE); struct scm *end = g_cells + (size * M2_CELL_SIZE);
struct scm *dist = cells; struct scm *dist = cells;
int i;
long t;
long a;
long d;
int c;
char* p;
if (g_dump_filedes == 0) if (g_dump_filedes == 0)
g_dump_filedes = mes_open ("dump.mo", O_CREAT|O_WRONLY, 0644); g_dump_filedes = mes_open ("dump.mo", O_CREAT|O_WRONLY, 0644);
dumps ("stack="); dumps (ltoa (g_stack)); dumpc ('\n'); dumps ("stack="); dumps (ltoa (g_stack)); dumpc ('\n');
@ -752,12 +764,11 @@ gc_dump_arena (struct scm *cells, long size)
} }
while (size > 0) while (size > 0)
{ {
int i;
for (i=0; i < 16; i = i + 1) for (i=0; i < 16; i = i + 1)
{ {
long t = cells->type; t = cells->type;
long a = cells->car_value; a = cells->car_value;
long d = cells->cdr_value; d = cells->cdr_value;
if (size == 0) if (size == 0)
dumps ("0 0 0"); dumps ("0 0 0");
else else
@ -800,8 +811,8 @@ gc_dump_arena (struct scm *cells, long size)
} }
if (t == TBYTES) if (t == TBYTES)
{ {
int c = bytes_cells (a); c = bytes_cells (a);
char *p = cell_bytes (cells); p = cell_bytes (cells);
size = size - c; size = size - c;
dumpc ('"'); dumpc ('"');
while (a > 0) while (a > 0)

5
src/hash.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 © 2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
* *
@ -156,9 +156,10 @@ hash_table_printer (struct scm *table)
struct scm *buckets = struct_ref_ (table, 4); struct scm *buckets = struct_ref_ (table, 4);
fdputs ("buckets: ", __stdout); fdputs ("buckets: ", __stdout);
int i; int i;
struct scm *e;
for (i = 0; i < buckets->length; i = i + 1) for (i = 0; i < buckets->length; i = i + 1)
{ {
struct scm *e = vector_ref_ (buckets, i); e = vector_ref_ (buckets, i);
if (e != cell_unspecified) if (e != cell_unspecified)
{ {
fdputc ('[', __stdout); fdputc ('[', __stdout);

11
src/lib.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,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
* *
@ -103,6 +103,10 @@ memq (struct scm *x, struct scm *a)
struct scm * struct scm *
equal2_p (struct scm *a, struct scm *b) equal2_p (struct scm *a, struct scm *b)
{ {
long i;
struct scm *ai;
struct scm *bi;
equal2: equal2:
if (a == b) if (a == b)
return cell_t; return cell_t;
@ -122,11 +126,10 @@ equal2:
{ {
if (a->length != b->length) if (a->length != b->length)
return cell_f; return cell_f;
long i;
for (i = 0; i < a->length; i = i + 1) for (i = 0; i < a->length; i = i + 1)
{ {
struct scm *ai = cell_ref (a->vector, i); ai = cell_ref (a->vector, i);
struct scm *bi = cell_ref (b->vector, i); bi = cell_ref (b->vector, i);
if (ai->type == TREF) if (ai->type == TREF)
ai = ai->ref; ai = ai->ref;
if (bi->type == TREF) if (bi->type == TREF)

66
src/math.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,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* Copyright © 2021 W. J. van der Laan <laanwj@protonmail.com> * Copyright © 2021 W. J. van der Laan <laanwj@protonmail.com>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
@ -45,11 +45,13 @@ greater_p (struct scm *x) /*:((name . ">") (arity . n)) */
assert_number ("greater_p", x->car); assert_number ("greater_p", x->car);
long n = x->car->value; long n = x->car->value;
x = x->cdr; x = x->cdr;
struct scm *i;
long v;
while (x != cell_nil) while (x != cell_nil)
{ {
assert_number ("greater_p", x->car); assert_number ("greater_p", x->car);
struct scm *i = car (x); i = car (x);
long v = i->value; v = i->value;
if (v >= n) if (v >= n)
return cell_f; return cell_f;
n = v; n = v;
@ -66,11 +68,13 @@ less_p (struct scm *x) /*:((name . "<") (arity . n)) */
assert_number ("less_p", x->car); assert_number ("less_p", x->car);
long n = x->car->value; long n = x->car->value;
x = x->cdr; x = x->cdr;
struct scm *i;
long v;
while (x != cell_nil) while (x != cell_nil)
{ {
assert_number ("less_p", x->car); assert_number ("less_p", x->car);
struct scm *i = car (x); i = car (x);
long v = i->value; v = i->value;
if (v <= n) if (v <= n)
return cell_f; return cell_f;
n = v; n = v;
@ -87,10 +91,12 @@ is_p (struct scm *x) /*:((name . "=") (arity . n)) */
assert_number ("is_p", x->car); assert_number ("is_p", x->car);
long n = x->car->value; long n = x->car->value;
x = cdr (x); x = cdr (x);
struct scm *i;
long v;
while (x != cell_nil) while (x != cell_nil)
{ {
struct scm *i = car (x); i = car (x);
long v = i->value; v = i->value;
if (v != n) if (v != n)
return cell_f; return cell_f;
x = cdr (x); x = cdr (x);
@ -106,11 +112,13 @@ minus (struct scm *x) /*:((name . "-") (arity . n)) */
x = cdr (x); x = cdr (x);
if (x == cell_nil) if (x == cell_nil)
n = -n; n = -n;
struct scm *i;
long v;
while (x != cell_nil) while (x != cell_nil)
{ {
struct scm *i = car (x); i = car (x);
assert_number ("minus", i); assert_number ("minus", i);
long v = i->value; v = i->value;
n = n - v; n = n - v;
x = cdr (x); x = cdr (x);
} }
@ -121,11 +129,13 @@ struct scm *
plus (struct scm *x) /*:((name . "+") (arity . n)) */ plus (struct scm *x) /*:((name . "+") (arity . n)) */
{ {
long n = 0; long n = 0;
struct scm *i;
long v;
while (x != cell_nil) while (x != cell_nil)
{ {
struct scm *i = car (x); i = car (x);
assert_number ("plus", i); assert_number ("plus", i);
long v = i->value; v = i->value;
n = n + v; n = n + v;
x = cdr (x); x = cdr (x);
} }
@ -136,19 +146,21 @@ struct scm *
divide (struct scm *x) /*:((name . "/") (arity . n)) */ divide (struct scm *x) /*:((name . "/") (arity . n)) */
{ {
long n = 1; long n = 1;
struct scm *i;
long v;
if (x != cell_nil) if (x != cell_nil)
{ {
struct scm *i = car (x); i = car (x);
assert_number ("divide", i); assert_number ("divide", i);
long v = i->value; v = i->value;
n = v; n = v;
x = cdr (x); x = cdr (x);
} }
while (x != cell_nil) while (x != cell_nil)
{ {
struct scm *i = car (x); i = car (x);
assert_number ("divide", i); assert_number ("divide", i);
long v = i->value; v = i->value;
if (v == 0) if (v == 0)
error (cstring_to_symbol ("divide-by-zero"), x); error (cstring_to_symbol ("divide-by-zero"), x);
if (n == 0) if (n == 0)
@ -180,11 +192,13 @@ struct scm *
multiply (struct scm *x) /*:((name . "*") (arity . n)) */ multiply (struct scm *x) /*:((name . "*") (arity . n)) */
{ {
long n = 1; long n = 1;
struct scm *i;
long v;
while (x != cell_nil) while (x != cell_nil)
{ {
struct scm *i = car (x); i = car (x);
assert_number ("multiply", i); assert_number ("multiply", i);
long v = i->value; v = i->value;
n = n * v; n = n * v;
x = cdr (x); x = cdr (x);
} }
@ -195,11 +209,13 @@ struct scm *
logand (struct scm *x) /*:((arity . n)) */ logand (struct scm *x) /*:((arity . n)) */
{ {
long n = -1; long n = -1;
struct scm *i;
long v;
while (x != cell_nil) while (x != cell_nil)
{ {
struct scm *i = car (x); i = car (x);
assert_number ("multiply", i); assert_number ("multiply", i);
long v = i->value; v = i->value;
n = n & v; n = n & v;
x = cdr (x); x = cdr (x);
} }
@ -210,11 +226,13 @@ struct scm *
logior (struct scm *x) /*:((arity . n)) */ logior (struct scm *x) /*:((arity . n)) */
{ {
long n = 0; long n = 0;
struct scm *i;
long v;
while (x != cell_nil) while (x != cell_nil)
{ {
struct scm *i = car (x); i = car (x);
assert_number ("logior", i); assert_number ("logior", i);
long v = i->value; v = i->value;
n = n | v; n = n | v;
x = cdr (x); x = cdr (x);
} }
@ -233,11 +251,13 @@ struct scm *
logxor (struct scm *x) /*:((arity . n)) */ logxor (struct scm *x) /*:((arity . n)) */
{ {
long n = 0; long n = 0;
struct scm *i;
long v;
while (x != cell_nil) while (x != cell_nil)
{ {
struct scm *i = car (x); i = car (x);
assert_number ("logxor", i); assert_number ("logxor", i);
long v = i->value; v = i->value;
n = n ^ v; n = n ^ v;
x = cdr (x); x = cdr (x);
} }

8
src/posix.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,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
* *
@ -205,9 +205,10 @@ current_input_port ()
if (__stdin >= 0) if (__stdin >= 0)
return make_number (__stdin); return make_number (__stdin);
struct scm *x = g_ports; struct scm *x = g_ports;
struct scm *a;
while (x != 0) while (x != 0)
{ {
struct scm *a = x->car; a = x->car;
if (a->port == __stdin) if (a->port == __stdin)
return a; return a;
x = x->cdr; x = x->cdr;
@ -328,10 +329,11 @@ execl_ (struct scm *file_name, struct scm *args) /*:((name . "execl")) */
cons (file_name, cons (make_string0 ("too many arguments"), cons (file_name, args)))); cons (file_name, cons (make_string0 ("too many arguments"), cons (file_name, args))));
c_argv[i] = cell_bytes (file_name->string); c_argv[i] = cell_bytes (file_name->string);
i = i + 1; i = i + 1;
struct scm *arg;
while (args != cell_nil) while (args != cell_nil)
{ {
assert_msg (args->car->type == TSTRING, "args->car->type == TSTRING"); assert_msg (args->car->type == TSTRING, "args->car->type == TSTRING");
struct scm *arg = args->car; arg = args->car;
c_argv[i] = cell_bytes (arg->string); c_argv[i] = cell_bytes (arg->string);
i = i + 1; i = i + 1;
args = args->cdr; args = args->cdr;

5
src/reader.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,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* Copyright © 2018 Jeremiah Orians <jeremiah@pdp10.guru> * Copyright © 2018 Jeremiah Orians <jeremiah@pdp10.guru>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
@ -439,6 +439,7 @@ reader_read_string ()
{ {
size_t i = 0; size_t i = 0;
int c; int c;
struct scm *n;
do do
{ {
if (i > MAX_STRING) if (i > MAX_STRING)
@ -475,7 +476,7 @@ reader_read_string ()
c = 27; c = 27;
else if (c == 'x') else if (c == 'x')
{ {
struct scm *n = reader_read_hex (); n = reader_read_hex ();
c = n->value; c = n->value;
} }
} }

5
src/stack.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,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* Copyright © 2021 W. J. van der Laan <laanwj@protonmail.com> * Copyright © 2021 W. J. van der Laan <laanwj@protonmail.com>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
@ -81,9 +81,10 @@ make_stack (struct scm *stack) /*:((arity . n)) */
long size = (STACK_SIZE - g_stack) / FRAME_SIZE; long size = (STACK_SIZE - g_stack) / FRAME_SIZE;
struct scm *frames = make_vector_ (size, cell_unspecified); struct scm *frames = make_vector_ (size, cell_unspecified);
long i; long i;
struct scm* frame;
for (i = 0; i < size; i = i + 1) for (i = 0; i < size; i = i + 1)
{ {
struct scm *frame = make_frame (stack, i); frame = make_frame (stack, i);
vector_set_x_ (frames, i, frame); vector_set_x_ (frames, i, frame);
} }
struct scm *values = cell_nil; struct scm *values = cell_nil;

11
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,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
* *
@ -45,11 +45,12 @@ list_to_cstring (struct scm *list, size_t *size)
{ {
size_t i = 0; size_t i = 0;
char *p = g_buf; char *p = g_buf;
struct scm *x;
while (list != cell_nil) while (list != cell_nil)
{ {
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);
struct scm *x = car (list); x = car (list);
g_buf[i] = x->value; g_buf[i] = x->value;
i = i + 1; i = i + 1;
list = cdr (list); list = cdr (list);
@ -131,10 +132,11 @@ struct scm *
bytes_to_list (char const *s, size_t i) bytes_to_list (char const *s, size_t i)
{ {
struct scm *p = cell_nil; struct scm *p = cell_nil;
int c;
while (i != 0) while (i != 0)
{ {
i = i - 1; i = i - 1;
int c = (0x100 + s[i]) % 0x100; c = (0x100 + s[i]) % 0x100;
p = cons (make_char (c), p); p = cons (make_char (c), p);
} }
return p; return p;
@ -198,9 +200,10 @@ string_append (struct scm *x) /*:((arity . n)) */
char *p = g_buf; char *p = g_buf;
g_buf[0] = 0; g_buf[0] = 0;
size_t size = 0; size_t size = 0;
struct scm *string;
while (x != cell_nil) while (x != cell_nil)
{ {
struct scm *string = x->car; string = x->car;
assert_msg (string->type == TSTRING, "string->type == TSTRING"); assert_msg (string->type == TSTRING, "string->type == TSTRING");
memcpy (p, cell_bytes (string->string), string->length + 1); memcpy (p, cell_bytes (string->string), string->length + 1);
p = p + string->length; p = p + string->length;

5
src/struct.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 © 2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
* *
@ -33,9 +33,10 @@ make_struct (struct scm *type, struct scm *fields, struct scm *printer)
copy_cell (v, vector_entry (type)); copy_cell (v, vector_entry (type));
copy_cell (cell_ref (v, 1), vector_entry (printer)); copy_cell (cell_ref (v, 1), vector_entry (printer));
long i; long i;
struct scm *e;
for (i = 2; i < size; i = i + 1) for (i = 2; i < size; i = i + 1)
{ {
struct scm *e = cell_unspecified; e = cell_unspecified;
if (fields != cell_nil) if (fields != cell_nil)
{ {
e = fields->car; e = fields->car;

2
src/symbol.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,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
* *

5
src/vector.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,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* *
* This file is part of GNU Mes. * This file is part of GNU Mes.
* *
@ -127,9 +127,10 @@ vector_to_list (struct scm *v)
{ {
struct scm *x = cell_nil; struct scm *x = cell_nil;
long i; long i;
struct scm *e;
for (i = v->length; i; i = i - 1) for (i = v->length; i; i = i - 1)
{ {
struct scm *e = cell_ref (v->vector, i - 1); e = cell_ref (v->vector, i - 1);
if (e->type == TREF) if (e->type == TREF)
e = e->ref; e = e->ref;
x = cons (e, x); x = cons (e, x);