andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: Split-out stack.c 

* 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/build-mes.sh (mes_sources): Add it.
* simple.make (LIBMES_SOURCES): Likewise.
This commit is contained in:
Jan Nieuwenhuizen 2019-10-27 07:53:46 +01:00
parent 672ce54f1e
commit 325f9e7377
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
7 changed files with 122 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
build-aux/build-mes.sh
View File

@ -47,6 +47,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

@ -56,6 +56,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/string.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

1
simple.make
View File

@ -58,6 +58,7 @@ MES_SOURCES = \
src/posix.c \
src/reader.c \
src/string.c \
src/stack.c \
src/struct.c \
src/symbol.c \
src/vector.c

96
src/lib.c
View File

@ -18,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"
@ -33,7 +39,7 @@ SCM
car_ (SCM x)
{
SCM a = CAR (x);
if (TYPE (x) == TPAIR)
if (TYPE (a) == TPAIR)
return a;
return make_number (a);
}
@ -42,97 +48,11 @@ SCM
cdr_ (SCM x)
{
SCM d = CDR (x);
if (TYPE (x) == TPAIR || TYPE (x) == TCLOSURE)
if (TYPE (d) == TPAIR)
return d;
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. */
{

7
src/posix.c
View File

@ -31,6 +31,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 ()
{

103
src/stack.c Normal file
View File

@ -0,0 +1,103 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
*
* 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 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);
}