artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: use FIXED_PRIMITIVES rather than environment cache.

Browse source 
* cache.c: Remove.
* define.c: Remove callers.
* mes.c: Likewise.
  (vm_eval_env) [FIXED_PRIMITIVES]: Hardcode car, cdr, cons, null_p.
* GNUmakefile: Update.
This commit is contained in:
Jan Nieuwenhuizen 2016-11-21 21:43:06 +01:00
parent 0a614e6543
commit b92a8f17f8
4 changed files with 23 additions and 122 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
GNUmakefile
View file

@ -24,7 +24,6 @@ all: mes
mes.o: mes.c
mes.o: mes.c mes.h mes.i mes.environment.i mes.symbols.i
mes.o: cache.c cache.h cache.i cache.environment.i
mes.o: define.c define.h define.i define.environment.i
mes.o: display.c display.h display.i display.environment.i
mes.o: lib.c lib.h lib.i lib.environment.i

103
cache.c
View file

@ -1,103 +0,0 @@
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
* Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
* 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.
*
* 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 Mes. If not, see <http://www.gnu.org/licenses/>.
*/
#define CACHE_SIZE 30
#define ENV_HEAD 15
#if! ENV_CACHE
SCM cache_invalidate (SCM x){}
SCM cache_invalidate_range (SCM p,SCM a){}
SCM cache_save (SCM p){}
SCM cache_lookup (SCM x){}
#else // ENV_CACHE
SCM env_cache_cars[CACHE_SIZE];
SCM env_cache_cdrs[CACHE_SIZE];
int cache_threshold = 0;
SCM
cache_save (SCM p)
{
int n = g_cells[car (p)].hits;
if (n < cache_threshold) return cell_unspecified;
int j = -1;
for (int i=0; i < CACHE_SIZE; i++) {
if (!env_cache_cars[i]) {
j = i;
break;
}
if (env_cache_cars[i] == car (p)) return cell_unspecified;
if (n > g_cells[env_cache_cars[i]].hits) {
n = g_cells[env_cache_cars[i]].hits;
j = i;
}
}
if (j >= 0) {
cache_threshold = g_cells[car (p)].hits;
env_cache_cars[j] = car (p);
env_cache_cdrs[j] = cdr (p);
}
return cell_unspecified;
}
SCM
cache_lookup (SCM x)
{
for (int i=0; i < CACHE_SIZE; i++) {
if (!env_cache_cars[i]) break;
if (env_cache_cars[i] == x) return env_cache_cdrs[i];
}
return cell_undefined;
}
SCM
cache_invalidate (SCM x)
{
for (int i=0; i < CACHE_SIZE; i++) {
if (env_cache_cars[i] == x) {
env_cache_cars[i] = 0;
break;
}
}
return cell_unspecified;
}
SCM
cache_invalidate_range (SCM p, SCM a)
{
do {
cache_invalidate (caar (p));
p = cdr (p);
} while (p != a);
return cell_unspecified;
}
SCM
assq_ref_cache (SCM x, SCM a) ///((internal))
{
g_cells[x].hits++;
SCM c = cache_lookup (x);
if (c != cell_undefined) return c;
int i = 0;
while (a != cell_nil && x != CAAR (a)) {i++;a = cdr (a);}
if (a == cell_nil) return cell_undefined;
if (i>ENV_HEAD) cache_save (car (a));
return cdar (a);
}
#endif // ENV_CACHE

1
define.c
View file

@ -35,7 +35,6 @@ vm_define_env ()
else {
r2 = car (r2);
SCM p = pairlis (cadr (r1), cadr (r1), r0);
cache_invalidate_range (p, r0);
x = eval_env (make_lambda (cdadr (r1), cddr (r1)), p);
}
if (eq_p (car (r1), cell_symbol_define_macro) == cell_t)

40
mes.c
View file

@ -31,7 +31,8 @@
#define DEBUG 0
#define QUASIQUOTE 1
#define QUASISYNTAX 0
#define ENV_CACHE 1
#define ENV_CACHE 0
#define FIXED_PRIMITIVES 1
int ARENA_SIZE = 100000;
int MAX_ARENA_SIZE = 20000000;
@ -78,7 +79,6 @@ function functions[200];
int g_function = 0;
#include "mes.symbols.h"
#include "cache.h"
#include "define.h"
#include "display.h"
#include "lib.h"
@ -144,6 +144,12 @@ scm scm_symbol_primitive_load = {SYMBOL, "primitive-load"};
scm scm_symbol_the_unquoters = {SYMBOL, "*the-unquoters*"};
scm scm_symbol_car = {SYMBOL, "car"};
scm scm_symbol_cdr = {SYMBOL, "cdr"};
scm scm_symbol_null_p = {SYMBOL, "null?"};
scm scm_symbol_eq_p = {SYMBOL, "eq?"};
scm scm_symbol_cons = {SYMBOL, "cons"};
scm char_eof = {CHAR, .name="*eof*", .value=-1};
scm char_nul = {CHAR, .name="nul", .value=0};
scm char_backspace = {CHAR, .name="backspace", .value=8};
@ -177,6 +183,7 @@ scm *g_news = 0;
#define CDAR(x) CDR (CAR (x))
#define CAAR(x) CAR (CAR (x))
#define CADAR(x) CAR (CDR (CAR (x)))
#define CADDR(x) CAR (CDR (CDR (x)))
#define CDADAR(x) CAR (CDR (CAR (CDR (x))))
#define CADR(x) CAR (CDR (x))
@ -255,7 +262,6 @@ SCM
set_cdr_x (SCM x, SCM e)
{
assert (TYPE (x) == PAIR);
cache_invalidate (cdr (x));
CDR (x) = e;
return cell_unspecified;
}
@ -263,7 +269,6 @@ set_cdr_x (SCM x, SCM e)
SCM
set_env_x (SCM x, SCM e, SCM a)
{
cache_invalidate (x);
SCM p = assert_defined (x, assq (x, a));
return set_cdr_x (p, e);
}
@ -309,7 +314,6 @@ assq (SCM x, SCM a)
return a != cell_nil ? car (a) : cell_f;
}
#if! ENV_CACHE
SCM
assq_ref_cache (SCM x, SCM a)
{
@ -317,7 +321,6 @@ assq_ref_cache (SCM x, SCM a)
if (x == cell_f) return cell_undefined;
return cdr (x);
}
#endif // !ENV_CACHE
SCM
assert_defined (SCM x, SCM e)
@ -356,10 +359,7 @@ call_lambda (SCM e, SCM x, SCM aa, SCM a) ///((internal))
r0 = cl;
r2 = a;
r3 = aa;
cache_invalidate_range (r0, CDR (r3));
SCM r = vm_call_lambda ();
cache_invalidate_range (r0, CDR (r3));
return r;
return vm_call_lambda ();
}
SCM
@ -417,6 +417,18 @@ vm_eval_env ()
{
case PAIR:
{
#if FIXED_PRIMITIVES
if (car (r1) == cell_symbol_car)
return car (eval_env (CADR (r1), r0));
if (car (r1) == cell_symbol_cdr)
return cdr (eval_env (CADR (r1), r0));
if (car (r1) == cell_symbol_cons) {
SCM m = evlis_env (CDR (r1), r0);
return cons (CAR (m), CADR (m));
}
if (car (r1) == cell_symbol_null_p)
return null_p (eval_env (CADR (r1), r0));
#endif // FIXED_PRIMITIVES
if (car (r1) == cell_symbol_quote)
return cadr (r1);
#if QUASISYNTAX
@ -589,10 +601,7 @@ vm_call (function0_t f, SCM p1, SCM p2, SCM a)
r2 = p2;
r0 = a;
if (g_free.value + GC_SAFETY > ARENA_SIZE)
{
cache_invalidate_range (r0, cell_nil);
gc_stack (stack);
}
gc_stack (stack);
SCM r = f ();
frame = gc_frame (stack);
@ -1086,7 +1095,6 @@ mes_builtins (SCM a)
{
#include "mes.i"
#include "cache.i"
#include "define.i"
#include "display.i"
#include "lib.i"
@ -1097,7 +1105,6 @@ mes_builtins (SCM a)
#include "string.i"
#include "type.i"
#include "cache.environment.i"
#include "define.environment.i"
#include "display.environment.i"
#include "lib.environment.i"
@ -1228,7 +1235,6 @@ bload_env (SCM a)
}
#include "type.c"
#include "cache.c"
#include "define.c"
#include "display.c"
#include "lib.c"