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

*CDR_PTR -> [0]

This commit is contained in:
Jan Nieuwenhuizen 2019-10-26 18:18:41 +02:00
parent eaf4291b11
commit 474159632a
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
8 changed files with 112 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
include/mes/macros.h
View File

@ -130,23 +130,23 @@
#endif
#define TYPE_PTR(x) &(TYPE (x))
#define CAR_PTR(x) &(CAR (x))
#define CDR_PTR(x) &(CDR (x))
#define TYPE_PTR(x) (&(TYPE (x)))
#define CAR_PTR(x) (&(CAR (x)))
#define CDR_PTR(x) (&(CDR (x)))
#define CONTINUATION_PTR(x) &(CONTINUATION (x))
#define LENGTH_PTR(x) &(LENGTH (x))
#define STRING_PTR(x) &(STRING (x))
#define VALUE_PTR(x) &(VALUE (x))
#define VECTOR_PTR(x) &(VECTOR (x))
#define CONTINUATION_PTR(x) (&(CONTINUATION (x)))
#define LENGTH_PTR(x) (&(LENGTH (x)))
#define STRING_PTR(x) (&(STRING (x)))
#define VALUE_PTR(x) (&(VALUE (x)))
#define VECTOR_PTR(x) (&(VECTOR (x)))
#define NTYPE_PTR(x) &(NTYPE (x))
#define NCAR_PTR(x) &(NCAR (x))
#define NCDR_PTR(x) &(NCDR (x))
#define NTYPE_PTR(x) (&(NTYPE (x)))
#define NCAR_PTR(x) (&(NCAR (x)))
#define NCDR_PTR(x) (&(NCDR (x)))
#define NLENGTH_PTR(x) &(NLENGTH (x))
#define NVALUE_PTR(x) &(NVALUE (x))
#define NVECTOR_PTR(x) &(NVECTOR (x))
#define NLENGTH_PTR(x) (&(NLENGTH (x)))
#define NVALUE_PTR(x) (&(NVALUE (x)))
#define NVECTOR_PTR(x) (&(NVECTOR (x)))
#define CAAR(x) CAR (CAR (x))
#define CADR(x) CAR (CDR (x))

3
simple.make
View File

@ -57,6 +57,7 @@ MES_SOURCES = \
src/gc.c \
src/hash.c \
src/lib.c \
src/m2.c \
src/math.c \
src/mes.c \
src/module.c \
@ -187,6 +188,7 @@ M2_PLANET_SOURCES = \
| $(CC) -E -I include \
-D POINTER_CELLS=0 \
-D __M2_PLANET__=1 \
-D M2_FUNCTIONS=1 \
-D 'MES_VERSION="git"' \
-D 'MES_PKGDATADIR="/usr/local/share/mes"' \
-D FUNCTION0=FUNCTION \
@ -213,6 +215,7 @@ M2_PLANET_SOURCES = \
| $(CC) -E -I include \
-D POINTER_CELLS=0 \
-D __M2_PLANET__=1 \
-D M2_FUNCTIONS=1 \
-D 'MES_VERSION="git"' \
-D 'MES_PKGDATADIR="/usr/local/share/mes"' \
-D FUNCTION0=FUNCTION \

24
src/eval-apply.c
View File

@ -107,7 +107,7 @@ set_car_x (SCM x, SCM e)
{
if (TYPE (x) != TPAIR)
error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("set-car!")));
*CAR_PTR (x) = e;
CAR_PTR (x)[0] = e;
return cell_unspecified;
}
@ -116,7 +116,7 @@ set_cdr_x (SCM x, SCM e)
{
if (TYPE (x) != TPAIR)
error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("set-cdr!")));
*CDR_PTR (x) = e;
CDR_PTR (x)[0] = e;
return cell_unspecified;
}
@ -754,7 +754,7 @@ macro_expand:
push_cc (CDDR (R1), R1, R0, cell_vm_macro_expand_lambda);
goto macro_expand;
macro_expand_lambda:
*CDR_PTR (CDR (R2)) = R1;
CDR_PTR (CDR (R2))[0] = R1;
R1 = R2;
goto vm_return;
}
@ -775,7 +775,7 @@ macro_expand:
push_cc (CDDR (R1), R1, R0, cell_vm_macro_expand_define);
goto macro_expand;
macro_expand_define:
*CDR_PTR (CDR (R2)) = R1;
CDR_PTR (CDR (R2))[0] = R1;
R1 = R2;
if (CAR (R1) == cell_symbol_define_macro)
{
@ -792,7 +792,7 @@ macro_expand:
push_cc (CDDR (R1), R1, R0, cell_vm_macro_expand_set_x);
goto macro_expand;
macro_expand_set_x:
*CDR_PTR (CDR (R2)) = R1;
CDR_PTR (CDR (R2))[0] = R1;
R1 = R2;
goto vm_return;
}
@ -828,7 +828,7 @@ macro_expand:
goto macro_expand;
macro_expand_car:
*CAR_PTR (R2) = R1;
CAR_PTR (R2)[0] = R1;
R1 = R2;
if (CDR (R1) == cell_nil)
goto vm_return;
@ -837,7 +837,7 @@ macro_expand_car:
goto macro_expand;
macro_expand_cdr:
*CDR_PTR (R2) = R1;
CDR_PTR (R2)[0] = R1;
R1 = R2;
goto vm_return;
@ -855,7 +855,7 @@ begin:
push_cc (program, R1, R0, cell_vm_begin_primitive_load);
goto begin_expand;
begin_primitive_load:
*CAR_PTR (R2) = R1;
CAR_PTR (R2)[0] = R1;
R1 = R2;
}
}
@ -924,7 +924,7 @@ begin_expand:
R1 = x;
set_current_input_port (input);
R1 = cons (cell_symbol_begin, R1);
*CAR_PTR (R2) = R1;
CAR_PTR (R2)[0] = R1;
R1 = R2;
goto begin_expand_while;
continue; /* FIXME: M2-PLanet */
@ -936,7 +936,7 @@ begin_expand:
begin_expand_macro:
if (R1 != CAR (R2))
{
*CAR_PTR (R2) = R1;
CAR_PTR (R2)[0] = R1;
R1 = R2;
goto begin_expand_while;
continue; /* FIXME: M2-PLanet */
@ -978,7 +978,7 @@ call_with_current_continuation:
v = make_vector__ (STACK_SIZE - g_stack);
for (i = g_stack; i < STACK_SIZE; i = i + 1)
vector_set_x_ (v, i - g_stack, g_stack_array[i]);
*CONTINUATION_PTR (x) = v;
CONTINUATION_PTR (x)[0] = v;
gc_pop_frame ();
push_cc (cons (CAR (R1), cons (x, cell_nil)), x, R0, cell_vm_call_with_current_continuation2);
goto apply;
@ -986,7 +986,7 @@ call_with_current_continuation2:
v = make_vector__ (STACK_SIZE - g_stack);
for (i = g_stack; i < STACK_SIZE; i = i + 1)
vector_set_x_ (v, i - g_stack, g_stack_array[i]);
*CONTINUATION_PTR (R2) = v;
CONTINUATION_PTR (R2)[0] = v;
goto vm_return;
call_with_values:

69
src/gc.c
View File

@ -64,14 +64,7 @@ struct scm *g_news;
char *
cell_bytes (SCM x)
{
#if POINTER_CELLS
char *p = x;
return p + (2 * sizeof (long));
#elif __M2_PLANET__
CELL (x) + 8;
#else
return CDR_PTR (x);
#endif
}
char *
@ -131,12 +124,20 @@ gc_init () /*:((internal)) */
/* The vector that holds the arenea. */
cell_arena = 0;
#endif
*TYPE_PTR (cell_arena) = TVECTOR;
*LENGTH_PTR (cell_arena) = 1000;
*VECTOR_PTR (cell_arena) = 0;
eputs ("00\n");
TYPE_PTR (cell_arena)[0] = TVECTOR;
eputs ("01\n");
LENGTH_PTR (cell_arena)[0] = 1000;
eputs ("02\n");
VECTOR_PTR (cell_arena)[0] = 0;
eputs ("03\n");
g_cells = g_cells + M2_CELL_SIZE;
*TYPE_PTR (cell_arena) = TCHAR;
*VALUE_PTR (cell_arena) = 'c';
TYPE_PTR (cell_arena)[0] = TCHAR;
eputs ("06\n");
VALUE_PTR (cell_arena)[0] = 'c';
eputs ("07\n");
// FIXME: remove MES_MAX_STRING, grow dynamically
g_buf = malloc (MAX_STRING);
@ -195,26 +196,26 @@ make_cell (long type, SCM car, SCM cdr)
#endif
if (i > ARENA_SIZE)
assert_msg (0, "alloc: out of memory");
*TYPE_PTR (x) = type;
*CAR_PTR (x) = car;
*CDR_PTR (x) = cdr;
TYPE_PTR (x)[0] = type;
CAR_PTR (x)[0] = car;
CDR_PTR (x)[0] = cdr;
return x;
}
void
copy_cell (SCM to, SCM from)
{
*TYPE_PTR (to) = TYPE (from);
*CAR_PTR (to) = CAR (from);
*CDR_PTR (to) = CDR (from);
TYPE_PTR (to)[0] = TYPE (from);
CAR_PTR (to)[0] = CAR (from);
CDR_PTR (to)[0] = CDR (from);
}
void
copy_news (SCM to, SCM from)
{
*NTYPE_PTR (to) = TYPE (from);
*NCAR_PTR (to) = CAR (from);
*NCDR_PTR (to) = CDR (from);
NTYPE_PTR (to)[0] = TYPE (from);
NCAR_PTR (to)[0] = CAR (from);
NCDR_PTR (to)[0] = CDR (from);
}
void
@ -246,8 +247,8 @@ make_bytes (char const *s, size_t length)
{
size_t size = bytes_cells (length);
SCM x = alloc (size);
*TYPE_PTR (x) = TBYTES;
*LENGTH_PTR (x) = length;
TYPE_PTR (x)[0] = TBYTES;
LENGTH_PTR (x)[0] = length;
char *p = cell_bytes (x);
if (length == 0)
p[0] = 0;
@ -294,7 +295,7 @@ make_string (char const *s, size_t length)
assert_max_string (length, "make_string", s);
SCM x = make_cell (TSTRING, length, 0);
SCM v = make_bytes (s, length);
*CDR_PTR (x) = v;
CDR_PTR (x)[0] = v;
return x;
}
@ -317,12 +318,12 @@ gc_init_news () /*:((internal)) */
g_news = g_free;
#else
g_news = g_cells + g_free;
*NTYPE_PTR (cell_arena) = TVECTOR;
*NLENGTH_PTR (cell_arena) = 1000;
*NVECTOR_PTR (cell_arena) = 0;
NTYPE_PTR (cell_arena)[0] = TVECTOR;
NLENGTH_PTR (cell_arena)[0] = 1000;
NVECTOR_PTR (cell_arena)[0] = 0;
g_news = g_news + 1;
*NTYPE_PTR (cell_arena) = TCHAR;
*NVALUE_PTR (cell_arena) = 'n';
NTYPE_PTR (cell_arena)[0] = TCHAR;
NVALUE_PTR (cell_arena)[0] = 'n';
#endif
return 0;
}
@ -392,7 +393,7 @@ gc_copy (SCM old) /*:((internal)) */
copy_news (new, old);
if (NTYPE (new) == TSTRUCT || NTYPE (new) == TVECTOR)
{
*NVECTOR_PTR (new) = g_free;
NVECTOR_PTR (new)[0] = g_free;
long i;
for (i = 0; i < LENGTH (old); i = i + 1)
{
@ -428,22 +429,22 @@ gc_copy (SCM old) /*:((internal)) */
eputs ("\n");
}
}
*TYPE_PTR (old) = TBROKEN_HEART;
*CAR_PTR (old) = new;
TYPE_PTR (old)[0] = TBROKEN_HEART;
CAR_PTR (old)[0] = new;
return new;
}
SCM
gc_relocate_car (SCM new, SCM car) /*:((internal)) */
{
*NCAR_PTR (new) = car;
NCAR_PTR (new)[0] = car;
return cell_unspecified;
}
SCM
gc_relocate_cdr (SCM new, SCM cdr) /*:((internal)) */
{
*NCDR_PTR (new) = cdr;
NCDR_PTR (new)[0] = cdr;
return cell_unspecified;
}

75
src/m2.c
View File

@ -21,6 +21,14 @@
//#include "mes/mes.h"
#include "mes/m2.h"
#if __M2_PLANET__
#define M2_CELL_SIZE 12
// CONSTANT M2_CELL_SIZE 12
#else
#define M2_CELL_SIZE 1
// CONSTANT M2_CELL_SIZE 12
#endif
#if M2_FUNCTIONS
SCM
@ -33,8 +41,8 @@ TYPE (SCM x)
SCM *
TYPE_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->type;
char *p = g_cells + (x * M2_CELL_SIZE);
return p;
}
SCM
@ -47,8 +55,8 @@ CAR (SCM x)
SCM *
CAR_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->car;
char *p = g_cells + (x * M2_CELL_SIZE);
return p + sizeof (long);
}
SCM
@ -61,8 +69,8 @@ CDR (SCM x)
SCM *
CDR_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->cdr;
char *p = g_cells + (x * M2_CELL_SIZE);
return p + sizeof (long) + sizeof (long);
}
SCM
@ -75,8 +83,8 @@ NTYPE (SCM x)
SCM *
NTYPE_PTR (SCM x)
{
struct scm *s = &g_news[x];
return &s->type;
char *p = g_news + (x * M2_CELL_SIZE);
return p;
}
SCM
@ -89,8 +97,8 @@ NCAR (SCM x)
SCM *
NCAR_PTR (SCM x)
{
struct scm *s = &g_news[x];
return &s->car;
char *p = g_news + (x * M2_CELL_SIZE);
return p + sizeof (long);
}
SCM
@ -103,8 +111,8 @@ NCDR (SCM x)
SCM *
NCDR_PTR (SCM x)
{
struct scm *s = &g_news[x];
return &s->cdr;
char *p = g_news + (x * M2_CELL_SIZE);
return p + sizeof (long) + sizeof (long);
}
SCM
@ -124,8 +132,8 @@ LENGTH (SCM x)
SCM *
LENGTH_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->car;
char *p = g_cells + (x * M2_CELL_SIZE);
return p + sizeof (long);
}
SCM
@ -159,8 +167,8 @@ CONTINUATION (SCM x)
SCM *
CONTINUATION_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->cdr;
char *p = g_cells + (x * M2_CELL_SIZE);
return p + sizeof (long) + sizeof (long);
}
SCM
@ -194,8 +202,8 @@ STRING (SCM x)
SCM *
STRING_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->cdr;
char *p = g_cells + (x * M2_CELL_SIZE);
return p + sizeof (long) + sizeof (long);
}
SCM
@ -215,8 +223,8 @@ VALUE (SCM x)
SCM *
VALUE_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->cdr;
char *p = g_cells + (x * M2_CELL_SIZE);
return p + sizeof (long) + sizeof (long);
}
SCM
@ -229,8 +237,8 @@ VECTOR (SCM x)
SCM *
VECTOR_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->cdr;
char *p = g_cells + (x * M2_CELL_SIZE);
return p + sizeof (long) + sizeof (long);
}
SCM
@ -243,43 +251,42 @@ NLENGTH (SCM x)
SCM *
NLENGTH_PTR (SCM x)
{
struct scm *s = &g_news[x];
return &s->car;
char *p = g_cells + (x * M2_CELL_SIZE);
return p + sizeof (long);
}
SCM
NVALUE (SCM x)
{
struct scm *s = &g_news[x];
return s->cdr;
return (x * M2_CELL_SIZE) + g_news + sizeof (long) + sizeof (long);
}
SCM *
NVALUE_PTR (SCM x)
{
struct scm *s = &g_news[x];
return &s->cdr;
char *p = g_news + (x * M2_CELL_SIZE);
return p + sizeof (long) + sizeof (long);
}
SCM
NSTRING (SCM x)
{
struct scm *s = &g_news[x];
return s->cdr;
char *p = g_news + (x * M2_CELL_SIZE);
return p + sizeof (long) + sizeof (long);
}
SCM
NVECTOR (SCM x)
{
struct scm *s = &g_news[x];
return s->cdr;
char *p = g_news + (x * M2_CELL_SIZE);
return p + sizeof (long) + sizeof (long);
}
SCM *
NVECTOR_PTR (SCM x)
{
struct scm *s = &g_news[x];
return &s->cdr;
char *p = g_news + (x * M2_CELL_SIZE);
return p + sizeof (long) + sizeof (long);
}
SCM

4
src/mes.c
View File

@ -149,7 +149,7 @@ SCM
values (SCM x) /*:((arity . n)) */
{
SCM v = cons (0, x);
*TYPE_PTR (v) = TVALUES;
TYPE_PTR (v)[0] = TVALUES;
return v;
}
@ -235,7 +235,7 @@ reverse_x_ (SCM x, SCM t)
while (x != cell_nil)
{
t = CDR (x);
*CDR_PTR (x) = r;
CDR_PTR (x)[0] = r;
r = x;
x = t;
}

4
src/posix.c
View File

@ -62,7 +62,7 @@ readchar ()
char const *p = cell_bytes (STRING (string));
int c = p[0];
p = p + 1;
*STRING_PTR (port) = make_string (p, length - 1);
STRING_PTR (port)[0] = make_string (p, length - 1);
return c;
}
@ -79,7 +79,7 @@ unreadchar (int c)
string = make_string (p, length + 1);
p = cell_bytes (STRING (string));
p[0] = c;
*STRING_PTR (port) = string;
STRING_PTR (port)[0] = string;
return c;
}

6
src/symbols.c
View File

@ -40,15 +40,15 @@ long g_symbol;
SCM
init_symbol (SCM x, long type, char const *name)
{
*TYPE_PTR (x) = type;
TYPE_PTR (x)[0] = type;
if (g_symbols == 0)
g_free = g_free + M2_CELL_SIZE;
else
{
int length = strlen (name);
SCM string = make_string (name, length);
*CAR_PTR (x) = length;
*CDR_PTR (x) = STRING (string);
CAR_PTR (x)[0] = length;
CDR_PTR (x)[0] = STRING (string);
hash_set_x (g_symbols, string, x);
}
g_symbol = g_symbol + M2_CELL_SIZE;