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

Revert "core: M2 remove macros." 

This reverts commit eaf4291b11.
This commit is contained in:
Jan Nieuwenhuizen 2019-10-26 18:46:42 +02:00
parent ac06b7addd
commit 09caee3706
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
9 changed files with 101 additions and 495 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

135
include/mes/m2.h
View File

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
* Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of GNU Mes.
*
@ -21,8 +21,6 @@
#ifndef __MES_M2_H
#define __MES_M2_H
#if __M2_PLANET__
char **environ;
int __stdin;
int __stdout;
@ -54,91 +52,58 @@ struct timeval
*/
#define struct_size 12
#if POINTER_CELLS
#define CELL(x) (x)
#else
#include "mes/mes.h"
#define CELL(x) ((x*struct_size)+g_cells)
#define TYPE(x) ((x*struct_size)+g_cells)->type
#define CAR(x) ((x*struct_size)+g_cells)->car
#define CDR(x) ((x*struct_size)+g_cells)->cdr
#define NTYPE(x) ((x*struct_size)+g_news)->type
#define NCAR(x) ((x*struct_size)+g_news)->car
#define NCDR(x) ((x*struct_size)+g_news)->cdr
#define BYTES(x) ((x*struct_size)+g_cells)->car
#define LENGTH(x) ((x*struct_size)+g_cells)->car
#define MACRO(x) ((x*struct_size)+g_cells)->car
#define PORT(x) ((x*struct_size)+g_cells)->car
#define REF(x) ((x*struct_size)+g_cells)->car
#define VARIABLE(x) ((x*struct_size)+g_cells)->car
#define CLOSURE(x) ((x*struct_size)+g_cells)->cdr
#define CONTINUATION(x) ((x*struct_size)+g_cells)->cdr
#define CBYTES(x) (((x*struct_size)+g_cells) + 8)
#define NAME(x) ((x*struct_size)+g_cells)->cdr
#define STRING(x) ((x*struct_size)+g_cells)->cdr
#define STRUCT(x) ((x*struct_size)+g_cells)->cdr
#define VALUE(x) ((x*struct_size)+g_cells)->cdr
#define VECTOR(x) ((x*struct_size)+g_cells)->cdr
#define NLENGTH(x) ((x*struct_size)+g_news)->car
#define NVALUE(x) ((x*struct_size)+g_news)->cdr
#define NSTRING(x) ((x*struct_size)+g_news)->cdr
#define NVECTOR(x) ((x*struct_size)+g_news)->cdr
#define CAAR(x) CAR (CAR (x))
#define CADR(x) CAR (CDR (x))
#define CDAR(x) CDR (CAR (x))
#define CDDR(x) CDR (CDR (x))
#define CADAR(x) CAR (CDR (CAR (x)))
#define CADDR(x) CAR (CDR (CDR (x)))
#define CDADR(x) CDR (CAR (CDR (x)))
#define CDDAR(x) CDR (CDR (CAR (x)))
#endif
#define struct_size 12
#define CELL(x) ((x*struct_size)+g_cells)
SCM TYPE (SCM x);
SCM *TYPE_PTR (SCM x);
SCM CAR (SCM x);
SCM *CAR_PTR (SCM x);
SCM CDR (SCM x);
SCM *CDR_PTR (SCM x);
SCM NTYPE (SCM x);
SCM *NTYPE_PTR (SCM x);
SCM NCAR (SCM x);
SCM *NCAR_PTR (SCM x);
SCM NCDR (SCM x);
SCM *NCDR_PTR (SCM x);
SCM BYTES (SCM x);
SCM *BYTES_PTR (SCM x);
SCM LENGTH (SCM x);
SCM *LENGTH_PTR (SCM x);
SCM MACRO (SCM x);
SCM *MACRO_PTR (SCM x);
SCM PORT (SCM x);
SCM *PORT_PTR (SCM x);
SCM REF (SCM x);
SCM *REF_PTR (SCM x);
SCM VARIABLE (SCM x);
SCM *VARIABLE_PTR (SCM x);
SCM CLOSURE (SCM x);
SCM *CLOSURE_PTR (SCM x);
SCM CONTINUATION (SCM x);
SCM *CONTINUATION_PTR (SCM x);
SCM NAME (SCM x);
SCM *NAME_PTR (SCM x);
SCM STRING (SCM x);
SCM *STRING_PTR (SCM x);
SCM STRUCT (SCM x);
SCM *STRUCT_PTR (SCM x);
SCM VALUE (SCM x);
SCM *VALUE_PTR (SCM x);
SCM VECTOR (SCM x);
SCM *VECTOR_PTR (SCM x);
SCM NLENGTH (SCM x);
SCM *NLENGTH_PTR (SCM x);
SCM NVALUE (SCM x);
SCM *NVALUE_PTR (SCM x);
SCM NSTRING (SCM x);
SCM *NSTRING_PTR (SCM x);
SCM NVECTOR (SCM x);
SCM *NVECTOR_PTR (SCM x);
SCM CAAR (SCM x);
SCM CADR (SCM x);
SCM CDAR (SCM x);
SCM CDDR (SCM x);
SCM CADAR (SCM x);
SCM CADDR (SCM x);
SCM CDADR (SCM x);
SCM CDDAR (SCM x);
#endif /* __MES_M2_H */

24
include/mes/macros.h
View File

@ -21,10 +21,6 @@
#ifndef __MES_MACROS_H
#define __MES_MACROS_H
#if M2_FUNCTIONS
#include "mes/m2.h"
#else
#if POINTER_CELLS
// #define TYPE(x) x->type
@ -130,24 +126,6 @@
#endif
#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 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 CAAR(x) CAR (CAR (x))
#define CADR(x) CAR (CDR (x))
#define CDAR(x) CDR (CAR (x))
@ -157,6 +135,4 @@
#define CDADR(x) CDR (CAR (CDR (x)))
#define CDDAR(x) CDR (CDR (CAR (x)))
#endif
#endif //__MES_MACROS_H

8
simple.make
View File

@ -39,7 +39,6 @@ CFLAGS:= \
-D const= \
-ggdb \
-D SYSTEM_LIBC=1 \
-D M2_FUNCTIONS=1 \
-D 'MES_VERSION="git"' \
-D 'MES_PKGDATADIR="/usr/local/share/mes"' \
-I include \
@ -173,10 +172,9 @@ M2_PLANET_INCLUDES = \
include/mes/symbols.h \
include/linux/$(M2_PLANET_ARCH)/syscall.h
M2_PLANET_SOURCES = \
$(M2_PLANET_INCLUDES:%.h=%.h.m2) \
$(M2_SOURCES:%.c=%.c.m2) \
src/m2.c.m2 \
M2_PLANET_SOURCES = \
$(M2_PLANET_INCLUDES:%.h=%.h.m2) \
$(M2_SOURCES:%.c=%.c.m2) \
$(MES_SOURCES:%.c=%.c.m2)
%.h.m2: %.h simple.make

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 (x) = 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 (x) = 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;
CDDR (R2) = 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;
CDDR (R2) = 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;
CDDR (R2) = R1;
R1 = R2;
goto vm_return;
}
@ -828,7 +828,7 @@ macro_expand:
goto macro_expand;
macro_expand_car:
*CAR_PTR (R2) = R1;
CAR (R2) = 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 (R2) = 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 (R2) = 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 (R2) = 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 (R2) = 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 (x) = 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 (R2) = v;
goto vm_return;
call_with_values:

58
src/gc.c
View File

@ -70,14 +70,14 @@ cell_bytes (SCM x)
#elif __M2_PLANET__
CELL (x) + 8;
#else
return CDR_PTR (x);
return &CDR (x);
#endif
}
char *
news_bytes (SCM x)
{
return NCDR_PTR (x);
return &NCDR (x);
}
SCM
@ -131,12 +131,12 @@ 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;
TYPE (cell_arena) = TVECTOR;
LENGTH (cell_arena) = 1000;
VECTOR (cell_arena) = 0;
g_cells = g_cells + M2_CELL_SIZE;
*TYPE_PTR (cell_arena) = TCHAR;
*VALUE_PTR (cell_arena) = 'c';
TYPE (cell_arena) = TCHAR;
VALUE (cell_arena) = 'c';
// FIXME: remove MES_MAX_STRING, grow dynamically
g_buf = malloc (MAX_STRING);
@ -195,26 +195,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 (x) = type;
CAR (x) = car;
CDR (x) = 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 (to) = TYPE (from);
CAR (to) = CAR (from);
CDR (to) = 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 (to) = TYPE (from);
NCAR (to) = CAR (from);
NCDR (to) = CDR (from);
}
void
@ -246,8 +246,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 (x) = TBYTES;
LENGTH (x) = length;
char *p = cell_bytes (x);
if (length == 0)
p[0] = 0;
@ -294,7 +294,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 (x) = v;
return x;
}
@ -317,12 +317,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 (cell_arena) = TVECTOR;
NLENGTH (cell_arena) = 1000;
NVECTOR (cell_arena) = 0;
g_news = g_news + 1;
*NTYPE_PTR (cell_arena) = TCHAR;
*NVALUE_PTR (cell_arena) = 'n';
NTYPE (cell_arena) = TCHAR;
NVALUE (cell_arena) = 'n';
#endif
return 0;
}
@ -392,7 +392,7 @@ gc_copy (SCM old) /*:((internal)) */
copy_news (new, old);
if (NTYPE (new) == TSTRUCT || NTYPE (new) == TVECTOR)
{
*NVECTOR_PTR (new) = g_free;
NVECTOR (new) = g_free;
long i;
for (i = 0; i < LENGTH (old); i = i + 1)
{
@ -428,22 +428,22 @@ gc_copy (SCM old) /*:((internal)) */
eputs ("\n");
}
}
*TYPE_PTR (old) = TBROKEN_HEART;
*CAR_PTR (old) = new;
TYPE (old) = TBROKEN_HEART;
CAR (old) = new;
return new;
}
SCM
gc_relocate_car (SCM new, SCM car) /*:((internal)) */
{
*NCAR_PTR (new) = car;
NCAR (new) = car;
return cell_unspecified;
}
SCM
gc_relocate_cdr (SCM new, SCM cdr) /*:((internal)) */
{
*NCDR_PTR (new) = cdr;
NCDR (new) = cdr;
return cell_unspecified;
}

333
src/m2.c
View File

@ -1,333 +0,0 @@
/* -*-comment-start: "//";comment-end:""-*-
* GNU Mes --- Maxwell Equations of Software
* Copyright © 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/mes.h"
#include "mes/m2.h"
#if M2_FUNCTIONS
SCM
TYPE (SCM x)
{
struct scm *s = &g_cells[x];
return s->type;
}
SCM *
TYPE_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->type;
}
SCM
CAR (SCM x)
{
struct scm *s = &g_cells[x];
return s->car;
}
SCM *
CAR_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->car;
}
SCM
CDR (SCM x)
{
struct scm *s = &g_cells[x];
return s->cdr;
}
SCM *
CDR_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->cdr;
}
SCM
NTYPE (SCM x)
{
struct scm *s = &g_news[x];
return s->type;
}
SCM *
NTYPE_PTR (SCM x)
{
struct scm *s = &g_news[x];
return &s->type;
}
SCM
NCAR (SCM x)
{
struct scm *s = &g_news[x];
return s->car;
}
SCM *
NCAR_PTR (SCM x)
{
struct scm *s = &g_news[x];
return &s->car;
}
SCM
NCDR (SCM x)
{
struct scm *s = &g_news[x];
return s->cdr;
}
SCM *
NCDR_PTR (SCM x)
{
struct scm *s = &g_news[x];
return &s->cdr;
}
SCM
BYTES (SCM x)
{
struct scm *s = &g_cells[x];
return s->car;
}
SCM
LENGTH (SCM x)
{
struct scm *s = &g_cells[x];
return s->car;
}
SCM *
LENGTH_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->car;
}
SCM
REF (SCM x)
{
struct scm *s = &g_cells[x];
return s->car;
}
SCM
VARIABLE (SCM x)
{
struct scm *s = &g_cells[x];
return s->car;
}
SCM
CLOSURE (SCM x)
{
struct scm *s = &g_cells[x];
return s->cdr;
}
SCM
CONTINUATION (SCM x)
{
struct scm *s = &g_cells[x];
return s->cdr;
}
SCM *
CONTINUATION_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->cdr;
}
SCM
MACRO (SCM x)
{
struct scm *s = &g_cells[x];
return s->car;
}
SCM
NAME (SCM x)
{
struct scm *s = &g_cells[x];
return s->cdr;
}
SCM
PORT (SCM x)
{
struct scm *s = &g_cells[x];
return s->car;
}
SCM
STRING (SCM x)
{
struct scm *s = &g_cells[x];
return s->cdr;
}
SCM *
STRING_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->cdr;
}
SCM
STRUCT (SCM x)
{
struct scm *s = &g_cells[x];
return s->cdr;
}
SCM
VALUE (SCM x)
{
struct scm *s = &g_cells[x];
return s->cdr;
}
SCM *
VALUE_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->cdr;
}
SCM
VECTOR (SCM x)
{
struct scm *s = &g_cells[x];
return s->cdr;
}
SCM *
VECTOR_PTR (SCM x)
{
struct scm *s = &g_cells[x];
return &s->cdr;
}
SCM
NLENGTH (SCM x)
{
struct scm *s = &g_news[x];
return s->car;
}
SCM *
NLENGTH_PTR (SCM x)
{
struct scm *s = &g_news[x];
return &s->car;
}
SCM
NVALUE (SCM x)
{
struct scm *s = &g_news[x];
return s->cdr;
}
SCM *
NVALUE_PTR (SCM x)
{
struct scm *s = &g_news[x];
return &s->cdr;
}
SCM
NSTRING (SCM x)
{
struct scm *s = &g_news[x];
return s->cdr;
}
SCM
NVECTOR (SCM x)
{
struct scm *s = &g_news[x];
return s->cdr;
}
SCM *
NVECTOR_PTR (SCM x)
{
struct scm *s = &g_news[x];
return &s->cdr;
}
SCM
CAAR (SCM x)
{
return CAR (CAR (x));
}
SCM
CADR (SCM x)
{
return CAR (CDR (x));
}
SCM
CDAR (SCM x)
{
return CDR (CAR (x));
}
SCM
CDDR (SCM x)
{
return CDR (CDR (x));
}
SCM
CADAR (SCM x)
{
return CAR (CDR (CAR (x)));
}
SCM
CADDR (SCM x)
{
return CAR (CDR (CDR (x)));
}
SCM
CDADR (SCM x)
{
return CDR (CAR (CDR (x)));
}
SCM
CDDAR (SCM x)
{
return CDR (CDR (CAR (x)));
}
#endif /* M2_FUNCTIONS */

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 (v) = 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 (x) = 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 (port) = 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 (port) = 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 (x) = 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 (x) = length;
CDR (x) = STRING (string);
hash_set_x (g_symbols, string, x);
}
g_symbol = g_symbol + M2_CELL_SIZE;