From 7a64470851bc7c0abff002183561e5d91e502d8b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ond=C5=99ej=20Hru=C5=A1ka?= <ondra@ondrovo.com>
Date: Thu, 18 Nov 2021 23:02:25 +0100
Subject: [PATCH] fix postpone

---
 include/fh_config.h      |  4 ++--
 src/fh_mem.c             |  6 +++---
 src/fh_runtime.c         | 19 ++++++++++++++++---
 testfiles/combinedtest.f |  1 +
 testfiles/postpone2.f    |  9 +++++++++
 5 files changed, 31 insertions(+), 8 deletions(-)
 create mode 100644 testfiles/postpone2.f

diff --git a/include/fh_config.h b/include/fh_config.h
index b279c6f..b375797 100644
--- a/include/fh_config.h
+++ b/include/fh_config.h
@@ -7,8 +7,8 @@
 #ifndef FORTH_FH_CONFIG_H
 #define FORTH_FH_CONFIG_H
 
-#define DATA_STACK_DEPTH 1024
-#define RETURN_STACK_DEPTH 1024
+#define DATA_STACK_DEPTH 10
+#define RETURN_STACK_DEPTH 10
 #define MAX_NAME_LEN 32
 #define HEAP_SIZE (1024*1024)
 #define MAXLINE 65535
diff --git a/src/fh_mem.c b/src/fh_mem.c
index 66a924c..4437ad7 100644
--- a/src/fh_mem.c
+++ b/src/fh_mem.c
@@ -194,7 +194,7 @@ void fh_heap_copyptr(struct fh_thread_s *fh, uint32_t addr, char * source, uint3
 
 char *fh_str_at(struct fh_thread_s *fh, uint32_t addr) {
   if (addr >= HEAP_SIZE) {
-    LOGE("fh_str_at out of bounds!");
+    LOGE("fh_str_at out of bounds! 0x%08x", addr);
     return NULL;
   }
   return (char *) &fh->heap[addr];
@@ -202,7 +202,7 @@ char *fh_str_at(struct fh_thread_s *fh, uint32_t addr) {
 
 struct fh_instruction_s *fh_instr_at(struct fh_thread_s *fh, uint32_t addr) {
   if (addr >= HEAP_END) {
-    LOGE("fh_instr_at out of bounds!");
+    LOGE("fh_instr_at out of bounds! 0x%08x", addr);
     return NULL;
   }
   return (void *) &fh->heap[addr];
@@ -210,7 +210,7 @@ struct fh_instruction_s *fh_instr_at(struct fh_thread_s *fh, uint32_t addr) {
 
 struct fh_word_s *fh_word_at(struct fh_thread_s *fh, uint32_t addr) {
   if (addr >= HEAP_END) {
-    LOGE("fh_word_at out of bounds!");
+    LOGE("fh_word_at out of bounds! 0x%08x", addr);
     return NULL;
   }
   return (struct fh_word_s *) &fh->heap[addr];
diff --git a/src/fh_runtime.c b/src/fh_runtime.c
index c58f364..123d56f 100644
--- a/src/fh_runtime.c
+++ b/src/fh_runtime.c
@@ -133,9 +133,10 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
 
   uint32_t strl;
   uint32_t val;
-  uint32_t addr = 0;
   uint32_t limit, index, index0;
 
+  LOG("0x%08x: Instr %s, 0x%08x", fh->execptr, instr_name(instr->kind), instr->data);
+
   switch (instr->kind) {
     case FH_INSTR_NUMBER:
       TRY(ds_push(fh, instr->data));
@@ -149,8 +150,15 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
           return FH_ERR_INTERNAL;
         }
         if (w2->flags & WORDFLAG_IMMEDIATE) {
-          LOG("Call immediate postponed word: %s", w2->name);
-          TRY(w2->handler(fh, w2));
+          goto call_w2;
+//          LOG("Call immediate postponed word: %s", w2->name);
+//          if (w2->flags & WORDFLAG_BUILTIN) {
+//            TRY(rs_push(fh, fh->execptr));
+//          }
+//          TRY(w2->handler(fh, w2));
+//          if (0 == (w2->flags & WORDFLAG_BUILTIN)) {
+//            TRY(rs_pop(fh, &fh->execptr));
+//          }
         } else {
           LOG("Add postponed word: %s", w2->name);
           TRY(fh_put_instr(fh, FH_INSTR_WORD, instr->data));
@@ -167,6 +175,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
         LOGE("Instr bad word addr!");
         return FH_ERR_INTERNAL;
       }
+    call_w2:
       if (w2->flags & WORDFLAG_BUILTIN) {
         LOG("Exec: native-word \"%s\"", w2->name);
         TRY(w2->handler(fh, w2));
@@ -269,6 +278,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       LOG("after add: %d", fh->loop_i);
 
       // FIXME this is probably wrong
+      // FIXME yes it actually is wrong
       if (((int32_t)index0 < (int32_t)limit) == ((int32_t)fh->loop_i < (int32_t)limit) && fh->loop_i != limit) { // boundary not crossed, continue
         fh->execptr = instr->data; // go to beginning
       } else {
@@ -307,6 +317,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       LOG("Exec: word-end");
       TRY(rs_pop(fh, &fh->execptr));
       if (fh->execptr == MAGICADDR_EXEC_INTERACTIVE) {
+        LOG("Done running compiled word");
         goto end;
       }
       goto instr;
@@ -384,6 +395,7 @@ enum fh_error fh_find_word(struct fh_thread_s *fh, const char *name, size_t word
 enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue)
 {
   enum fh_error rv;
+  LOG("Loop nest");
   TRY(rs_push(fh, fh->loop_j));
   fh->loop_j = fh->loop_i;
   fh->loop_i = indexvalue;
@@ -393,6 +405,7 @@ enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue)
 enum fh_error fh_loop_unnest(struct fh_thread_s *fh)
 {
   enum fh_error rv;
+  LOG("Loop un-nest");
   fh->loop_i = fh->loop_j;
   TRY(rs_pop(fh, &fh->loop_j));
   return FH_OK;
diff --git a/testfiles/combinedtest.f b/testfiles/combinedtest.f
index 769fcb9..a9f6203 100644
--- a/testfiles/combinedtest.f
+++ b/testfiles/combinedtest.f
@@ -777,6 +777,7 @@ T{ : GD2 DO I -1 +LOOP ; -> }T
 T{ 1 4 GD2 -> 4 3 2 1 }T
 T{ -1 2 GD2 -> 2 1 0 -1 }T
 T{ MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT }T
+exit
 
 T{ : GD3 DO 1 0 DO J LOOP LOOP ; -> }T
 T{ 4 1 GD3 -> 1 2 3 }T
diff --git a/testfiles/postpone2.f b/testfiles/postpone2.f
new file mode 100644
index 0000000..bb8a29f
--- /dev/null
+++ b/testfiles/postpone2.f
@@ -0,0 +1,9 @@
+: GT6 345 ; IMMEDIATE
+
+see gt6
+
+: GT7 POSTPONE GT6 ;
+
+see gt7
+
+GT7 .