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

core: Split-out stack.c

Browse source 
* src/lib.c (exit_, frame_printer, make_frame_type, make_frame,
make_stack_type, make_stack, stack_length, stack_ref_): Move to ..
* src/posix.c (exit_): Here and to ..
* src/core.c: New file.
* build-aux/configure-lib.sh (mes_SOURCES): Add it.
* simple.make (LIBMES_SOURCES): Likewise.
* build-aux/snarf.sh: Likewise.
* include/mes/builtins.h: Update.
* src/builtins.c (mes_builtins): Update.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-07-19 08:53:46 +02:00
parent 3ff1fcb809
commit 178b063ffa
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
9 changed files with 138 additions and 104 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
build-aux/configure-lib.sh
View file

@ -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

1
build-aux/pointer.sh
View file

@ -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 \

1
build-aux/snarf.sh
View file

@ -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

11
include/mes/builtins.h
View file

@ -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);

1
simple.make
View file

@ -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

11
src/builtins.c
View file

@ -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);

102
src/lib.c
View file

@ -1,7 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* Copyright © 2021 W. J. van der Laan <laanwj@protonmail.com>
*
* This file is part of GNU Mes.
*
@ -19,6 +18,12 @@
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
*/
/** 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)

7
src/posix.c
View file

@ -33,6 +33,13 @@
#include <sys/wait.h>
#include <unistd.h>
SCM
exit_ (SCM x) /*:((name . "exit")) */
{
assert_msg (TYPE (x) == TNUMBER, "TYPE (x) == TNUMBER");
exit (VALUE (x));
}
int
peekchar ()
{

107
src/stack.c Normal file
View file

@ -0,0 +1,107 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* Copyright © 2021 W. J. van der Laan <laanwj@protonmail.com>
*
* 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 <http://www.gnu.org/licenses/>.
*/
#include "mes/lib.h"
#include "mes/mes.h"
#include <stdlib.h>
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);
}