diff --git a/build-aux/configure-lib.sh b/build-aux/configure-lib.sh index 27f1eebe..8bce4f5e 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 ae0375bd..6b16cf1f 100644 --- a/src/lib.c +++ b/src/lib.c @@ -1,7 +1,6 @@ /* -*-comment-start: "//";comment-end:""-*- * GNU Mes --- Maxwell Equations of Software * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen - * Copyright © 2021 W. J. van der Laan * * This file is part of GNU Mes. * @@ -19,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" @@ -48,97 +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 = 0; - SCM procedure = 0; - if (index != 0) - { - array_index = (STACK_SIZE - (index * FRAME_SIZE)); - 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. */ { @@ -211,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..6d2de5a7 --- /dev/null +++ b/src/stack.c @@ -0,0 +1,107 @@ +/* -*-comment-start: "//";comment-end:""-*- + * GNU Mes --- Maxwell Equations of Software + * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen + * Copyright © 2021 W. J. van der Laan + * + * 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 = 0; + SCM procedure = 0; + if (index != 0) + { + array_index = (STACK_SIZE - (index * FRAME_SIZE)); + 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); +}