more fixes in DOES>, now it's almost correct and extra weird

README.md

@@ -50,12 +50,12 @@ Implemented (some may be wrong, like `FM/MOD`):
 CORE:
 ! ' ( * */ */MOD + +! +LOOP , - . ." / /mod 0< 0= 1+ 1- 2! 2* 2/ 2@ 2DROP 2DUP 2OVER 2SWAP
 : ; < = > >IN >R ?DUP @ ABORT ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL C! C, C@ CELL CELL+ CELLS CHAR CHAR+
-CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DROP DUP ELSE EMIT ENVIRONMENT? EXECUTE EXIT FM/MOD FIND
+CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DOES> DROP DUP ELSE EMIT ENVIRONMENT? EXECUTE EXIT FM/MOD FIND
 HERE I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP LSHIFT M* MAX MIN MOD NEGATE OR OVER POSTPONE QUIT R> R@ RECURSE
 REPEAT ROT RSHIFT S>D S" SM/REM SOURCE SPACE STATE SWAP THEN TYPE U< UNTIL UM* UM/MOD UNLOOP VARIABLE WHILE WORD XOR [ ['] [CHAR] ] 
 
 CORE-EXT:
-.( 0<> 0> 2>R 2R> 2R@ <> ?DO AGAIN FALSE HEX NIP PAD PICK ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE
+.( :NONAME 0<> 0> 2>R 2R> 2R@ <> ?DO AGAIN FALSE HEX NIP PAD PICK ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE
 \
 
 Other sets:
@@ -68,10 +68,10 @@ basically, CASE-OF, pictured numbers, keyboard input, some weirder metaprogrammi
 
 ```
 CORE:
-# #> #S <# >BODY >NUMBER ABORT" ACCEPT DOES> EVALUATE FILL HOLD KEY MOVE SIGN SPACES U.
+# #> #S <# >BODY >NUMBER ABORT" ACCEPT EVALUATE FILL HOLD KEY MOVE SIGN SPACES U.
 
 CORE-EXT:
-.R :NONAME ACTION-OF BUFFER: C" CASE COMPILE, DEFER DEFER! DEFER@ ENDCASE ENDOF ERASE HOLDS IS
+.R ACTION-OF BUFFER: C" CASE COMPILE, DEFER DEFER! DEFER@ ENDCASE ENDOF ERASE HOLDS IS
 MARKER OF PARSE PARSE-NAME REFILL RESTORE-INPUT SAVE-INPUT SOURCE-ID WITHIN [COMPILE]
 ```
 

include/fh_runtime.h

@@ -198,6 +198,8 @@ struct fh_thread_s {
 
   /** Nesting level of [if] */
   uint32_t parse_if_level;
+  
+  bool executing_compiled;
 };
 
 enum fh_error fh_loop_nest(struct fh_thread_s *fh, uint32_t indexvalue);

src/fh_builtins_meta.c

@@ -31,20 +31,81 @@ static enum fh_error w_colon(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
-static enum fh_error w_does(struct fh_thread_s *fh, const struct fh_word_s *w)
+static enum fh_error w_colon_noname(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
   enum fh_error rv;
   ENSURE_STATE(FH_STATE_INTERPRET);
+
+  LOG("Starting noname compilation");
+
+  fh_setstate(fh, FH_STATE_COMPILE, 0);
+
+  uint32_t ptr;
+  TRY(fh_heap_reserve(fh, DICTWORD_SIZE, &ptr));
+
+  struct fh_word_s *new_word = fh_word_at(fh, ptr);
+  if (!new_word) return FH_ERR_INTERNAL;
+  new_word->previous = MAGICADDR_DICTFIRST;
+  new_word->param = fh->here;
+  new_word->handler = w_user_word;
+  new_word->name[0] = 0;
+  new_word->flags = WORDFLAG_WORD;
+  
+  TRY(ds_push(fh, ptr)); // TODO maybe should do this at semicolon?
+
+  return FH_OK;
+}
+
+static enum fh_error w_does(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  bool crazy = 0;
+  
+  if (fh->executing_compiled) {
+    LOG("DOES> in compiled code. OK but weird");
+    //FIXME make this less shitty
+    
+    // FIXME this works correctly, but the test fails, because it assumes
+    //  that compiled DOES> just changes some pointer in the dict entry,
+    //  whereas we do it by generating helper instructions.
+    
+    crazy = 1;
+    goto banana;
+    banana2:
+    
+    // We are in :NONAME or : NAME.
+    // This word should be compiled.
+    TRY(fh_put_instr(fh, FH_INSTR_JUMP, fh->execptr + INSTR_SIZE)); // skip two forward
+    // next instr run is the ENDWORD emitted at compile time
+    
+    return FH_OK;
+  }
+  
+  if (fh->state == FH_STATE_COMPILE) {
+    TRY(fh_put_instr(fh, FH_INSTR_WORD, (void*)w - (void*)&fh->heap[0])); // call the DOES word
+    TRY(fh_put_instr(fh, FH_INSTR_ENDWORD, 1));
+    return FH_OK;
+  }
   
   fh_setstate(fh, FH_STATE_COMPILE, 0);
 
+  banana:
   struct fh_word_s *last_word = fh_word_at(fh, fh->dict_last);
   if (!last_word) return FH_ERR_INTERNAL;
   
-  last_word->handler = w_user_word;  
+  last_word->handler = w_user_word;
-  last_word->param = fh->here;
+  last_word->param = fh->here; // + CELL; // skip the one cell used to hold data. this is a shitty hack
   last_word->flags = WORDFLAG_WORD;
+  
+  uint32_t dptr = fh->here;
+  //TRY(fh_heap_reserve(fh, CELL, NULL));
+  
+  TRY(fh_put_instr(fh, FH_INSTR_NUMBER, dptr)); // put pointer to the reserved cell
+  
+  if (crazy) goto banana2;
+  
   return FH_OK;
 }
 
@@ -328,6 +389,17 @@ static enum fh_error w_to_in(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_to_body(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  
+  uint32_t xt;
+  TRY(ds_pop(fh, &xt)); // xt is now a dict entry (hopefully)
+  TRY(ds_push(fh, xt + DICTWORD_SIZE)); // XXX should it still point here if DOES> was used?
+  return FH_OK;
+}
+
 static bool chartest_equals_or_end(char c, void *param)
 {
   char cc = (char) *(uint32_t *) param;
@@ -567,7 +639,9 @@ const struct name_and_handler fh_builtins_meta[] = {
     {"depth",        w_depth,        0, 0},
     {"unused",       w_unused,       0, 0},
     {">in",          w_to_in,        0, 0},
+    {">body",        w_to_body,      0, 0},
     {":",            w_colon,        0, 0},
+    {":noname",      w_colon_noname, 0, 0},
     {"does>",        w_does,         1, 0},
     {";",            w_semicolon,    1, 0},
     {"forget",       w_forget,       1, 0},

src/fh_mem.c

@@ -175,6 +175,7 @@ enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len)
   enum fh_error rv;
   uint32_t addr = 0;
   TRY(fh_heap_reserve(fh, len, &addr));
+  LOG("Put %d bytes at 0x%08x", len, addr);
   fh_heap_write(fh, addr, src, len);
   return FH_OK;
 }

src/fh_runtime.c

@@ -107,6 +107,8 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
   const struct fh_word_s *w;
   struct fh_word_s *w2;
 
+  fh->executing_compiled = 1;
+
   w = w0;
   call:
   if (!w) { return FH_ERR_INTERNAL; }
@@ -332,6 +334,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
   }
 
   end:
+  fh->executing_compiled = 0;
   return FH_OK;
 }
 

src/fh_see.c

@@ -27,7 +27,7 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
         const struct fh_word_s *w2;
         switch (instr->kind) {
           case FH_INSTR_NUMBER:
-            FHPRINT("Number(%d)\n", instr->data);
+            FHPRINT("Number(%d / 0x%08x)\n", instr->data, instr->data);
             break;
 
           case FH_INSTR_WORD:
@@ -103,8 +103,13 @@ static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
             break;
 
           case FH_INSTR_ENDWORD:
-            FHPRINT("END\n");
+            if (instr->data == 1) {
-            return;
+              FHPRINT("END (synthetic for DOES>)\n");
+              break;
+            } else {
+              FHPRINT("END\n");            
+              return;
+            }
 
           default:
             FHPRINT("Unknown(kind 0x%08x, data 0x%08x)\n", instr->kind, instr->data);
@@ -133,6 +138,7 @@ enum fh_error fh_see_word(
 {
   enum fh_error rv;
   uint32_t addr;
+  // TODO allow see with addr to inspect :NONAME defined words
   TRY(fh_find_word(fh, name, wordlen, &addr));
   show_word(fh, fh_word_at(fh, addr));
   return FH_OK;

testfiles/combinedtest.f

@@ -826,6 +826,7 @@ T{ CR1 -> HERE }T
 T{ ' CR1 >BODY -> HERE }T
 T{ 1 , -> }T
 T{ CR1 @ -> 1 }T
+
 T{ DOES1 -> }T
 T{ CR1 -> 2 }T
 T{ DOES2 -> }T