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:
parent
71b94d577f
commit
d5a71819ae
|
@ -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
|
||||
|
|
|
@ -55,6 +55,7 @@ sed -ri \
|
|||
src/module.c \
|
||||
src/posix.c \
|
||||
src/reader.c \
|
||||
src/stack.c \
|
||||
src/string.c \
|
||||
src/struct.c \
|
||||
src/symbols.c \
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
96
src/lib.c
|
@ -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. */
|
||||
{
|
||||
|
|
|
@ -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 ()
|
||||
{
|
||||
|
|
|
@ -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);
|
||||
}
|
Loading…
Reference in New Issue