The struct data is now an array of scm_bits_t variables.

[bpt/guile.git] / libguile / eval.c

diff --git a/libguile/eval.c b/libguile/eval.c
index f256285..c17e478 100644 (file)
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -93,8 +93,12 @@ char *alloca ();
 #include "srcprop.h"
 #include "stackchk.h"
 #include "objects.h"
+#include "async.h"
 #include "feature.h"
 #include "modules.h"
+#include "ports.h"
+#include "root.h"
+#include "vectors.h"
 
 #include "validate.h"
 #include "eval.h"
@@ -274,18 +278,18 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
 #endif
   for (; SCM_NIMP (env); env = SCM_CDR (env))
     {
-      if (SCM_BOOL_T == scm_procedure_p (SCM_CAR (env)))
+      if (SCM_TRUE_P (scm_procedure_p (SCM_CAR (env))))
        break;
       al = SCM_CARLOC (env);
       for (fl = SCM_CAR (*al); SCM_NIMP (fl); fl = SCM_CDR (fl))
        {
          if (SCM_NCONSP (fl))
            {
-             if (fl == var)
+             if (SCM_EQ_P (fl, var))
              {
 #ifdef MEMOIZE_LOCALS
 #ifdef USE_THREADS
-               if (SCM_CAR (vloc) != var)
+               if (! SCM_EQ_P (SCM_CAR (vloc), var))
                  goto race;
 #endif
                SCM_SETCAR (vloc, iloc + SCM_ICDR);
@@ -296,7 +300,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
                break;
            }
          al = SCM_CDRLOC (*al);
-         if (SCM_CAR (fl) == var)
+         if (SCM_EQ_P (SCM_CAR (fl), var))
            {
 #ifdef MEMOIZE_LOCALS
 #ifndef SCM_RECKLESS           /* letrec inits to SCM_UNDEFINED */
@@ -332,7 +336,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
     else
       top_thunk = SCM_BOOL_F;
     vcell = scm_sym2vcell (var, top_thunk, SCM_BOOL_F);
-    if (vcell == SCM_BOOL_F)
+    if (SCM_FALSEP (vcell))
       goto errout;
     else
       var = vcell;
@@ -410,7 +414,7 @@ scm_unmemocar (SCM form, SCM env)
     return form;
   c = SCM_CAR (form);
   if (1 == (SCM_UNPACK (c) & 7))
-    SCM_SETCAR (form, SCM_CAR (c - 1));
+    SCM_SETCAR (form, SCM_GLOC_SYM (c));
 #ifdef MEMOIZE_LOCALS
 #ifdef DEBUG_EXTENSIONS
   else if (SCM_ILOCP (c))
@@ -634,7 +638,7 @@ scm_m_case (SCM xorig, SCM env)
       proc = SCM_CAR (x);
       SCM_ASSYNT (scm_ilength (proc) >= 2, xorig, scm_s_clauses, s_case);
       SCM_ASSYNT (scm_ilength (SCM_CAR (proc)) >= 0
-                 || scm_sym_else == SCM_CAR (proc),
+                 || SCM_EQ_P (scm_sym_else, SCM_CAR (proc)),
                  xorig, scm_s_clauses, s_case);
     }
   return scm_cons (SCM_IM_CASE, cdrx);
@@ -656,13 +660,13 @@ scm_m_cond (SCM xorig, SCM env)
       arg1 = SCM_CAR (x);
       len = scm_ilength (arg1);
       SCM_ASSYNT (len >= 1, xorig, scm_s_clauses, s_cond);
-      if (scm_sym_else == SCM_CAR (arg1))
+      if (SCM_EQ_P (scm_sym_else, SCM_CAR (arg1)))
        {
          SCM_ASSYNT (SCM_NULLP (SCM_CDR (x)) && len >= 2,
                      xorig, "bad ELSE clause", s_cond);
          SCM_SETCAR (arg1, SCM_BOOL_T);
        }
-      if (len >= 2 && scm_sym_arrow == SCM_CAR (SCM_CDR (arg1)))
+      if (len >= 2 && SCM_EQ_P (scm_sym_arrow, SCM_CAR (SCM_CDR (arg1))))
        SCM_ASSYNT (3 == len && SCM_NIMP (SCM_CAR (SCM_CDR (SCM_CDR (arg1)))),
                    xorig, "bad recipient", s_cond);
       x = SCM_CDR (x);
@@ -682,7 +686,7 @@ scm_m_lambda (SCM xorig, SCM env)
   proc = SCM_CAR (x);
   if (SCM_NULLP (proc))
     goto memlambda;
-  if (SCM_IM_LET == proc)  /* named let */
+  if (SCM_EQ_P (SCM_IM_LET, proc))  /* named let */
     goto memlambda;
   if (SCM_IMP (proc))
     goto badforms;
@@ -831,12 +835,12 @@ iqq (SCM form,SCM env,int depth)
   if (SCM_NCONSP(form)) 
     return form;
   tmp = SCM_CAR (form);
-  if (scm_sym_quasiquote == tmp)
+  if (SCM_EQ_P (scm_sym_quasiquote, tmp))
     {
       depth++;
       goto label;
     }
-  if (scm_sym_unquote == tmp)
+  if (SCM_EQ_P (scm_sym_unquote, tmp))
     {
       --depth;
     label:
@@ -847,7 +851,7 @@ iqq (SCM form,SCM env,int depth)
        return evalcar (form, env);
       return scm_cons2 (tmp, iqq (SCM_CAR (form), env, depth), SCM_EOL);
     }
-  if (SCM_NIMP (tmp) && (scm_sym_uq_splicing == SCM_CAR (tmp)))
+  if (SCM_NIMP (tmp) && (SCM_EQ_P (scm_sym_uq_splicing, SCM_CAR (tmp))))
     {
       tmp = SCM_CDR (tmp);
       if (0 == --edepth)
@@ -899,10 +903,10 @@ scm_m_define (SCM x, SCM env)
        proc:
          if (SCM_CLOSUREP (arg1)
              /* Only the first definition determines the name. */
-             && scm_procedure_property (arg1, scm_sym_name) == SCM_BOOL_F)
+             && SCM_FALSEP (scm_procedure_property (arg1, scm_sym_name)))
            scm_set_procedure_property_x (arg1, scm_sym_name, proc);
          else if (SCM_TYP16 (arg1) == scm_tc16_macro
-                  && SCM_CDR (arg1) != arg1)
+                  && !SCM_EQ_P (SCM_CDR (arg1), arg1))
            {
              arg1 = SCM_CDR (arg1);
              goto proc;
@@ -1065,8 +1069,8 @@ scm_m_cont (SCM xorig, SCM env)
 
 /* Multi-language support */
 
-SCM scm_nil;
-SCM scm_t;
+SCM scm_lisp_nil;
+SCM scm_lisp_t;
 
 SCM_SYNTAX (s_nil_cond, "nil-cond", scm_makmmacro, scm_m_nil_cond);
 
@@ -1193,7 +1197,7 @@ scm_m_expand_body (SCM xorig, SCM env)
                                            SCM_CDR (form)),
                           env);
 
-      if (SCM_IM_DEFINE == SCM_CAR (form))
+      if (SCM_EQ_P (SCM_IM_DEFINE, SCM_CAR (form)))
        {
          defs = scm_cons (SCM_CDR (form), defs);
          x = SCM_CDR(x);
@@ -1202,7 +1206,7 @@ scm_m_expand_body (SCM xorig, SCM env)
        {
          break;
        }
-      else if (SCM_IM_BEGIN == SCM_CAR (form))
+      else if (SCM_EQ_P (SCM_IM_BEGIN, SCM_CAR (form)))
        {
          x = scm_append (scm_cons2 (SCM_CDR (form), SCM_CDR (x), SCM_EOL));
        }
@@ -1344,10 +1348,10 @@ unmemocopy (SCM x, SCM env)
        z = EXTEND_ENV (f, SCM_EOL, env);
        /* inits */
        e = scm_reverse (unmemocopy (SCM_CAR (x),
-                                    SCM_CAR (ls) == scm_sym_letrec ? z : env));
+                                    SCM_EQ_P (SCM_CAR (ls), scm_sym_letrec) ? z : env));
        env = z;
        /* increments */
-       s = SCM_CAR (ls) == scm_sym_do
+       s = SCM_EQ_P (SCM_CAR (ls), scm_sym_do)
            ? scm_reverse (unmemocopy (SCM_CDR (SCM_CDR (SCM_CDR (x))), env))
            : f;
        /* build transformed binding list */
@@ -1356,7 +1360,7 @@ unmemocopy (SCM x, SCM env)
          {
            z = scm_acons (SCM_CAR (v),
                           scm_cons (SCM_CAR (e),
-                                    SCM_CAR (s) == SCM_CAR (v)
+                                    SCM_EQ_P (SCM_CAR (s), SCM_CAR (v))
                                     ? SCM_EOL
                                     : scm_cons (SCM_CAR (s), SCM_EOL)),
                           z);
@@ -1367,7 +1371,7 @@ unmemocopy (SCM x, SCM env)
        while (SCM_NIMP (v));
        z = scm_cons (z, SCM_UNSPECIFIED);
        SCM_SETCDR (ls, z);
-       if (SCM_CAR (ls) == scm_sym_do)
+       if (SCM_EQ_P (SCM_CAR (ls), scm_sym_do))
          {
            x = SCM_CDR (x);
            /* test clause */
@@ -1973,7 +1977,7 @@ dispatch:
       while (SCM_NIMP (x = SCM_CDR (x)))
        {
          proc = SCM_CAR (x);
-         if (scm_sym_else == SCM_CAR (proc))
+         if (SCM_EQ_P (scm_sym_else, SCM_CAR (proc)))
            {
              x = SCM_CDR (proc);
              PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
@@ -2006,7 +2010,7 @@ dispatch:
                {
                  RETURN (t.arg1)
                }
-             if (scm_sym_arrow != SCM_CAR (x))
+             if (! SCM_EQ_P (scm_sym_arrow, SCM_CAR (x)))
                {
                  PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
                  goto begin;
@@ -2295,8 +2299,8 @@ dispatch:
                if (SCM_NIMP (t.arg1))
                  do
                    {
-                     i += SCM_UNPACK ((SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1))))
-                                      [scm_si_hashsets + hashset]);
+                     i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))
+                          [scm_si_hashsets + hashset];
                      t.arg1 = SCM_CDR (t.arg1);
                    }
                  while (--j && SCM_NIMP (t.arg1));
@@ -2314,7 +2318,7 @@ dispatch:
                  do
                    {
                      /* More arguments than specifiers => CLASS != ENV */
-                     if (scm_class_of (SCM_CAR (t.arg1)) != SCM_CAR (z))
+                     if (! SCM_EQ_P (scm_class_of (SCM_CAR (t.arg1)), SCM_CAR (z)))
                        goto next_method;
                      t.arg1 = SCM_CDR (t.arg1);
                      z = SCM_CDR (z);
@@ -2340,15 +2344,15 @@ dispatch:
        case (SCM_ISYMNUM (SCM_IM_SLOT_REF)):
          x = SCM_CDR (x);
          t.arg1 = EVALCAR (x, env);
-         RETURN (SCM_STRUCT_DATA (t.arg1)[SCM_INUM (SCM_CADR (x))])
+         RETURN (SCM_PACK (SCM_STRUCT_DATA (t.arg1) [SCM_INUM (SCM_CADR (x))]))
          
        case (SCM_ISYMNUM (SCM_IM_SLOT_SET_X)):
          x = SCM_CDR (x);
          t.arg1 = EVALCAR (x, env);
          x = SCM_CDR (x);
          proc = SCM_CDR (x);
-         SCM_STRUCT_DATA (t.arg1)[SCM_INUM (SCM_CAR (x))]
-           = EVALCAR (proc, env);
+         SCM_STRUCT_DATA (t.arg1) [SCM_INUM (SCM_CAR (x))]
+           = SCM_UNPACK (EVALCAR (proc, env));
          RETURN (SCM_UNSPECIFIED)
          
        case (SCM_ISYMNUM (SCM_IM_NIL_COND)):
@@ -2356,9 +2360,9 @@ dispatch:
          while (SCM_NIMP (x = SCM_CDR (proc)))
            {
              if (!(SCM_FALSEP (t.arg1 = EVALCAR (proc, env))
-                   || t.arg1 == scm_nil))
+                   || t.arg1 == scm_lisp_nil))
                {
-                 if (SCM_CAR (x) == SCM_UNSPECIFIED)
+                 if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED))
                    RETURN (t.arg1);
                  PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
                  goto carloop;
@@ -2372,12 +2376,12 @@ dispatch:
        case (SCM_ISYMNUM (SCM_IM_NIL_IFY)):
          x = SCM_CDR (x);
          RETURN ((SCM_FALSEP (proc = EVALCAR (x, env)) || SCM_NULLP (proc))
-                  ? scm_nil
+                  ? scm_lisp_nil
                   : proc)
            
        case (SCM_ISYMNUM (SCM_IM_T_IFY)):
          x = SCM_CDR (x);
-         RETURN (SCM_NFALSEP (EVALCAR (x, env)) ? scm_t : scm_nil)
+         RETURN (SCM_NFALSEP (EVALCAR (x, env)) ? scm_lisp_t : scm_lisp_nil)
            
        case (SCM_ISYMNUM (SCM_IM_0_COND)):
          proc = SCM_CDR (x);
@@ -2386,7 +2390,7 @@ dispatch:
              if (!(SCM_FALSEP (t.arg1 = EVALCAR (proc, env))
                    || t.arg1 == SCM_INUM0))
                {
-                 if (SCM_CAR (x) == SCM_UNSPECIFIED)
+                 if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED))
                    RETURN (t.arg1);
                  PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
                  goto carloop;
@@ -2417,7 +2421,8 @@ dispatch:
          while (SCM_NIMP (arg2))
            {
              proc = SCM_GLOC_VAL (SCM_CAR (t.arg1));
-             SCM_SETCDR (SCM_CAR (t.arg1) - 1L, SCM_CAR (arg2));
+             SCM_SETCDR (SCM_PACK (SCM_UNPACK (SCM_CAR (t.arg1)) - 1L),
+                         SCM_CAR (arg2));
              SCM_SETCAR (arg2, proc);
              t.arg1 = SCM_CDR (t.arg1);
              arg2 = SCM_CDR (arg2);
@@ -2437,7 +2442,8 @@ dispatch:
          arg2 = SCM_CDAR (env);
          while (SCM_NIMP (arg2))
            {
-             SCM_SETCDR (SCM_CAR (t.arg1) - 1L, SCM_CAR (arg2));
+             SCM_SETCDR (SCM_PACK (SCM_UNPACK (SCM_CAR (t.arg1)) - 1L),
+                         SCM_CAR (arg2));
              t.arg1 = SCM_CDR (t.arg1);
              arg2 = SCM_CDR (arg2);
            }
@@ -3679,7 +3685,7 @@ long scm_tc16_promise;
 SCM 
 scm_makprom (SCM code)
 {
-  SCM_RETURN_NEWSMOB (scm_tc16_promise, code);
+  SCM_RETURN_NEWSMOB (scm_tc16_promise, SCM_UNPACK (code));
 }
 
 
@@ -3863,12 +3869,12 @@ scm_init_eval ()
   scm_sym_unquote = SCM_CAR (scm_sysintern ("unquote", SCM_UNDEFINED));
   scm_sym_uq_splicing = SCM_CAR (scm_sysintern ("unquote-splicing", SCM_UNDEFINED));
 
-  scm_nil = scm_sysintern ("nil", SCM_UNDEFINED);
-  SCM_SETCDR (scm_nil, SCM_CAR (scm_nil));
-  scm_nil = SCM_CAR (scm_nil);
-  scm_t = scm_sysintern ("t", SCM_UNDEFINED);
-  SCM_SETCDR (scm_t, SCM_CAR (scm_t));
-  scm_t = SCM_CAR (scm_t);
+  scm_lisp_nil = scm_sysintern ("nil", SCM_UNDEFINED);
+  SCM_SETCDR (scm_lisp_nil, SCM_CAR (scm_lisp_nil));
+  scm_lisp_nil = SCM_CAR (scm_lisp_nil);
+  scm_lisp_t = scm_sysintern ("t", SCM_UNDEFINED);
+  SCM_SETCDR (scm_lisp_t, SCM_CAR (scm_lisp_t));
+  scm_lisp_t = SCM_CAR (scm_lisp_t);
   
   /* acros */
   /* end of acros */
@@ -3890,3 +3896,9 @@ scm_init_eval ()
 }
 
 #endif /* !DEVAL */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/