Import Upstream version 5d9upstream/5d9

1 files changed, 190 insertions, 151 deletions

diff --git a/eval.c b/eval.c
index 7b0e983..d5bba5f 100644
--- a/eval.c
+++ b/eval.c
@@ -45,8 +45,16 @@
 #include "scm.h"
 #include "setjump.h"
 
-#define I_SYM(x) (CAR((x)-1L))
-#define I_VAL(x) (CDR((x)-1L))
+#ifdef _M_ARM
+/* The Microsoft CLARM compiler has a bug in pointer arithmetic.
+   It doesn't always take into account that data acceses have to be
+   DWORD aligned.  The MS_CLARM_dumy assignment resolves this problem.  */
+# define I_SYM(x) (CAR((SCM)(MS_CLARM_dumy = (x)-1L)))
+# define I_VAL(x) (CDR((SCM)(MS_CLARM_dumy = (x)-1L)))
+#else
+# define I_SYM(x) (CAR((x)-1L))
+# define I_VAL(x) (CDR((x)-1L))
+#endif
 #define ATOMP(x) (5==(5 & (int)CAR(x)))
 #define EVALCELLCAR(x) (ATOMP(CAR(x))?evalatomcar(x, 0):ceval_1(CAR(x)))
 #define EVALIMP(x) (ILOCP(x)?*ilookup(x):x)
@@ -103,7 +111,7 @@
 #endif
 #define EXTEND_ENV cons
 
-SCM scm_env = EOL, scm_env_tmp = UNSPECIFIED;
+SCM scm_env, scm_env_tmp;
 long tc16_env;			/* Type code for environments passed to macro
 				   transformers. */
 
@@ -221,8 +229,7 @@ static void debug_env_save P((char *fnam, int line));
 #endif
 
 #ifndef RECKLESS
-SCM scm_trace = BOOL_F;
-SCM scm_trace_env = EOL;
+SCM scm_trace, scm_trace_env;
 #endif
 #define ENV_MAY_POP(p, guard) if (p>0 && !(guard)) {ENV_POP; p=-1;}
 #define ENV_MAY_PUSH(p) if (p<=0) {ENV_PUSH; p=1;}
@@ -250,8 +257,8 @@ long tc16_macro;		/* Type code for macros */
 #define MAC_MACRO	0x8L
 #define MAC_MMACRO	0x2L
 #define MAC_IDMACRO	0x6L
-/*  uncomment this to experiment with inline procedures
-    #define MAC_INLINE	0x10L */
+/*  Uncomment this to experiment with inline procedures: */
+/* #define MAC_INLINE	0x10L */
 
 #ifdef MACRO
 long tc16_ident;		/* synthetic macro identifier */
@@ -272,11 +279,16 @@ long eval_clo_cases[5][4];	/* actual args, required args */
 SCM scm_profile(resetp)
      SCM resetp;
 {
-  SCM ev = make_uve(sizeof(eval_cases)/sizeof(long), MAKINUM(-1));
-  SCM evo = make_uve(sizeof(eval_cases_other)/sizeof(long), MAKINUM(-1));
+  SCM ev = make_uve(sizeof(eval_cases)/sizeof(long),
+		    MAKINUM(-8L*sizeof(long)));
+  SCM evo = make_uve(sizeof(eval_cases_other)/sizeof(long),
+		     MAKINUM(-8L*sizeof(long)));
   SCM il = dims2ura(cons2(MAKINUM(10), MAKINUM(10), cons(MAKINUM(2), EOL)),
-		    MAKINUM(-1), EOL);
-  SCM evc = dims2ura(cons2(MAKINUM(5), MAKINUM(4), EOL), MAKINUM(-1), EOL);
+		    MAKINUM(-8L*sizeof(long)),
+		    EOL);
+  SCM evc = dims2ura(cons2(MAKINUM(5), MAKINUM(4), EOL),
+		     MAKINUM(-8L*sizeof(long)),
+		     EOL);
   long *v = (long *)VELTS(ev);
   int i;
   for (i = 0; i < sizeof(eval_cases)/sizeof(long); i++)
@@ -291,14 +303,14 @@ SCM scm_profile(resetp)
   for (i = 0; i < sizeof(eval_clo_cases)/sizeof(long); i++)
     v[i] = ((long *)eval_clo_cases)[i];
   if (! UNBNDP(resetp)) {
-  for (i = 0; i < sizeof(eval_cases)/sizeof(long); i++)
-    eval_cases[i] = 0;
-  for (i = 0; i < sizeof(eval_cases_other)/sizeof(long); i++)
-    eval_cases_other[i] = 0;
-  for (i = 0; i < sizeof(ilookup_cases)/sizeof(long); i++)
-    ((long *)ilookup_cases)[i] = 0;
-  for (i = 0; i < sizeof(eval_clo_cases)/sizeof(long); i++)
-    ((long *)eval_clo_cases)[i] = 0;
+    for (i = 0; i < sizeof(eval_cases)/sizeof(long); i++)
+      eval_cases[i] = 0;
+    for (i = 0; i < sizeof(eval_cases_other)/sizeof(long); i++)
+      eval_cases_other[i] = 0;
+    for (i = 0; i < sizeof(ilookup_cases)/sizeof(long); i++)
+      ((long *)ilookup_cases)[i] = 0;
+    for (i = 0; i < sizeof(eval_clo_cases)/sizeof(long); i++)
+      ((long *)eval_clo_cases)[i] = 0;
   }
   return cons2(ev, evo, cons2(il, evc, EOL));
 }
@@ -540,7 +552,7 @@ static SCM *lookupcar(vloc)
 #endif
   else {			/* global ref */
 #ifdef MACRO
-    ASSERT(SYMBOLP(addr), var, s_escaped, "");
+    ASRTER(SYMBOLP(addr), var, s_escaped, "");
 #endif
     val = sym2vcell(addr);
     addr = val + tc3_cons_gloc;
@@ -549,7 +561,7 @@ static SCM *lookupcar(vloc)
     ASRTGO(!KEYWORDP(*pv), badkey);
 #endif
   }
-  ASSERT(!UNBNDP(*pv) && undefineds != *pv, var, s_unbnd, "");
+  ASRTER(!UNBNDP(*pv) && undefineds != *pv, var, s_unbnd, "");
   CAR(vloc) = addr;
   return pv;
 }
@@ -576,13 +588,13 @@ static SCM scm_lookupval(vloc, memo)
   }
   else {			/* global ref */
 #ifdef MACRO
-    ASSERT(SYMBOLP(addr), var, s_escaped, "");
+    ASRTER(SYMBOLP(addr), var, s_escaped, "");
 #endif
     addr = sym2vcell(addr);
     val = CDR(addr);
     addr += tc3_cons_gloc;
   }
-  ASSERT(!UNBNDP(val) && val != undefineds, var, s_unbnd, "");
+  ASRTER(!UNBNDP(val) && val != undefineds, var, s_unbnd, "");
   if (memo && !KEYWORDP(val))	/* Don't memoize forms to be macroexpanded. */
     CAR(vloc) = addr;
   return val;
@@ -643,7 +655,7 @@ SCM scm_multi_set(syms, vals)
   SCM res = EOL, *pres = &res;
   SCM *loc;
   do {
-    ASSERT(NIMP(vals) && CONSP(vals), vals, WNA, s_set);
+    ASRTER(NIMP(vals) && CONSP(vals), vals, WNA, s_set);
     switch (7 & (int)(CAR(syms))) {
     case 0:
       loc = lookupcar(syms);
@@ -661,7 +673,7 @@ SCM scm_multi_set(syms, vals)
     syms = CDR(syms);
     vals = CDR(vals);
   } while (NIMP(syms));
-  ASSERT(NULLP(vals) && NULLP(syms), vals, WNA, s_set);
+  ASRTER(NULLP(vals) && NULLP(syms), vals, WNA, s_set);
   return res;
 }
 
@@ -743,7 +755,7 @@ static SCM toplevel_define(xorig, env)
 {
   SCM x = CDR(xorig);
   SCM name = CAR(x);
-  ASSERT(scm_nullenv_p(env), xorig, s_placement, s_define);
+  ASRTER(scm_nullenv_p(env), xorig, s_placement, s_define);
   ENV_PUSH;
   x = cons(m_binding(name, CAR(CDR(x)), env, EOL), EOL);
   x = evalcar(x);
@@ -845,7 +857,7 @@ SCM scm_values(arg1, arg2, rest, what)
      char *what;
 {
   DEFER_INTS_EGC;
-  ASSERT(IM_VALUES_TOKEN==scm_env_tmp, UNDEFINED, "one value expected", what);
+  ASRTER(IM_VALUES_TOKEN==scm_env_tmp, UNDEFINED, "one value expected", what);
   if (! UNBNDP(arg2))
     scm_env_cons(arg2, rest);
   return arg1;
@@ -1051,7 +1063,7 @@ SCM m_case(xorig, env, ctxt)
   while(NIMP(x = CDR(x))) {
     clause = CAR(x);
     s = scm_check_linum(clause, 0L);
-    ASSYNT(ilength(clause) >= 2, clause /* xorig */, s_clauses, s_case);
+    ASSYNT(ilength(s) >= 2, clause /* xorig */, s_clauses, s_case);
     clause = s;
     if (TOPDENOTE_EQ(i_else, CAR(clause), env)) {
       ASSYNT(NULLP(CDR(x)), xorig, s_bad_else_clause, s_case);
@@ -1165,7 +1177,7 @@ SCM m_lambda(xorig, env, ctxt)
   SCM name, linum;
 #endif
   int argc;
-  ASSERT(ilength(x) > 1, x, s_body, s_lambda);
+  ASRTER(ilength(x) > 1, x, s_body, s_lambda);
   formals = CAR(x);
   argc = varcheck(formals, IM_LAMBDA, s_formals);
   formals = scm_check_linum(formals, 0L);
@@ -1219,8 +1231,8 @@ SCM m_inline_lambda(xorig, env)
   SCM x = CDR(xorig);
   SCM typ = (SCM)(tc16_macro | (MAC_INLINE << 16));
   int depth = env_depth();
-  ASSERT(ilength(x) > 1, xorig, s_formals, s_lambda);
-  ASSERT(ilength(CAR(x)) >= 0, xorig, s_formals, s_lambda);
+  ASRTER(ilength(x) > 1, xorig, s_formals, s_lambda);
+  ASRTER(ilength(CAR(x)) >= 0, xorig, s_formals, s_lambda);
   varcheck(CAR(x), IM_LAMBDA, s_formals);
   x = cons2(typ, MAKINUM((long)depth),
 	    cons(CAR(x), m_body(CDR(x), env)));
@@ -1235,13 +1247,13 @@ int scm_nullenv_p(env)
   SCM fr, e;
   if (IMP(env)) return !0;
   for (e = env; NIMP(e); e = CDR(e)) {
-    ASSERT(CONSP(e), e, s_badenv, s_nullenv_p);
+    ASRTER(CONSP(e), e, s_badenv, s_nullenv_p);
     fr = CAR(e);
     if (IMP(fr)) {
       if (NULLP(fr)) return 0;
       if (INUMP(fr)) {      /* These frames are for meta-data, not bindings. */
 	e = CDR(e);
-	ASSERT(NIMP(e), env, s_badenv, s_nullenv_p);
+	ASRTER(NIMP(e), env, s_badenv, s_nullenv_p);
       }
     } else return 0;
   }
@@ -1314,7 +1326,6 @@ SCM m_do(xorig, env, ctxt)
   x = CDR(x);
   test = scm_check_linum(CAR(x), 0L);
   ASSYNT(ilength(test) >= 1, CAR(x), s_test, s_do);
-  test = m_seq(test, env, ctxt);
   if (IMP(CDR(test))) test = cons(CAR(test), list_unspecified);
   ASSYNT(ilength(CDR(x))>=0, xorig, s_expression, s_do);
   varcheck(vars, IM_DO, s_variable);
@@ -1396,7 +1407,7 @@ static SCM m_iqq(form, depth, env, ctxt)
 	if (0==depth) tmp = IM_UNQUOTE;
       label:
 	form = CDR(form);
-	ASSERT(NIMP(form) && ECONSP(form) && NULLP(CDR(form)),
+	ASRTER(NIMP(form) && ECONSP(form) && NULLP(CDR(form)),
 	       form, ARG1, s_quasiquote);
 	if (0!=depth)
 	  form = cons(m_iqq(CAR(form), depth, env, ctxt), EOL);
@@ -1444,6 +1455,11 @@ static int built_inp(name, x)
   return 0;
 }
 
+extern char s_redefining[];
+#ifndef RECKLESS
+char s_built_in_syntax[] = "built-in syntax ";
+# define s_syntax (&s_built_in_syntax[9])
+#endif
 static void checked_define(name, val, what)
      SCM name, val;
      char *what;
@@ -1451,7 +1467,7 @@ static void checked_define(name, val, what)
   SCM old, vcell;
 #ifdef MACRO
   while (M_IDENTP(name)) {
-    ASSERT(IMP(IDENT_ENV(name)), name, s_escaped, what);
+    ASRTER(IMP(IDENT_ENV(name)), name, s_escaped, what);
     name = IDENT_PARENT(name);
   }
 #endif
@@ -1459,17 +1475,17 @@ static void checked_define(name, val, what)
   old = CDR(vcell);
 #ifndef RECKLESS
     if ('@'==CHARS(name)[0] && UNDEFINED != old)
-      scm_warn("redefining internal name ", "", name);
+      scm_warn(s_redefining, "internal name ", name);
     if (KEYWORDP(old)) {
       if (1 <= verbose && built_inp(name, KEYWORD_MACRO(old)))
-	scm_warn("redefining built-in syntax ", "", name);
+	scm_warn(s_redefining, s_built_in_syntax, name);
       else if (3 <= verbose)
-	scm_warn("redefining syntax ", "", name);
+	scm_warn(s_redefining, s_syntax, name);
     }
     else if (2 <= verbose && built_inp(name, old) && (old != val))
-      scm_warn("redefining built-in ", "", name);
+      scm_warn(s_redefining, "built-in ", name);
     else if (5 <= verbose && UNDEFINED != old)
-      scm_warn("redefining ", "", name);
+      scm_warn(s_redefining, "", name);
 #endif
     CDR(vcell) = val;
 }
@@ -1594,7 +1610,7 @@ static SCM m_body(xorig, env, ctxt)
      SCM xorig, env, ctxt;
 {
   SCM form, denv = env, x = xorig, defs = EOL;
-  char *what = ISYMCHARS(CAR(xorig)) + 2;
+  char *what = 0; /* Should this be passed in? */
   ASRTSYNTAX(ilength(xorig) >= 1, s_expression);
   while NIMP(x) {
     form = scm_check_linum(CAR(x), 0L);
@@ -1627,9 +1643,9 @@ static SCM m_body(xorig, env, ctxt)
     }
   }
 #ifdef CAUTIOUS
-  ASSYNT(ilength(x) > 0, x, s_body, what);
+  ASSYNT(ilength(x) > 0, xorig, s_body, what);
 #else
-  ASSYNT(ilength(x) > 0, CDR(xorig), s_body, what);
+  ASSYNT(ilength(x) > 0, xorig, s_body, what);
 #endif
   if (IMP(defs)) return x;
   return cons(m_letrec1(IM_DEFINE, cons2(i_define, defs, x), env, ctxt), EOL);
@@ -2019,11 +2035,26 @@ SCM scm_eval_values(x, env, valenv)
   return res;
 }
 
+#ifdef __GNUC__
+# define GCC_VERSION (__GNUC__ * 100 + __GNUC_MINOR__)
+/* __GNUC_PATCHLEVEL__ */
+# if 302 == GCC_VERSION
+#  ifdef sparc
+#   define GCC_SPARC_BUG
+#  endif
+# endif
+#endif
+
 static SCM ceval_1(x)
      SCM x;
 {
-  union {SCM *lloc; SCM arg1;} t;
-  SCM proc, arg2, arg3;
+#ifdef GCC_SPARC_BUG
+  SCM arg1;
+#else
+  struct {SCM arg_1;} t;
+# define arg1 t.arg_1
+#endif
+  SCM arg2, arg3, proc;
   int envpp = 0;	/* 1 means an environment has been pushed in this
 		   invocation of ceval_1, -1 means pushed and then popped. */
 #ifdef CAUTIOUS
@@ -2044,19 +2075,19 @@ static SCM ceval_1(x)
     goto retx;
   case (127 & IM_AND):
     x = CDR(x);
-    t.arg1 = x;
-    while(NNULLP(t.arg1 = CDR(t.arg1)))
+    arg1 = x;
+    while(NNULLP(arg1 = CDR(arg1)))
       if (FALSEP(EVALCAR(x))) {x = BOOL_F; goto retx;}
-      else x = t.arg1;
+      else x = arg1;
     goto carloop;
  cdrxbegin:
   case (127 & IM_BEGIN):
     x = CDR(x);
  begin:
-    t.arg1 = x;
-    while(NNULLP(t.arg1 = CDR(t.arg1))) {
+    arg1 = x;
+    while(NNULLP(arg1 = CDR(arg1))) {
       if (NIMP(CAR(x))) ceval_1(CAR(x));
-      x = t.arg1;
+      x = arg1;
     }
  carloop:			/* eval car of last form in list */
     if NCELLP(CAR(x)) {
@@ -2080,11 +2111,11 @@ static SCM ceval_1(x)
   case (127 & IM_COND):
     while(NIMP(x = CDR(x))) {
       proc = CAR(x);
-      t.arg1 = EVALCAR(proc);
-      if NFALSEP(t.arg1) {
+      arg1 = EVALCAR(proc);
+      if NFALSEP(arg1) {
 	x = CDR(proc);
 	if NULLP(x) {
-	  x = t.arg1;
+	  x = arg1;
 	  goto retx;
 	}
 	if (IM_ARROW != CAR(x)) goto begin;
@@ -2106,8 +2137,8 @@ static SCM ceval_1(x)
     x = CDR(CDR(x));
     while (proc = CAR(x), FALSEP(EVALCAR(proc))) {
       for(proc = CAR(CDR(x));NIMP(proc);proc = CDR(proc)) {
-	t.arg1 = CAR(proc);	/* body */
-	SIDEVAL_1(t.arg1);
+	arg1 = CAR(proc);	/* body */
+	SIDEVAL_1(arg1);
       }
       ecache_evalx(CDR(CDR(x))); /* steps */
       scm_env = CDR(scm_env);
@@ -2125,13 +2156,13 @@ static SCM ceval_1(x)
     ENV_MAY_PUSH(envpp);
     TRACE(x);
 #ifdef MAC_INLINE
-    t.arg1 = CAR(x);
+    arg1 = CAR(x);
 #endif
     x = CDR(x);
     ecache_evalx(CAR(CDR(x)));
 #ifdef MAC_INLINE
-    if (t.arg1 != IM_LET)	/* inline call */
-      env_tail(ISYMVAL(t.arg1));
+    if (arg1 != IM_LET)	/* inline call */
+      env_tail(ISYMVAL(arg1));
 #endif
     STATIC_ENV = CAR(x);
     EXTEND_VALENV;
@@ -2171,11 +2202,11 @@ static SCM ceval_1(x)
     goto cdrxbegin;
   case (127 & IM_OR):
     x = CDR(x);
-    t.arg1 = x;
-    while(NNULLP(t.arg1 = CDR(t.arg1))) {
+    arg1 = x;
+    while(NNULLP(arg1 = CDR(arg1))) {
       x = EVALCAR(x);
       if NFALSEP(x) goto retx;
-      x = t.arg1;
+      x = arg1;
     }
     goto carloop;
   case (127 & IM_LAMBDA):
@@ -2226,18 +2257,18 @@ static SCM ceval_1(x)
       x = CDR(x);
       proc = evalcar(x);
       ASRTGO(NIMP(proc), badfun);
-      t.arg1 = evalcar(CDR(x));
+      arg1 = evalcar(CDR(x));
       if (CLOSUREP(proc)) {
 	ENV_MAY_PUSH(envpp);
 	TRACE(x);
-	scm_env_tmp = t.arg1;
+	scm_env_tmp = arg1;
 #ifndef RECKLESS
 	goto clo_checked;
 #else
 	goto clo_unchecked;
 #endif
       }
-      x = apply(proc, t.arg1, EOL);
+      x = apply(proc, arg1, EOL);
       goto retx;
     case (ISYMNUM(IM_DELAY)):
       x = makprom(closure(CDR(x), 0));
@@ -2338,13 +2369,13 @@ static SCM ceval_1(x)
 #ifdef CAUTIOUS
       if (0!=ARGC(proc)) {
       clo_checked:
-	t.arg1 = SCM_ENV_FORMALS(CAR(CODE(proc)));
+	arg1 = SCM_ENV_FORMALS(CAR(CODE(proc)));
 	DEFER_INTS_EGC;
 	arg2 = scm_env_tmp;
-	while NIMP(t.arg1) {
-	  if NCONSP(t.arg1) goto clo_unchecked;
+	while NIMP(arg1) {
+	  if NCONSP(arg1) goto clo_unchecked;
 	  if IMP(arg2) goto umwrongnumargs;
-	  t.arg1 = CDR(t.arg1);
+	  arg1 = CDR(arg1);
 	  arg2 = CDR(arg2);
 	}
 	if NNULLP(arg2) goto umwrongnumargs;
@@ -2364,7 +2395,7 @@ static SCM ceval_1(x)
 	/* default: break; */
 #ifdef CCLO
       case tc16_cclo:
-	t.arg1 = proc;
+	arg1 = proc;
 	proc = CCLO_SUBR(proc);
 	goto evap1;
 #endif
@@ -2400,77 +2431,77 @@ static SCM ceval_1(x)
   if (IMP(x))
     goto wrongnumargs;
 #endif
-  t.arg1 = EVALCAR(x);
+  arg1 = EVALCAR(x);
   x = CDR(x);
   if NULLP(x) {
     TOP_TRACE(xorig, STATIC_ENV);
 evap1:
     ENV_MAY_POP(envpp, CLOSUREP(proc));
     ALLOW_INTS_EGC;
-    switch TYP7(proc) { /* have one argument in t.arg1 */
+    switch TYP7(proc) { /* have one argument in arg1 */
     case tc7_subr_2o:
-      return SUBRF(proc)(t.arg1, UNDEFINED);
+      return SUBRF(proc)(arg1, UNDEFINED);
     case tc7_subr_1:
     case tc7_subr_1o:
-      return SUBRF(proc)(t.arg1);
+      return SUBRF(proc)(arg1);
     case tc7_cxr:
 #ifdef FLOATS
       if SUBRF(proc) {
-	if INUMP(t.arg1)
-	  return makdbl(DSUBRF(proc)((double) INUM(t.arg1)), 0.0);
-	ASRTGO(NIMP(t.arg1), floerr);
-	if REALP(t.arg1)
-	  return makdbl(DSUBRF(proc)(REALPART(t.arg1)), 0.0);
+	if INUMP(arg1)
+	  return makdbl(DSUBRF(proc)((double) INUM(arg1)), 0.0);
+	ASRTGO(NIMP(arg1), floerr);
+	if REALP(arg1)
+	  return makdbl(DSUBRF(proc)(REALPART(arg1)), 0.0);
 # ifdef BIGDIG
-	if BIGP(t.arg1)
-	  return makdbl(DSUBRF(proc)(big2dbl(t.arg1)), 0.0);
+	if BIGP(arg1)
+	  return makdbl(DSUBRF(proc)(big2dbl(arg1)), 0.0);
 # endif
       floerr:
-	wta(t.arg1, (char *)ARG1, SNAME(proc));
+	wta(arg1, (char *)ARG1, SNAME(proc));
       }
 #endif
       {
 	int op = CXR_OP(proc);
 #ifndef RECKLESS
-	x = t.arg1;
+	x = arg1;
 #endif
 	while (op) {
-	  ASSERT(NIMP(t.arg1) && CONSP(t.arg1),
+	  ASRTER(NIMP(arg1) && CONSP(arg1),
 		 x, ARG1, SNAME(proc));
-	  t.arg1 = (1 & op ? CAR(t.arg1) : CDR(t.arg1));
+	  arg1 = (1 & op ? CAR(arg1) : CDR(arg1));
 	  op >>= 2;
 	}
-	return t.arg1;
+	return arg1;
       }
     case tc7_rpsubr:
       return BOOL_T;
     case tc7_asubr:
-      return SUBRF(proc)(t.arg1, UNDEFINED);
+      return SUBRF(proc)(arg1, UNDEFINED);
     case tc7_lsubr:
-      return SUBRF(proc)(cons(t.arg1, EOL));
+      return SUBRF(proc)(cons(arg1, EOL));
     case tcs_closures:
       ENV_MAY_PUSH(envpp);
 #ifdef SCM_PROFILE
       eval_clo_cases[1][ARGC(proc)]++;
 #endif
       if (1==ARGC(proc)) {
-	scm_env_cons(t.arg1, EOL);
+	scm_env_cons(arg1, EOL);
 	goto clo_unchecked;
       }
       else {
-	scm_env_tmp = cons(t.arg1, EOL);
+	scm_env_tmp = cons(arg1, EOL);
 	goto clo_checked;
       }
     case tc7_contin:
-      scm_dynthrow(proc, t.arg1);
+      scm_dynthrow(proc, arg1);
     case tc7_specfun:
       switch TYP16(proc) {
       case tc16_call_cc:
-	proc = t.arg1;
+	proc = arg1;
 	DEFER_INTS_EGC;
-	t.arg1 = scm_make_cont();
-	EGC_ROOT(t.arg1);
-	x = setjump(CONT(t.arg1)->jmpbuf);
+	arg1 = scm_make_cont();
+	EGC_ROOT(arg1);
+	x = setjump(CONT(arg1)->jmpbuf);
 	if (x) {
 #ifdef SHORT_INT
 	  x = (SCM)thrown_value;
@@ -2484,22 +2515,22 @@ evap1:
 	goto evap1;
       case tc16_eval:
 	ENV_MAY_PUSH(envpp);
-	TRACE(t.arg1);
+	TRACE(arg1);
 	STATIC_ENV = eval_env;
 	scm_env = EOL;
-	x = t.arg1;
+	x = arg1;
 	if (IMP(x)) goto retx;
 	goto loop;
 #ifdef CCLO
       case tc16_cclo:
 	arg2 = UNDEFINED;
 	goto cclon;
-	/* arg2 = t.arg1;
-	   t.arg1 = proc;
+	/* arg2 = arg1;
+	   arg1 = proc;
 	   proc = CCLO_SUBR(proc);
 	   goto evap2; */
 #endif
-      case tc16_values: return t.arg1;
+      case tc16_values: return arg1;
       }
     case tc7_subr_2:
     case tc7_subr_0:
@@ -2524,25 +2555,25 @@ evap1:
       switch TYP7(proc) {
       case tc7_subr_2:
       case tc7_subr_2o:
-	return SUBRF(proc)(t.arg1, arg2);
+	return SUBRF(proc)(arg1, arg2);
       case tc7_lsubr:
-	return SUBRF(proc)(cons2(t.arg1, arg2, EOL));
+	return SUBRF(proc)(cons2(arg1, arg2, EOL));
       case tc7_lsubr_2:
-	return SUBRF(proc)(t.arg1, arg2, EOL);
+	return SUBRF(proc)(arg1, arg2, EOL);
       case tc7_rpsubr:
       case tc7_asubr:
-	return SUBRF(proc)(t.arg1, arg2);
+	return SUBRF(proc)(arg1, arg2);
       case tc7_specfun:
 	switch TYP16(proc) {
 	case tc16_apply:
-	  proc = t.arg1;
+	  proc = arg1;
 	  ASRTGO(NIMP(proc), badfun);
 	  if NULLP(arg2) goto evap0;
 	  if (IMP(arg2) || NCONSP(arg2)) {
 	    x = arg2;
 	  badlst: wta(x, (char *)ARGn, s_apply);
 	  }
-	  t.arg1 = CAR(arg2);
+	  arg1 = CAR(arg2);
 	  x = CDR(arg2);
 	apply3:
 	  if NULLP(x) goto evap1;
@@ -2562,25 +2593,25 @@ evap1:
 #ifdef CCLO
 	case tc16_cclo: cclon:
 	  arg3 = arg2;
-	  arg2 = t.arg1;
-	  t.arg1 = proc;
+	  arg2 = arg1;
+	  arg1 = proc;
 	  proc = CCLO_SUBR(proc);
 	  if (UNBNDP(arg3)) goto evap2;
 	  goto evap3;
 	  /* return apply(CCLO_SUBR(proc),
-		       cons2(proc, t.arg1, cons(arg2, x)), EOL); */
+		       cons2(proc, arg1, cons(arg2, x)), EOL); */
 #endif
 	case tc16_values:
-	  return scm_values(t.arg1, arg2, EOL, s_values);
+	  return scm_values(arg1, arg2, EOL, s_values);
 	case tc16_call_wv:
 	  ENV_MAY_PUSH(envpp);
 	  scm_env_tmp = IM_VALUES_TOKEN; /* Magic value recognized by VALUES */
-	  t.arg1 = apply(t.arg1, EOL, EOL);
+	  arg1 = apply(arg1, EOL, EOL);
 	  proc = arg2;
 	  DEFER_INTS_EGC;
 	  if (IM_VALUES_TOKEN==scm_env_tmp) {
 	    scm_env_tmp = EOL;
-	    if (UNBNDP(t.arg1)) goto evap0;
+	    if (UNBNDP(arg1)) goto evap0;
 	    goto evap1;
 	  }
 	  arg2 = CAR(scm_env_tmp);
@@ -2604,14 +2635,14 @@ evap1:
 #endif
 	switch ARGC(proc) {
 	case 2:
-	  scm_env_cons2(t.arg1, arg2, EOL);
+	  scm_env_cons2(arg1, arg2, EOL);
 	  goto clo_unchecked;
 	case 1:
-	  scm_env_cons(t.arg1, cons(arg2, EOL));
+	  scm_env_cons(arg1, cons(arg2, EOL));
 	  goto clo_checked;
 	case 0:
 	case 3:		/* Error, will be caught at clo_checked: */
-	  scm_env_tmp = cons2(t.arg1, arg2, EOL);
+	  scm_env_tmp = cons2(arg1, arg2, EOL);
 	  goto clo_checked;
 	}
       }
@@ -2623,7 +2654,7 @@ evap1:
 	if (CLOSUREP(proc) && 3==ARGC(proc)) {
 	  ALLOW_INTS_EGC;
 	  ENV_MAY_PUSH(envpp);
-	  if (ecache_eval_args(proc, t.arg1, arg2, arg3, x))
+	  if (ecache_eval_args(proc, arg1, arg2, arg3, x))
 	    goto clo_unchecked;
 	  goto umwrongnumargs;
 	}
@@ -2636,15 +2667,15 @@ evap1:
       switch TYP7(proc) {
       case tc7_subr_3:
 	ASRTGO(NULLP(x), wrongnumargs);
-	return SUBRF(proc)(t.arg1, arg2, arg3);
+	return SUBRF(proc)(arg1, arg2, arg3);
       case tc7_asubr:
       case tc7_rpsubr:
-	return asubr_apply(proc, t.arg1, arg2, arg3, x);
-	/* return apply(proc, cons2(t.arg1, arg2, cons(arg3, x)), EOL); */
+	return asubr_apply(proc, arg1, arg2, arg3, x);
+	/* return apply(proc, cons2(arg1, arg2, cons(arg3, x)), EOL); */
       case tc7_lsubr_2:
-	return SUBRF(proc)(t.arg1, arg2, cons(arg3, x));
+	return SUBRF(proc)(arg1, arg2, cons(arg3, x));
       case tc7_lsubr:
-	return SUBRF(proc)(cons2(t.arg1, arg2, cons(arg3, x)));
+	return SUBRF(proc)(cons2(arg1, arg2, cons(arg3, x)));
       case tcs_closures:
 	ENV_MAY_PUSH(envpp);
 #ifdef SCM_PROFILE
@@ -2652,24 +2683,24 @@ evap1:
 #endif
 	switch ARGC(proc) {
 	case 3:
-	  scm_env_cons3(t.arg1, arg2, arg3, x);
+	  scm_env_cons3(arg1, arg2, arg3, x);
 	  goto clo_checked;
 	case 2:
-	  scm_env_cons2(t.arg1, arg2, cons(arg3, x));
+	  scm_env_cons2(arg1, arg2, cons(arg3, x));
 	  goto clo_checked;
 	case 1:
-	  scm_env_cons(t.arg1, cons2(arg2, arg3, x));
+	  scm_env_cons(arg1, cons2(arg2, arg3, x));
 	  goto clo_checked;
 	case 0:
-	  scm_env_tmp = cons2(t.arg1, arg2, cons(arg3, x));
+	  scm_env_tmp = cons2(arg1, arg2, cons(arg3, x));
 	  goto clo_checked;
 	}
       case tc7_specfun:
 	switch TYP16(proc) {
 	case tc16_apply:
-	  proc = t.arg1;
+	  proc = arg1;
 	  ASRTGO(NIMP(proc), badfun);
-	  t.arg1 = arg2;
+	  arg1 = arg2;
 	  if IMP(x) {
 	    x = arg3;
 	    goto apply3;
@@ -2688,7 +2719,7 @@ evap1:
 	  goto cclon;
 #endif
 	case tc16_values:
-	  return scm_values(t.arg1, arg2, cons(arg3, x), s_values);
+	  return scm_values(arg1, arg2, cons(arg3, x), s_values);
 	}
       case tc7_subr_2:
       case tc7_subr_1o:
@@ -2703,6 +2734,7 @@ evap1:
       }
     }
   }
+#undef arg1
 }
 
 SCM procedurep(obj)
@@ -2723,7 +2755,7 @@ SCM l_proc_doc(proc)
      SCM proc;
 {
   SCM env;
-  ASSERT(BOOL_T==procedurep(proc) && NIMP(proc) && TYP7(proc) != tc7_contin,
+  ASRTER(BOOL_T==procedurep(proc) && NIMP(proc) && TYP7(proc) != tc7_contin,
 	 proc, ARG1, s_proc_doc);
   switch TYP7(proc) {
   case tcs_closures:
@@ -2747,11 +2779,11 @@ SCM nconc2copy(lst)
 {
   SCM last, *lloc = &lst;
 #ifdef CAUTIOUS
-  ASSERT(ilength(lst) >= 1, lst, WNA, s_apply);
+  ASRTER(ilength(lst) >= 1, lst, WNA, s_apply);
 #endif
   while NNULLP(CDR(*lloc)) lloc = &CDR(*lloc);
 #ifdef CAUTIOUS
-  ASSERT(ilength(CAR(*lloc)) >= 0, lst, ARGn, s_apply);
+  ASRTER(ilength(CAR(*lloc)) >= 0, lst, ARGn, s_apply);
 #endif
   last = CAR(*lloc);
   *lloc = EOL;
@@ -2846,7 +2878,7 @@ SCM apply(proc, arg1, args)
       args = arg1;
 #endif
       while (op) {
-	ASSERT(NIMP(arg1) && CONSP(arg1),
+	ASRTER(NIMP(arg1) && CONSP(arg1),
 	       args, ARG1, SNAME(proc));
 	arg1 = (1 & op ? CAR(arg1) : CDR(arg1));
 	op >>= 2;
@@ -2865,7 +2897,7 @@ SCM apply(proc, arg1, args)
   case tc7_asubr:
     if NULLP(args) return SUBRF(proc)(arg1, UNDEFINED);
     while NIMP(args) {
-      ASSERT(CONSP(args), args, ARG2, s_apply);
+      ASRTER(CONSP(args), args, ARG2, s_apply);
       arg1 = SUBRF(proc)(arg1, CAR(args));
       args = CDR(args);
     }
@@ -2873,7 +2905,7 @@ SCM apply(proc, arg1, args)
   case tc7_rpsubr:
     if NULLP(args) return BOOL_T;
     while NIMP(args) {
-      ASSERT(CONSP(args), args, ARG2, s_apply);
+      ASRTER(CONSP(args), args, ARG2, s_apply);
       if FALSEP(SUBRF(proc)(arg1, CAR(args))) return BOOL_F;
       arg1 = CAR(args);
       args = CDR(args);
@@ -2948,7 +2980,7 @@ SCM scm_cvapply(proc, n, argv)
       int op = CXR_OP(proc);
       res = argv[0];
       while (op) {
-	ASSERT(NIMP(res) && CONSP(res),
+	ASRTER(NIMP(res) && CONSP(res),
 	       argv[0], ARG1, SNAME(proc));
 	res = (1 & op ? CAR(res) : CDR(res));
 	op >>= 2;
@@ -3024,7 +3056,7 @@ SCM map(proc, arg1, args)
 #ifndef RECKLESS
   scm_arity_check(proc, n, s_map);
 #endif
-  ASSERT(NIMP(arg1), arg1, ARG2, s_map);
+  ASRTER(NIMP(arg1), arg1, ARG2, s_map);
 #ifdef CCLO
   if (tc16_cclo==TYP16(proc)) {
     args = cons(arg1, args);
@@ -3040,10 +3072,10 @@ SCM map(proc, arg1, args)
     ave = &(ve[n]);
   }
   ve[0] = arg1;
-  ASSERT(NIMP(ve[0]), arg1, ARG2, s_map);
+  ASRTER(NIMP(ve[0]), arg1, ARG2, s_map);
   for (i = 1; i < n; i++) {
     ve[i] = CAR(args);
-    ASSERT(NIMP(ve[i]), ve[i], ARGn, s_map);
+    ASRTER(NIMP(ve[i]), ve[i], ARGn, s_map);
     args = CDR(args);
   }
   while (1) {
@@ -3053,7 +3085,7 @@ SCM map(proc, arg1, args)
 	/* We could check for lists the same length here. */
 	return res;
       }
-      ASSERT(CONSP(ve[i]), ve[i], 0==i ? ARG2 : ARGn, s_map);
+      ASRTER(CONSP(ve[i]), ve[i], 0==i ? ARG2 : ARGn, s_map);
       ave[i] = CAR(ve[i]);
       ve[i] = CDR(ve[i]);
     }
@@ -3070,9 +3102,9 @@ SCM for_each(proc, arg1, args)
   scm_protect_temp(&heap_ve);  /* Keep heap_ve from being optimized away. */
   if NULLP(arg1) return UNSPECIFIED;
 #ifndef RECKLESS
-  scm_arity_check(proc, n, s_map);
+  scm_arity_check(proc, n, s_for_each);
 #endif
-  ASSERT(NIMP(arg1), arg1, ARG2, s_for_each);
+  ASRTER(NIMP(arg1), arg1, ARG2, s_for_each);
 #ifdef CCLO
   if (tc16_cclo==TYP16(proc)) {
     args = cons(arg1, args);
@@ -3088,10 +3120,10 @@ SCM for_each(proc, arg1, args)
     ave = &(ve[n]);
   }
   ve[0] = arg1;
-  ASSERT(NIMP(ve[0]), arg1, ARG2, s_for_each);
+  ASRTER(NIMP(ve[0]), arg1, ARG2, s_for_each);
   for (i = 1; i < n; i++) {
     ve[i] = CAR(args);
-    ASSERT(NIMP(ve[i]), args, ARGn, s_for_each);
+    ASRTER(NIMP(ve[i]), args, ARGn, s_for_each);
     args = CDR(args);
   }
   while (1) {
@@ -3100,7 +3132,7 @@ SCM for_each(proc, arg1, args)
       if IMP(ve[i]) {
 	return UNSPECIFIED;
       }
-      ASSERT(CONSP(ve[i]), ve[i], 0==i ? ARG2 : ARGn, s_for_each);
+      ASRTER(CONSP(ve[i]), ve[i], 0==i ? ARG2 : ARGn, s_for_each);
       ave[i] = CAR(ve[i]);
       ve[i] = CDR(ve[i]);
     }
@@ -3158,7 +3190,7 @@ static SCM makro(code, flags, what)
      char *what;
 {
   register SCM z;
-  ASSERT(scm_arity_check(code, (MAC_PRIMITIVE & flags ? 3L : 2L),
+  ASRTER(scm_arity_check(code, (MAC_PRIMITIVE & flags ? 3L : 2L),
 			 (char *)0), code, ARG1, what);
   NEWCELL(z);
   CDR(z) = code;
@@ -3193,7 +3225,7 @@ SCM makidmacro(code)
 /* Functions for  smart expansion */
 
 /* @MACROEXPAND1 returns:
-   #F if its argument is not a macro invocation,
+   '#F' if its argument is not a macro invocation,
    the argument if the argument is a primitive syntax invocation,
    the result of expansion if the argument is a macro invocation
    (BEGIN #F) will be returned instead of #F if #F is the result.
@@ -3394,7 +3426,7 @@ SCM ident2sym(id)
      SCM id;
 {
   id = id2sym(id);
-  ASSERT(NIMP(id) && SYMBOLP(id), id, ARG1, s_ident2sym);
+  ASRTER(NIMP(id) && SYMBOLP(id), id, ARG1, s_ident2sym);
   return id;
 }
 
@@ -3403,18 +3435,18 @@ SCM renamed_ident(id, env)
      SCM id, env;
 {
   SCM z;
-  ASSERT(NIMP(id) && IDENTP(id), id, ARG1, s_renamed_ident);
+  ASRTER(NIMP(id) && IDENTP(id), id, ARG1, s_renamed_ident);
   NEWCELL(z);
   while (NIMP(env)) {
     if (INUMP(CAR(env))) {
-      ASSERT(NIMP(CDR(env)), env, s_badenv, s_renamed_ident);
+      ASRTER(NIMP(CDR(env)), env, s_badenv, s_renamed_ident);
       env = CDR(CDR(env));
     }
     else if (SCM_LINUMP(CAR(env))) {
       env = CDR(env);
     }
     else {
-      ASSERT(NULLP(env) || (NIMP(env) && CONSP(env)),
+      ASRTER(NULLP(env) || (NIMP(env) && CONSP(env)),
 	     env, s_badenv, s_renamed_ident);
       break;
     }
@@ -3587,6 +3619,12 @@ SCM make_specfun(name, typ, flags)
 }
 void init_eval()
 {
+  scm_env = EOL;
+  scm_env_tmp = UNSPECIFIED;
+#ifndef RECKLESS
+  scm_trace = BOOL_F;
+  scm_trace_env = EOL;
+#endif
   tc16_promise = newsmob(&promsmob);
   tc16_macro = newsmob(&macrosmob);
   tc16_env = newsmob(&envsmob);
@@ -3653,6 +3691,7 @@ void init_eval()
   make_synt(s_letrec_syntax, MAC_MMACRO, m_letrec_syntax);
 
   make_synt(s_the_macro, MAC_ACRO, m_the_macro);
+  add_feature("primitive-hygiene");
 #endif
 
   f_begin = CDR(CDR(KEYWORD_MACRO(sym2vcell(i_begin))));