From 2e1d3365817d7322714e79e417c0b30fd253c2fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Tue, 3 Jun 2025 09:59:54 +0200
Subject: [PATCH] [bytevm][wip] new opcode CALLW, don't use lcl frame when no
 locals

CALLW calls a word from the data stack. The word differs from normal functions
in that it takes no arguments (so the call does not modify the data stack).

To allow words using the stack across calls (like in "real" forth) don't unwind
the stack on exit if there are no locals.
---
 src/c/disassembler.d |  9 ++++++++-
 src/c/interpreter.d  | 14 +++++++++++---
 src/h/bytecodes.h    |  2 ++
 3 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/src/c/disassembler.d b/src/c/disassembler.d
index e996b6b8c..b3ad2838e 100644
--- a/src/c/disassembler.d
+++ b/src/c/disassembler.d
@@ -204,12 +204,19 @@ disassemble(cl_object bytecodes, cl_opcode *vector) {
     goto OPARG;
 
     /* OP_QUOTE
-       Sets VALUES(0) to an immediate value.
+       Sets REG0 to an immediate value.
     */
   case OP_QUOTE:          string = "QUOTE\t";
     GET_DATA(o, vector, data);
     goto ARG;
 
+    /* OP_CALLW
+       Sets REG0 to a result of calling an immediate value.
+    */
+  case OP_CALLW:          string = "CALLW\t";
+    GET_DATA(o, vector, data);
+    goto ARG;
+
     /* OP_CSET      n{arg}
        Replace constant with a computed value
     */
diff --git a/src/c/interpreter.d b/src/c/interpreter.d
index 3be5192bb..82caaad8f 100644
--- a/src/c/interpreter.d
+++ b/src/c/interpreter.d
@@ -410,7 +410,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
   lcl_env = ecl_cast_ptr(cl_object, &frame_lcl);
   ecl_cs_check(the_env, ihs);
   ecl_ihs_push(the_env, &ihs, bytecodes, closure, lcl_env);
-  ecl_stack_frame_open(the_env, lcl_env, nlcl);
+  if(nlcl) ecl_stack_frame_open(the_env, lcl_env, nlcl);
   frame_aux.t = t_frame;
   frame_aux.opened = 0;
   frame_aux.base = 0;
@@ -423,13 +423,21 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
       the_env->nvalues = 0;
       THREAD_NEXT;
     }
-    /* OP_QUOTE
+    /* OP_QUOTE     n{dat}
        Sets REG0 to an immediate value.
     */
     CASE(OP_QUOTE); {
       GET_DATA(reg0, vector, data);
       THREAD_NEXT;
     }
+    /* OP_CALLW     n{dat}
+       Calls the immediate value and sets REG0 to the result.
+    */
+    CASE(OP_CALLW); {
+      GET_DATA(reg0, vector, data);
+      ecl_apply_from_stack_frame(frame, reg0);
+      THREAD_NEXT;
+    }
     /* OP_VAR       n{lcl}
        OP_VARC      n{lex}
        OP_VARS      n{dat}
@@ -747,7 +755,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
     */
     CASE(OP_EXIT); {
       ecl_ihs_pop(the_env);
-      ecl_stack_frame_close(lcl_env);
+      if(nlcl) ecl_stack_frame_close(lcl_env);
       return reg0;
     }
     /* OP_FLET      nfun{arg}, fun1{object}
diff --git a/src/h/bytecodes.h b/src/h/bytecodes.h
index 9831e1085..ff57ad3be 100644
--- a/src/h/bytecodes.h
+++ b/src/h/bytecodes.h
@@ -13,6 +13,7 @@
 enum {
   OP_NOP,
   OP_QUOTE,
+  OP_CALLW,
   OP_ENDP,
   OP_CONS,
   OP_CAR,
@@ -176,6 +177,7 @@ typedef int16_t cl_opcode;
         static const int offsets[] = {\
   &&LBL_OP_NOP - &&LBL_OP_NOP,\
   &&LBL_OP_QUOTE - &&LBL_OP_NOP,\
+  &&LBL_OP_CALLW - &&LBL_OP_NOP,\
   &&LBL_OP_ENDP - &&LBL_OP_NOP,\
   &&LBL_OP_CONS - &&LBL_OP_NOP,\
   &&LBL_OP_CAR - &&LBL_OP_NOP,\