diff --git a/build-aux/configure-lib.sh b/build-aux/configure-lib.sh
index a3a1c02c..3a6a8c82 100644
--- a/build-aux/configure-lib.sh
+++ b/build-aux/configure-lib.sh
@@ -442,6 +442,7 @@ src/mes.c
src/module.c
src/posix.c
src/reader.c
+src/stack.c
src/string.c
src/struct.c
src/symbol.c
diff --git a/build-aux/pointer.sh b/build-aux/pointer.sh
index 9cc6167f..ab7683ce 100755
--- a/build-aux/pointer.sh
+++ b/build-aux/pointer.sh
@@ -58,6 +58,7 @@ sed -ri \
src/module.c \
src/posix.c \
src/reader.c \
+ src/stack.c \
src/string.c \
src/struct.c \
src/symbol.c \
diff --git a/build-aux/snarf.sh b/build-aux/snarf.sh
index cc6aa8d8..782438aa 100755
--- a/build-aux/snarf.sh
+++ b/build-aux/snarf.sh
@@ -36,6 +36,7 @@ trace "SNARF$snarf mes.c" ${srcdest}build-aux/mes-snarf.scm src/mes.c
trace "SNARF$snarf module.c" ${srcdest}build-aux/mes-snarf.scm src/module.c
trace "SNARF$snarf posix.c" ${srcdest}build-aux/mes-snarf.scm src/posix.c
trace "SNARF$snarf reader.c" ${srcdest}build-aux/mes-snarf.scm src/reader.c
+trace "SNARF$snarf stack.c" ${srcdest}build-aux/mes-snarf.scm src/stack.c
trace "SNARF$snarf strings.c" ${srcdest}build-aux/mes-snarf.scm src/string.c
trace "SNARF$snarf struct.c" ${srcdest}build-aux/mes-snarf.scm src/struct.c
trace "SNARF$snarf symbol.c" ${srcdest}build-aux/mes-snarf.scm src/symbol.c
diff --git a/include/mes/builtins.h b/include/mes/builtins.h
index 7cbba7cd..0d3a4539 100644
--- a/include/mes/builtins.h
+++ b/include/mes/builtins.h
@@ -74,11 +74,6 @@ SCM make_hash_table (SCM x);
SCM type_ (SCM x);
SCM car_ (SCM x);
SCM cdr_ (SCM x);
-SCM exit_ (SCM x);
-SCM frame_printer (SCM frame);
-SCM make_stack (SCM stack);
-SCM stack_length (SCM stack);
-SCM stack_ref (SCM stack, SCM index);
SCM xassq (SCM x, SCM a);
SCM memq (SCM x, SCM a);
SCM equal2_p (SCM a, SCM b);
@@ -107,6 +102,7 @@ SCM module_variable (SCM module, SCM name);
SCM module_ref (SCM module, SCM name);
SCM module_define_x (SCM module, SCM name, SCM value);
/* src/posix.c */
+SCM exit_ (SCM x);
SCM peek_byte ();
SCM read_byte ();
SCM unread_byte (SCM i);
@@ -149,6 +145,11 @@ SCM reader_read_binary ();
SCM reader_read_octal ();
SCM reader_read_hex ();
SCM reader_read_string ();
+/* src/stack.c */
+SCM frame_printer (SCM frame);
+SCM make_stack (SCM stack);
+SCM stack_length (SCM stack);
+SCM stack_ref (SCM stack, SCM index);
/* src/string.c */
SCM string_equal_p (SCM a, SCM b);
SCM symbol_to_string (SCM symbol);
diff --git a/simple.make b/simple.make
index 542f7b78..e55aaaf1 100644
--- a/simple.make
+++ b/simple.make
@@ -60,6 +60,7 @@ MES_SOURCES = \
src/posix.c \
src/reader.c \
src/string.c \
+ src/stack.c \
src/struct.c \
src/symbol.c \
src/vector.c
diff --git a/src/builtins.c b/src/builtins.c
index 98afbe3f..64883ab6 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -167,11 +167,6 @@ mes_builtins (SCM a) /*:((internal)) */
a = init_builtin (builtin_type, "core:type", 1, &type_, a);
a = init_builtin (builtin_type, "core:car", 1, &car_, a);
a = init_builtin (builtin_type, "core:cdr", 1, &cdr_, a);
- a = init_builtin (builtin_type, "exit", 1, &exit_, a);
- a = init_builtin (builtin_type, "frame-printer", 1, &frame_printer, a);
- a = init_builtin (builtin_type, "make-stack", -1, &make_stack, a);
- a = init_builtin (builtin_type, "stack-length", 1, &stack_length, a);
- a = init_builtin (builtin_type, "stack-ref", 2, &stack_ref, a);
a = init_builtin (builtin_type, "xassq", 2, &xassq, a);
a = init_builtin (builtin_type, "memq", 2, &memq, a);
a = init_builtin (builtin_type, "equal2?", 2, &equal2_p, a);
@@ -200,6 +195,7 @@ mes_builtins (SCM a) /*:((internal)) */
a = init_builtin (builtin_type, "module-ref", 2, &module_ref, a);
a = init_builtin (builtin_type, "module-define!", 3, &module_define_x, a);
/* src/posix.c */
+ a = init_builtin (builtin_type, "exit", 1, &exit_, a);
a = init_builtin (builtin_type, "peek-byte", 0, &peek_byte, a);
a = init_builtin (builtin_type, "read-byte", 0, &read_byte, a);
a = init_builtin (builtin_type, "unread-byte", 1, &unread_byte, a);
@@ -242,6 +238,11 @@ mes_builtins (SCM a) /*:((internal)) */
a = init_builtin (builtin_type, "reader-read-octal", 0, &reader_read_octal, a);
a = init_builtin (builtin_type, "reader-read-hex", 0, &reader_read_hex, a);
a = init_builtin (builtin_type, "reader-read-string", 0, &reader_read_string, a);
+ /* src/stack.c */
+ a = init_builtin (builtin_type, "frame-printer", 1, &frame_printer, a);
+ a = init_builtin (builtin_type, "make-stack", -1, &make_stack, a);
+ a = init_builtin (builtin_type, "stack-length", 1, &stack_length, a);
+ a = init_builtin (builtin_type, "stack-ref", 2, &stack_ref, a);
/* src/string.c */
a = init_builtin (builtin_type, "string=?", 2, &string_equal_p, a);
a = init_builtin (builtin_type, "symbol->string", 1, &symbol_to_string, a);
diff --git a/src/lib.c b/src/lib.c
index 49145832..6b16cf1f 100644
--- a/src/lib.c
+++ b/src/lib.c
@@ -18,6 +18,12 @@
* along with GNU Mes. If not, see .
*/
+/** Commentary:
+ Scheme library functions not used by the eval/apply core.
+ */
+
+/** Code: */
+
#include "mes/lib.h"
#include "mes/mes.h"
@@ -47,92 +53,6 @@ cdr_ (SCM x)
return make_number (d);
}
-SCM
-exit_ (SCM x) /*:((name . "exit")) */
-{
- assert_msg (TYPE (x) == TNUMBER, "TYPE (x) == TNUMBER");
- exit (VALUE (x));
-}
-
-SCM
-frame_printer (SCM frame)
-{
- fdputs ("#<", __stdout);
- display_ (struct_ref_ (frame, 2));
- fdputc (' ', __stdout);
- fdputs ("procedure: ", __stdout);
- display_ (struct_ref_ (frame, 3));
- fdputc ('>', __stdout);
-}
-
-SCM
-make_frame_type () /*:((internal)) */
-{
- SCM record_type = cell_symbol_record_type; // FIXME
- SCM fields = cell_nil;
- fields = cons (cell_symbol_procedure, fields);
- fields = cons (fields, cell_nil);
- fields = cons (cell_symbol_frame, fields);
- return make_struct (record_type, fields, cell_unspecified);
-}
-
-SCM
-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 == 0)
- procedure = cell_f;
- SCM values = cell_nil;
- values = cons (procedure, values);
- values = cons (cell_symbol_frame, values);
- return make_struct (frame_type, values, cstring_to_symbol ("frame-printer"));
-}
-
-SCM
-make_stack_type () /*:((internal)) */
-{
- SCM record_type = cell_symbol_record_type; // FIXME
- SCM fields = cell_nil;
- fields = cons (cstring_to_symbol ("frames"), fields);
- fields = cons (fields, cell_nil);
- fields = cons (cell_symbol_stack, fields);
- return make_struct (record_type, fields, cell_unspecified);
-}
-
-SCM
-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);
- long i;
- for (i = 0; i < size; i = i + 1)
- {
- SCM frame = make_frame (stack, i);
- vector_set_x_ (frames, i, frame);
- }
- SCM values = cell_nil;
- values = cons (frames, values);
- values = cons (cell_symbol_stack, values);
- return make_struct (stack_type, values, cell_unspecified);
-}
-
-SCM
-stack_length (SCM stack)
-{
- SCM frames = struct_ref_ (stack, 3);
- return vector_length (frames);
-}
-
-SCM
-stack_ref (SCM stack, SCM index)
-{
- SCM frames = struct_ref_ (stack, 3);
- return vector_ref (frames, index);
-}
-
SCM
xassq (SCM x, SCM a) /* For speed in core. */
{
@@ -205,8 +125,8 @@ equal2:
long i;
for (i = 0; i < LENGTH (a); i = i + 1)
{
- SCM ai = VECTOR (a) + i;
- SCM bi = VECTOR (b) + i;
+ SCM ai = cell_ref (VECTOR (a), i);
+ SCM bi = cell_ref (VECTOR (b), i);
if (TYPE (ai) == TREF)
ai = REF (ai);
if (TYPE (bi) == TREF)
diff --git a/src/posix.c b/src/posix.c
index 8b2ff9c8..e98ad335 100644
--- a/src/posix.c
+++ b/src/posix.c
@@ -33,6 +33,13 @@
#include
#include
+SCM
+exit_ (SCM x) /*:((name . "exit")) */
+{
+ assert_msg (TYPE (x) == TNUMBER, "TYPE (x) == TNUMBER");
+ exit (VALUE (x));
+}
+
int
peekchar ()
{
diff --git a/src/stack.c b/src/stack.c
new file mode 100644
index 00000000..1a6022c2
--- /dev/null
+++ b/src/stack.c
@@ -0,0 +1,101 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen
+ *
+ * This file is part of GNU Mes.
+ *
+ * GNU Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * GNU Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with GNU Mes. If not, see .
+ */
+
+#include "mes/lib.h"
+#include "mes/mes.h"
+
+#include
+
+SCM
+frame_printer (SCM frame)
+{
+ fdputs ("#<", __stdout);
+ display_ (struct_ref_ (frame, 2));
+ fdputc (' ', __stdout);
+ fdputs ("procedure: ", __stdout);
+ display_ (struct_ref_ (frame, 3));
+ fdputc ('>', __stdout);
+}
+
+SCM
+make_frame_type () /*:((internal)) */
+{
+ SCM fields = cell_nil;
+ fields = cons (cell_symbol_procedure, fields);
+ fields = cons (fields, cell_nil);
+ fields = cons (cell_symbol_frame, fields);
+ return make_struct (cell_symbol_record_type, fields, cell_unspecified);
+}
+
+SCM
+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 == 0)
+ procedure = cell_f;
+ SCM values = cell_nil;
+ values = cons (procedure, values);
+ values = cons (cell_symbol_frame, values);
+ return make_struct (frame_type, values, cstring_to_symbol ("frame-printer"));
+}
+
+SCM
+make_stack_type () /*:((internal)) */
+{
+ SCM fields = cell_nil;
+ fields = cons (cstring_to_symbol ("frames"), fields);
+ fields = cons (fields, cell_nil);
+ fields = cons (cell_symbol_stack, fields);
+ return make_struct (cell_symbol_record_type, fields, cell_unspecified);
+}
+
+SCM
+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);
+ long i;
+ for (i = 0; i < size; i = i + 1)
+ {
+ SCM frame = make_frame (stack, i);
+ vector_set_x_ (frames, i, frame);
+ }
+ SCM values = cell_nil;
+ values = cons (frames, values);
+ values = cons (cell_symbol_stack, values);
+ return make_struct (stack_type, values, cell_unspecified);
+}
+
+SCM
+stack_length (SCM stack)
+{
+ SCM frames = struct_ref_ (stack, 3);
+ return vector_length (frames);
+}
+
+SCM
+stack_ref (SCM stack, SCM index)
+{
+ SCM frames = struct_ref_ (stack, 3);
+ return vector_ref (frames, index);
+}