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:""-*-
* 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.
*
@ -230,19 +230,22 @@ formal_p (struct scm *x, struct scm *formals) /*:((internal)) */
struct scm *
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)
{
struct scm *a = x->car;
a = x->car;
if (a->type == TPAIR)
{
if (a->car == cell_symbol_lambda)
{
struct scm *f = a->cdr->car;
f = a->cdr->car;
formals = add_formals (formals, f);
}
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);
}
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)
{
struct scm *f = x->cdr->car;
f = x->cdr->car;
formals = add_formals (formals, f);
x = x->cdr;
}
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)
f = f->cdr;
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
&& formal_p (x->car, formals) == 0)
{
struct scm *v = module_variable (R0, a);
v = module_variable (R0, a);
if (v != cell_f)
x->car = make_variable_ (v);
}
@ -293,17 +296,18 @@ struct scm *
apply_builtin (struct scm *fn, struct scm *x) /*:((internal)) */
{
struct scm *a = builtin_arity (fn);
struct scm *d;
int arity = a->value;
if ((arity > 0 || arity == -1) && x != cell_nil)
{
struct scm *a = x->car;
a = x->car;
if (a->type == TVALUES)
x = cons (a->cdr->car, x->cdr);
}
if ((arity > 1 || arity == -1) && x != cell_nil)
{
struct scm *a = x->car;
struct scm *d = x->cdr;
a = x->car;
d = x->cdr;
if (d->type == TPAIR)
if (d->car->type == TVALUES)
x = cons (a, cons (d->car->cdr->car, d));

37
src/gc.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* 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.
*
@ -361,11 +361,16 @@ gc_cellcpy (struct scm *dest, struct scm *src, size_t n)
void *p = src;
void *q = dest;
long dist = p - q;
long t;
long a;
long d;
int i;
int c;
while (n != 0)
{
long t = src->type;
long a = src->car_value;
long d = src->cdr_value;
t = src->type;
a = src->car_value;
d = src->cdr_value;
dest->type = t;
if (t == TBROKEN_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 ("\n");
}
int i = bytes_cells (a);
i = bytes_cells (a);
n = n - i;
int c = i * M2_CELL_SIZE;
c = i * M2_CELL_SIZE;
dest = dest + c;
src = src + c;
}
@ -519,9 +524,10 @@ gc_loop (struct scm *scan)
{
struct scm *car;
struct scm *cdr;
long t;
while (scan < g_free)
{
long t = scan->type;
t = scan->type;
if (t == TBROKEN_HEART)
assert_msg (0, "gc_loop: broken heart");
/* *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 *dist = cells;
int i;
long t;
long a;
long d;
int c;
char* p;
if (g_dump_filedes == 0)
g_dump_filedes = mes_open ("dump.mo", O_CREAT|O_WRONLY, 0644);
dumps ("stack="); dumps (ltoa (g_stack)); dumpc ('\n');
@ -752,12 +764,11 @@ gc_dump_arena (struct scm *cells, long size)
}
while (size > 0)
{
int i;
for (i=0; i < 16; i = i + 1)
{
long t = cells->type;
long a = cells->car_value;
long d = cells->cdr_value;
t = cells->type;
a = cells->car_value;
d = cells->cdr_value;
if (size == 0)
dumps ("0 0 0");
else
@ -800,8 +811,8 @@ gc_dump_arena (struct scm *cells, long size)
}
if (t == TBYTES)
{
int c = bytes_cells (a);
char *p = cell_bytes (cells);
c = bytes_cells (a);
p = cell_bytes (cells);
size = size - c;
dumpc ('"');
while (a > 0)

5
src/hash.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* 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.
*
@ -156,9 +156,10 @@ hash_table_printer (struct scm *table)
struct scm *buckets = struct_ref_ (table, 4);
fdputs ("buckets: ", __stdout);
int i;
struct scm *e;
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)
{
fdputc ('[', __stdout);

11
src/lib.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* 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.
*
@ -103,6 +103,10 @@ memq (struct scm *x, struct scm *a)
struct scm *
equal2_p (struct scm *a, struct scm *b)
{
long i;
struct scm *ai;
struct scm *bi;
equal2:
if (a == b)
return cell_t;
@ -122,11 +126,10 @@ equal2:
{
if (a->length != b->length)
return cell_f;
long i;
for (i = 0; i < a->length; i = i + 1)
{
struct scm *ai = cell_ref (a->vector, i);
struct scm *bi = cell_ref (b->vector, i);
ai = cell_ref (a->vector, i);
bi = cell_ref (b->vector, i);
if (ai->type == TREF)
ai = ai->ref;
if (bi->type == TREF)

66
src/math.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* 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>
*
* 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);
long n = x->car->value;
x = x->cdr;
struct scm *i;
long v;
while (x != cell_nil)
{
assert_number ("greater_p", x->car);
struct scm *i = car (x);
long v = i->value;
i = car (x);
v = i->value;
if (v >= n)
return cell_f;
n = v;
@ -66,11 +68,13 @@ less_p (struct scm *x) /*:((name . "<") (arity . n)) */
assert_number ("less_p", x->car);
long n = x->car->value;
x = x->cdr;
struct scm *i;
long v;
while (x != cell_nil)
{
assert_number ("less_p", x->car);
struct scm *i = car (x);
long v = i->value;
i = car (x);
v = i->value;
if (v <= n)
return cell_f;
n = v;
@ -87,10 +91,12 @@ is_p (struct scm *x) /*:((name . "=") (arity . n)) */
assert_number ("is_p", x->car);
long n = x->car->value;
x = cdr (x);
struct scm *i;
long v;
while (x != cell_nil)
{
struct scm *i = car (x);
long v = i->value;
i = car (x);
v = i->value;
if (v != n)
return cell_f;
x = cdr (x);
@ -106,11 +112,13 @@ minus (struct scm *x) /*:((name . "-") (arity . n)) */
x = cdr (x);
if (x == cell_nil)
n = -n;
struct scm *i;
long v;
while (x != cell_nil)
{
struct scm *i = car (x);
i = car (x);
assert_number ("minus", i);
long v = i->value;
v = i->value;
n = n - v;
x = cdr (x);
}
@ -121,11 +129,13 @@ struct scm *
plus (struct scm *x) /*:((name . "+") (arity . n)) */
{
long n = 0;
struct scm *i;
long v;
while (x != cell_nil)
{
struct scm *i = car (x);
i = car (x);
assert_number ("plus", i);
long v = i->value;
v = i->value;
n = n + v;
x = cdr (x);
}
@ -136,19 +146,21 @@ struct scm *
divide (struct scm *x) /*:((name . "/") (arity . n)) */
{
long n = 1;
struct scm *i;
long v;
if (x != cell_nil)
{
struct scm *i = car (x);
i = car (x);
assert_number ("divide", i);
long v = i->value;
v = i->value;
n = v;
x = cdr (x);
}
while (x != cell_nil)
{
struct scm *i = car (x);
i = car (x);
assert_number ("divide", i);
long v = i->value;
v = i->value;
if (v == 0)
error (cstring_to_symbol ("divide-by-zero"), x);
if (n == 0)
@ -180,11 +192,13 @@ struct scm *
multiply (struct scm *x) /*:((name . "*") (arity . n)) */
{
long n = 1;
struct scm *i;
long v;
while (x != cell_nil)
{
struct scm *i = car (x);
i = car (x);
assert_number ("multiply", i);
long v = i->value;
v = i->value;
n = n * v;
x = cdr (x);
}
@ -195,11 +209,13 @@ struct scm *
logand (struct scm *x) /*:((arity . n)) */
{
long n = -1;
struct scm *i;
long v;
while (x != cell_nil)
{
struct scm *i = car (x);
i = car (x);
assert_number ("multiply", i);
long v = i->value;
v = i->value;
n = n & v;
x = cdr (x);
}
@ -210,11 +226,13 @@ struct scm *
logior (struct scm *x) /*:((arity . n)) */
{
long n = 0;
struct scm *i;
long v;
while (x != cell_nil)
{
struct scm *i = car (x);
i = car (x);
assert_number ("logior", i);
long v = i->value;
v = i->value;
n = n | v;
x = cdr (x);
}
@ -233,11 +251,13 @@ struct scm *
logxor (struct scm *x) /*:((arity . n)) */
{
long n = 0;
struct scm *i;
long v;
while (x != cell_nil)
{
struct scm *i = car (x);
i = car (x);
assert_number ("logxor", i);
long v = i->value;
v = i->value;
n = n ^ v;
x = cdr (x);
}

8
src/posix.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* 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.
*
@ -205,9 +205,10 @@ current_input_port ()
if (__stdin >= 0)
return make_number (__stdin);
struct scm *x = g_ports;
struct scm *a;
while (x != 0)
{
struct scm *a = x->car;
a = x->car;
if (a->port == __stdin)
return a;
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))));
c_argv[i] = cell_bytes (file_name->string);
i = i + 1;
struct scm *arg;
while (args != cell_nil)
{
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);
i = i + 1;
args = args->cdr;

5
src/reader.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* 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>
*
* This file is part of GNU Mes.
@ -439,6 +439,7 @@ reader_read_string ()
{
size_t i = 0;
int c;
struct scm *n;
do
{
if (i > MAX_STRING)
@ -475,7 +476,7 @@ reader_read_string ()
c = 27;
else if (c == 'x')
{
struct scm *n = reader_read_hex ();
n = reader_read_hex ();
c = n->value;
}
}

5
src/stack.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* 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>
*
* 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;
struct scm *frames = make_vector_ (size, cell_unspecified);
long i;
struct scm* frame;
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);
}
struct scm *values = cell_nil;

11
src/string.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* 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.
*
@ -45,11 +45,12 @@ list_to_cstring (struct scm *list, size_t *size)
{
size_t i = 0;
char *p = g_buf;
struct scm *x;
while (list != cell_nil)
{
if (i > MAX_STRING)
assert_max_string (i, "list_to_string", g_buf);
struct scm *x = car (list);
x = car (list);
g_buf[i] = x->value;
i = i + 1;
list = cdr (list);
@ -131,10 +132,11 @@ struct scm *
bytes_to_list (char const *s, size_t i)
{
struct scm *p = cell_nil;
int c;
while (i != 0)
{
i = i - 1;
int c = (0x100 + s[i]) % 0x100;
c = (0x100 + s[i]) % 0x100;
p = cons (make_char (c), p);
}
return p;
@ -198,9 +200,10 @@ string_append (struct scm *x) /*:((arity . n)) */
char *p = g_buf;
g_buf[0] = 0;
size_t size = 0;
struct scm *string;
while (x != cell_nil)
{
struct scm *string = x->car;
string = x->car;
assert_msg (string->type == TSTRING, "string->type == TSTRING");
memcpy (p, cell_bytes (string->string), string->length + 1);
p = p + string->length;

5
src/struct.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* 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.
*
@ -33,9 +33,10 @@ make_struct (struct scm *type, struct scm *fields, struct scm *printer)
copy_cell (v, vector_entry (type));
copy_cell (cell_ref (v, 1), vector_entry (printer));
long i;
struct scm *e;
for (i = 2; i < size; i = i + 1)
{
struct scm *e = cell_unspecified;
e = cell_unspecified;
if (fields != cell_nil)
{
e = fields->car;

2
src/symbol.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* 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.
*

5
src/vector.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* 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.
*
@ -127,9 +127,10 @@ vector_to_list (struct scm *v)
{
struct scm *x = cell_nil;
long i;
struct scm *e;
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)
e = e->ref;
x = cons (e, x);