diff --git a/include/mes/m2.h b/include/mes/m2.h index ad6172fb..6d52e7a5 100644 --- a/include/mes/m2.h +++ b/include/mes/m2.h @@ -1,6 +1,6 @@ /* -*-comment-start: "//";comment-end:""-*- * GNU Mes --- Maxwell Equations of Software - * Copyright © 2019 Jan (janneke) Nieuwenhuizen + * Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen * * 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 */ diff --git a/include/mes/macros.h b/include/mes/macros.h index cffc7450..05788467 100644 --- a/include/mes/macros.h +++ b/include/mes/macros.h @@ -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 diff --git a/simple.make b/simple.make index 949d3973..2f23bd65 100644 --- a/simple.make +++ b/simple.make @@ -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 diff --git a/src/eval-apply.c b/src/eval-apply.c index 3c9dd89b..d20ab756 100644 --- a/src/eval-apply.c +++ b/src/eval-apply.c @@ -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: diff --git a/src/gc.c b/src/gc.c index 5927e2f6..3f0d47da 100644 --- a/src/gc.c +++ b/src/gc.c @@ -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; } diff --git a/src/m2.c b/src/m2.c deleted file mode 100644 index 0b1ae409..00000000 --- a/src/m2.c +++ /dev/null @@ -1,333 +0,0 @@ -/* -*-comment-start: "//";comment-end:""-*- - * GNU Mes --- Maxwell Equations of Software - * Copyright © 2019 Jan (janneke) Nieuwenhuizen - * - * 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 . - */ - -//#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 */ diff --git a/src/mes.c b/src/mes.c index b597e090..afc94b29 100644 --- a/src/mes.c +++ b/src/mes.c @@ -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; } diff --git a/src/posix.c b/src/posix.c index 5f4ffafe..0db74df0 100644 --- a/src/posix.c +++ b/src/posix.c @@ -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; } diff --git a/src/symbols.c b/src/symbols.c index cb7cf565..4635fe60 100644 --- a/src/symbols.c +++ b/src/symbols.c @@ -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;