From c2d1a0c2d2d09d889f8aa33eceffe0baa39e5378 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Tue, 29 Apr 2025 13:39:53 +0200
Subject: [PATCH] ecl_interpreter: abstract away all lcl accessors

We are going to change the representation of the local environment, but first we
make identify accessors and put them behind macros.

While doing so the OP_LABELS has been changed to look similar to OP_FLET. Among
other things we cons separately functions into fun_env, but this inefficiency
will be removed later when we address local entries from the frame.base.
---
 src/c/interpreter.d | 98 +++++++++++++++++++++++++++------------------
 1 file changed, 59 insertions(+), 39 deletions(-)

diff --git a/src/c/interpreter.d b/src/c/interpreter.d
index cb2074e78..52b1fbef0 100644
--- a/src/c/interpreter.d
+++ b/src/c/interpreter.d
@@ -121,9 +121,34 @@ VEclose_around_arg_type()
  *      sym_macro = ( si::symbol-macro macro_function[bytecodes] . macro_name )
  */
 
-#define bind_var(env, var, val)   CONS(CONS(var, val), (env))
-#define bind_function(env, fun)   CONS(fun, (env))
-#define bind_frame(env, id, name) CONS(CONS(id, name), (env))
+#define bind_lcl(env, entry)   push_lcl(&env, entry)
+#define tack_lcl(env, entries) foot_lcl(&env, entries)
+
+#define bind_var(env, var, val)   bind_lcl(env, CONS(var, val))
+#define bind_function(env, fun)   bind_lcl(env, fun)
+#define bind_frame(env, id, name) bind_lcl(env, CONS(id, name))
+
+#define unbind_lcl(env, n) drop_lcl(&env, n)
+#define tangle_lcl(stack) (stack)
+#define unwind_lcl(stack, where) (stack = where)
+
+static void
+push_lcl(cl_object *stack, cl_object new)
+{
+  *stack = ecl_cons(new, *stack);
+}
+
+static void
+foot_lcl(cl_object *stack, cl_object list)
+{
+  *stack = ecl_append(list, *stack);
+}
+
+static void
+drop_lcl(cl_object *stack, cl_fixnum n)
+{
+  while (n--) *stack = ECL_CONS_CDR(*stack);
+}
 
 static cl_object
 ecl_lcl_env_get_record(cl_object env, int s)
@@ -697,10 +722,10 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
       for(idx = 0; idx<nfun; idx++) {
         GET_DATA(fun, vector, data);
         fun = ecl_close_around(fun, lcl_env, lex_env);
-        fun_env = bind_function(fun_env, fun);
+        fun_env = CONS(fun, fun_env);
       }
       /* Update the environment with new functions. */
-      lcl_env = ecl_append(fun_env, lcl_env);
+      tack_lcl(lcl_env, fun_env);
       THREAD_NEXT;
     }
     /* OP_LABELS    nfun{arg}
@@ -714,26 +739,22 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
        the functions "fun1" ... "funn".
     */
     CASE(OP_LABELS); {
-      cl_index nfun;
+      cl_index idx, nfun;
+      cl_object fun_env=ECL_NIL, fun;
       GET_OPARG(nfun, vector);
-      /* Build up a new environment with all functions */
-      {
-        cl_index i = nfun;
-        do {
-          cl_object f;
-          GET_DATA(f, vector, data);
-          f = close_around_self(f);
-          lcl_env = bind_function(lcl_env, f);
-        } while (--i);
+      /* Create closures. */
+      for(idx = 0; idx<nfun; idx++) {
+        GET_DATA(fun, vector, data);
+        fun = close_around_self(fun);
+        fun_env = CONS(fun, fun_env);
       }
+      /* Update the environment with new functions. */
+      tack_lcl(lcl_env, fun_env);
       /* Update the closures so that all functions can call each other */
-      {
-        cl_object l = lcl_env;
-        do {
-          close_around_self_fixup(ECL_CONS_CAR(l), lcl_env, lex_env);
-          l = ECL_CONS_CDR(l);
-        } while (--nfun);
-      }
+      loop_for_on_unsafe(fun_env) {
+        fun = ECL_CONS_CAR(fun_env);
+        close_around_self_fixup(fun, lcl_env, lex_env);
+      } end_loop_for_on_unsafe(fun_env);
       THREAD_NEXT;
     }
     /* OP_LFUNCTION index{fixnum} ; local
@@ -902,8 +923,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
     CASE(OP_UNBIND); {
       cl_oparg n;
       GET_OPARG(n, vector);
-      while (n--)
-        lcl_env = ECL_CONS_CDR(lcl_env);
+      unbind_lcl(lcl_env, n);
       THREAD_NEXT;
     }
     /* OP_UNBINDS   n{arg}
@@ -928,13 +948,13 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
     CASE(OP_BIND); {
       cl_object var_name;
       GET_DATA(var_name, vector, data);
-      lcl_env = bind_var(lcl_env, var_name, reg0);
+      bind_var(lcl_env, var_name, reg0);
       THREAD_NEXT;
     }
     CASE(OP_PBIND); {
       cl_object var_name;
       GET_DATA(var_name, vector, data);
-      lcl_env = bind_var(lcl_env, var_name, ECL_STACK_POP_UNSAFE(the_env));
+      bind_var(lcl_env, var_name, ECL_STACK_POP_UNSAFE(the_env));
       THREAD_NEXT;
     }
     CASE(OP_VBIND); {
@@ -942,8 +962,8 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
       cl_object var_name;
       GET_OPARG(n, vector);
       GET_DATA(var_name, vector, data);
-      lcl_env = bind_var(lcl_env, var_name,
-                         (n < the_env->nvalues) ? the_env->values[n] : ECL_NIL);
+      bind_var(lcl_env, var_name,
+               (n < the_env->nvalues) ? the_env->values[n] : ECL_NIL);
       THREAD_NEXT;
     }
     CASE(OP_BINDS); {
@@ -1070,24 +1090,24 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
     CASE(OP_BLOCK); {
       GET_DATA(reg0, vector, data);
       reg1 = ecl_make_fixnum(the_env->frame_id++);
-      lcl_env = bind_frame(lcl_env, reg1, reg0);
+      bind_frame(lcl_env, reg1, reg0);
       THREAD_NEXT;
     }
     CASE(OP_DO); {
       reg0 = ECL_NIL;
       reg1 = ecl_make_fixnum(the_env->frame_id++);
-      lcl_env = bind_frame(lcl_env, reg1, reg0);
+      bind_frame(lcl_env, reg1, reg0);
       THREAD_NEXT;
     }
     CASE(OP_CATCH); {
       reg1 = reg0;
-      lcl_env = bind_frame(lcl_env, reg1, reg0);
+      bind_frame(lcl_env, reg1, reg0);
       THREAD_NEXT;
     }
     CASE(OP_FRAME); {
       cl_opcode *exit;
       GET_LABEL(exit, vector);
-      ECL_STACK_PUSH(the_env, lcl_env);
+      ECL_STACK_PUSH(the_env, tangle_lcl(lcl_env));
       ECL_STACK_PUSH(the_env, (cl_object)exit);
       ecl_frs_push(the_env,reg1);
       if (__ecl_frs_push_result == 0) {
@@ -1095,7 +1115,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
       } else {
         reg0 = the_env->values[0];
         vector = (cl_opcode *)ECL_STACK_REF(the_env,-1); /* FIXME! */
-        lcl_env = ECL_STACK_REF(the_env,-2);
+        unwind_lcl(lcl_env, ECL_STACK_REF(the_env, -2));
         goto DO_EXIT_FRAME;
       }
     }
@@ -1115,7 +1135,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
     CASE(OP_TAGBODY); {
       int n;
       GET_OPARG(n, vector);
-      ECL_STACK_PUSH(the_env, lcl_env);
+      ECL_STACK_PUSH(the_env, tangle_lcl(lcl_env));
       ECL_STACK_PUSH(the_env, (cl_object)vector); /* FIXME! */
       vector += n * OPARG_SIZE;
       ecl_frs_push(the_env,reg1);
@@ -1124,7 +1144,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
            ranges from 0 to ntags-1, depending on the tag. These numbers are
            indices into the jump table and are computed at compile time. */
         cl_opcode *table = (cl_opcode *)ECL_STACK_REF(the_env,-1);
-        lcl_env = ECL_STACK_REF(the_env,-2);
+        unwind_lcl(lcl_env, ECL_STACK_REF(the_env,-2));
         table = table + ecl_fixnum(the_env->values[0]) * OPARG_SIZE;
         vector = table + *(cl_oparg *)table;
       }
@@ -1137,7 +1157,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
     DO_EXIT_FRAME:
       ecl_frs_pop(the_env);
       ECL_STACK_POP_N_UNSAFE(the_env, 2);
-      lcl_env = ECL_CONS_CDR(lcl_env);
+      unbind_lcl(lcl_env, 1);
       THREAD_NEXT;
     }
     CASE(OP_NIL); {
@@ -1241,13 +1261,13 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
     CASE(OP_PROTECT); {
       cl_opcode *exit;
       GET_LABEL(exit, vector);
-      ECL_STACK_PUSH(the_env, lcl_env);
+      ECL_STACK_PUSH(the_env, tangle_lcl(lcl_env));
       ECL_STACK_PUSH(the_env, (cl_object)exit);
       ecl_frs_push(the_env,ECL_PROTECT_TAG);
       if (__ecl_frs_push_result != 0) {
         ecl_frs_pop(the_env);
         vector = (cl_opcode *)ECL_STACK_POP_UNSAFE(the_env);
-        lcl_env = ECL_STACK_POP_UNSAFE(the_env);
+        unwind_lcl(lcl_env, ECL_STACK_POP_UNSAFE(the_env));
         reg0 = the_env->values[0];
         ECL_STACK_PUSH(the_env, ecl_make_fixnum(the_env->nlj_fr - the_env->frs_top));
         goto PUSH_VALUES;
@@ -1258,7 +1278,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
       ecl_bds_unwind(the_env, the_env->frs_top->frs_bds_top_index);
       ecl_frs_pop(the_env);
       (void)ECL_STACK_POP_UNSAFE(the_env);
-      lcl_env = ECL_STACK_POP_UNSAFE(the_env);
+      unwind_lcl(lcl_env, ECL_STACK_POP_UNSAFE(the_env));
       ECL_STACK_PUSH(the_env, ecl_make_fixnum(1));
       goto PUSH_VALUES;
     }