1 files changed, 31 insertions, 22 deletions

diff --git a/eval.c b/eval.c
index 407efc4..eda526d 100644..100755
--- a/eval.c
+++ b/eval.c
@@ -116,7 +116,6 @@ SCM m_letrec P((SCM xorig, SCM env, SCM ctxt));
 SCM m_let P((SCM xorig, SCM env, SCM ctxt));
 SCM m_apply P((SCM xorig, SCM env, SCM ctxt));
 SCM m_syn_quote P((SCM xorig, SCM env, SCM ctxt));
-SCM m_define_syntax P((SCM xorig, SCM env, SCM ctxt));
 SCM m_let_syntax P((SCM xorig, SCM env, SCM ctxt));
 SCM m_letrec_syntax P((SCM xorig, SCM env, SCM ctxt));
 SCM m_the_macro P((SCM xorig, SCM env, SCM ctxt));
@@ -130,7 +129,7 @@ static SCM *lookupcar P((SCM vloc));
 static SCM scm_lookupval P((SCM vloc, int memo));
 static SCM asubr_apply P((SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args));
 static SCM ceval_1 P((SCM x));
-static SCM evalatomcar P((SCM x, int toplevelp));
+static SCM evalatomcar P((SCM x, int no_error));
 static SCM evalcar P((SCM x));
 static SCM id2sym P((SCM id));
 static SCM iqq P((SCM form));
@@ -577,9 +576,9 @@ static SCM scm_lookupval(vloc, memo)
 }
 
 /* CAR(x) is known to be a cell but not a cons */
-static SCM evalatomcar(x, toplevelp)
+static SCM evalatomcar(x, no_error)
      SCM x;
-     int toplevelp;
+     int no_error;
 {
   SCM ret;
   switch TYP7(CAR(x)) {
@@ -597,7 +596,7 @@ static SCM evalatomcar(x, toplevelp)
       switch (MAC_TYPE(mac) & ~MAC_PRIMITIVE) {
       default:
 #ifdef MACRO
-	if (!toplevelp)
+	if (!no_error)
 	  everr(x, argv[1], argv[0], s_badkey, "", 0);
 #endif
 	return ret;
@@ -610,7 +609,7 @@ static SCM evalatomcar(x, toplevelp)
     return ret;
   case tc7_vector:
 #ifndef RECKLESS
-    if (2 <= verbose) scm_warn("unquoted ", s_vector, CAR(x));
+    if (2 <= scm_verbose) scm_warn("unquoted ", s_vector, CAR(x));
 #endif
     ret = cons2(IM_QUOTE, CAR(x), EOL);
     CAR(x) = ret;
@@ -1490,14 +1489,14 @@ static void checked_define(name, val, what)
     if ('@'==CHARS(name)[0] && UNDEFINED != old)
       scm_warn(s_redefining, "internal name ", name);
     if (KEYWORDP(old)) {
-      if (1 <= verbose && built_inp(name, KEYWORD_MACRO(old)))
+      if (1 <= scm_verbose && built_inp(name, KEYWORD_MACRO(old)))
 	scm_warn(s_redefining, s_built_in_syntax, name);
-      else if (3 <= verbose)
+      else if (3 <= scm_verbose)
 	scm_warn(s_redefining, s_syntax, name);
     }
-    else if (2 <= verbose && built_inp(name, old) && (old != val))
+    else if (2 <= scm_verbose && built_inp(name, old) && (old != val))
       scm_warn(s_redefining, "built-in ", name);
-    else if (5 <= verbose && UNDEFINED != old)
+    else if (5 <= scm_verbose && UNDEFINED != old)
       scm_warn(s_redefining, "", name);
 #endif
     CDR(vcell) = val;
@@ -1657,7 +1656,9 @@ static SCM m_body(xorig, env, ctxt)
   }
   ASSYNT(ilength(x) > 0, xorig, s_body, what);
   if (IMP(defs)) return x;
-  return cons(m_letrec1(IM_DEFINE, cons2(i_define, defs, x), env, ctxt), EOL);
+  return
+    cons(m_letrec1(IM_DEFINE, cons2(i_define, reverse(defs), x), env, ctxt),
+	 EOL);
 }
 
 static SCM m_binding(name, value, env, ctxt)
@@ -1746,18 +1747,19 @@ static SCM macroexp1(xorig, env, ctxt, mode)
   MACROEXP_TRACE(xorig, env);
 #endif
   x = scm_check_linum(xorig, &linum);
-  if (IMP(x) || NCONSP(x)) {	/* Happens for unquoted vectors. */
+  if (IMP(x) || VECTORP(x)) {	/* Happens for unquoted vectors. */
     if (NIMP(x))
       x = evalatomcar(cons(x, EOL), 0);
     x = cons2(IM_QUOTE, x, EOL);
     goto retx;
   }
-  else if (IDENTP(x)) {		/* Happens for @macroexpand1 */
+  else if (IDENTP(x)) {         /* Happens for @macroexpand1 */
+    ASRTER(0==mode, x, "macroexp1", "internal error");
     proc = x;
-    x = cons(proc, EOL);
   }
-  else
+  else {
     proc = CAR(x);
+  }
   ASRTGO(NIMP(proc), errout);
   if (CONSP(proc)) {
     if (mode < 3) {
@@ -2071,7 +2073,7 @@ SCM scm_apply_cxr(proc, arg1)
     }
 # ifdef BIGDIG
     if (BIGP(arg1)) {
-      y = DSUBRF(proc)(big2dbl(arg1));
+      y = DSUBRF(proc)(int2dbl(arg1));
       goto ret;
     }
 # endif
@@ -2685,13 +2687,13 @@ evap1:
 	  goto apply4;   /* Jumping to apply code results in extra list copy
 			    for >=3 args, but we want to minimize bloat. */
 	}
+      case tc7_contin:
+	scm_dynthrow(proc, arg1, arg2, EOL);
       case tc7_subr_0:
       case tc7_cxr:
       case tc7_subr_1o:
       case tc7_subr_1:
       case tc7_subr_3:
-      case tc7_contin:
-	scm_dynthrow(proc, arg1, arg2, EOL);
 	goto wrongnumargs;
       default:
 	goto badfun;
@@ -3252,14 +3254,21 @@ static char s_macroexpand1[] = "@macroexpand1";
 SCM scm_macroexpand1(x, env)
      SCM x, env;
 {
-  SCM name;
+  SCM proc;
   if (IMP(x)) return BOOL_F;
   if (CONSP(x)) {
-    name = CAR(x);
-    if (IMP(name) || !IDENTP(name)) return BOOL_F; /* probably an error */
+    proc = CAR(x);
+    if (IMP(proc) || !IDENTP(proc)) return BOOL_F; /* probably an error */
   }
   else if (IDENTP(x)) {
-    name = x;
+    proc = scm_env_lookup(x, env);
+    if (IMP(proc))		/* local binding */
+      return BOOL_F;
+    if (SYMBOLP(proc)) {   /* global variable */
+      proc = CDR(sym2vcell(proc));
+      if (!KEYWORDP(proc))
+        return BOOL_F;
+    }
   }
   else
     return BOOL_F;