implement >NUMBER, <# #> fixes

src/fh_builtins_meta.c

@@ -411,6 +411,8 @@ static enum fh_error w_word(struct fh_thread_s *fh, const struct fh_word_s *w)
   fh_store_char(fh, WORDBUF_ADDR, (char) len);
   fh_heap_copyptr(fh, WORDBUF_ADDR + 1, out, len);
   
+  LOG("Word found: \"%.*s\"", len, out);
+
   TRY(ds_push(fh, WORDBUF_ADDR));
   return FH_OK;
 }

src/fh_builtins_text.c

@@ -1,5 +1,26 @@
 #include "forth_internal.h"
 
+static enum fh_error pop_addr_len(struct fh_thread_s *fh, uint32_t *addr, uint32_t *len)
+{
+  enum fh_error rv;
+  TRY(ds_pop(fh, len));
+  TRY(ds_pop(fh, addr));
+
+  if (*addr >= HEAP_SIZE) { // not HEAP_END, because this can point into other buffers too
+    LOGE("heap string pointer out of bounds!");
+    return FH_ERR_NOT_APPLICABLE; // TODO better code
+  }
+  return FH_OK;
+}
+
+static enum fh_error push_addr_len(struct fh_thread_s *fh, uint32_t addr, uint32_t len)
+{
+  enum fh_error rv;
+  TRY(ds_push(fh, addr));
+  TRY(ds_push(fh, len));
+  return FH_OK;
+}
+
 /**
  * Encode a code point using UTF-8
  *
@@ -76,15 +97,9 @@ static enum fh_error w_type(struct fh_thread_s *fh, const struct fh_word_s *w)
   (void) w;
   enum fh_error rv;
   uint32_t count = 0, addr = 0;
-  LOG("Get count,addr");
+  TRY(pop_addr_len(fh, &addr, &count));
-  TRY(ds_pop(fh, &count));
-  TRY(ds_pop(fh, &addr));
-
   const char *str = fh_str_at(fh, addr);
-  if (!str) {
+  if (!str) return FH_ERR_INTERNAL;
-    LOGE("Type addr out of bounds!");
-    return FH_ERR_NOT_APPLICABLE;
-  }
   FHPRINT("%.*s", count, str);
   return FH_OK;
 }
@@ -156,8 +171,7 @@ static enum fh_error w_s_quote(struct fh_thread_s *fh, const struct fh_word_s *w
   struct fh_instruction_s instr;
   if (fh->state == FH_STATE_INTERPRET) {
     LOG("Interpret a string alloc: \"%.*s\"", len, start);
-    TRY(ds_push(fh, addr));
+    TRY(push_addr_len(fh, addr, len));
-    TRY(ds_push(fh, len));
   } else {
     LOG("Compile a string: \"%.*s\"", len, start);
     instr.kind = FH_INSTR_ALLOCSTR;
@@ -239,8 +253,7 @@ static enum fh_error w_hash_greater(struct fh_thread_s *fh, const struct fh_word
   TRY(fh_heap_reserve(fh, len, &addr));
   fh_heap_copy(fh, addr, fh->pictnumptr+1, len);
   LOG("#> output: \"%.*s\"", len, &fh->heap[fh->pictnumptr+1]);  
-  TRY(ds_push(fh, addr));
+  TRY(push_addr_len(fh, addr, len));
-  TRY(ds_push(fh, len));
   return FH_OK;
 }
 
@@ -327,23 +340,64 @@ static enum fh_error w_holds(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
   enum fh_error rv;
-  uint32_t ch;
-  
   uint32_t count = 0, addr = 0;
-  LOG("Get count,addr");
+  TRY(pop_addr_len(fh, &addr, &count));
-  TRY(ds_pop(fh, &count));
+  const char *str = fh_str_at(fh, addr);
-  TRY(ds_pop(fh, &addr));
+  if (!str) return FH_ERR_INTERNAL;
+  
+  for(int i=count-1; i>=0; i--) {
+    TRY(pictnum_prepend_char(fh, str[i]));
+  }
+  
+  return FH_OK;
+}
+
+static enum fh_error w_to_number(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  
+  /*
+  ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 )
+  ud2 is the unsigned result of converting the characters within the string specified by c-addr1 u1 into digits, using the number in BASE, and adding each into ud1 after multiplying ud1 by the number in BASE. Conversion continues left-to-right until a character that is not convertible, including any "+" or "-", is encountered or the string is entirely converted. c-addr2 is the location of the first unconverted character or the first character past the end of the string if the string was entirely converted. u2 is the number of unconverted characters in the string. An ambiguous condition exists if ud2 overflows during the conversion. 
+  */
   
+  uint32_t count = 0, addr = 0;
+  TRY(pop_addr_len(fh, &addr, &count));
   const char *str = fh_str_at(fh, addr);
-  if (!str) {
+  if (!str) return FH_ERR_INTERNAL;
-    LOGE("HOLDS addr out of bounds!");
+  
-    return FH_ERR_NOT_APPLICABLE;
+  LOG("parse num from str: %.*s", count, str);
+  
+  uint64_t val;
+  TRY(ds_pop_dw(fh, &val));
+  
+  int conv;
+  int i = 0;
+  for(; i<count; i++) {
+    char ch = str[i];
+    LOG("parse c: %c", ch);
+    if (ch >= '0' && ch <= '9') {
+      conv = ch - '0';
+    } else if (ch >= 'a' && ch <= 'z') {
+      conv = 10 + ch - 'a';
+    } else if (ch >= 'A' && ch <= 'Z') {
+      conv = 10 + ch - 'A';
+    } else {
+      break;
     }
     
-  for(int i=count-1;i>=0;i--) {
+    if (conv >= fh->base) {
-    TRY(pictnum_prepend_char(fh, str[i]));
+    LOG("not numeric, end num parse!");
+      break;
+    }
+    
+    val = (val * (uint64_t)fh->base) + (uint64_t)conv;
   }
   
+  LOG("parsed num: %d", val);
+  TRY(ds_push_dw(fh, val));
+  TRY(push_addr_len(fh, addr+i, count-i));
   return FH_OK;
 }
 
@@ -369,5 +423,6 @@ const struct name_and_handler fh_builtins_text[] = {
     {"sign",     w_sign,       0, 0},
     {"hold",     w_hold,       0, 0},
     {"holds",     w_holds,       0, 0},
+    {">number",     w_to_number,       0, 0},
     { /* end marker */ }
 };

src/fh_runtime.c

@@ -113,7 +113,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
   call:
   if (!w) { return FH_ERR_INTERNAL; }
 
-  LOG("Run user word: %s", w->name);
+  LOG("\x1b[35mExec: Called user word: %s\x1b[m", w->name);
 
   TRY(rs_push(fh, fh->execptr));
   fh->execptr = w->param;
@@ -167,7 +167,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
 //            TRY(rs_pop(fh, &fh->execptr));
 //          }
         } else {
-          LOG("Add postponed word: %s", w2->name);
+          LOG("\x1b[35mExec: Add postponed word\x1b[m %s", w2->name);
           TRY(fh_put_instr(fh, FH_INSTR_WORD, instr->data));
         }
       /*} else {
@@ -184,7 +184,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       }
     call_w2:
       if (w2->flags & WORDFLAG_BUILTIN) {
-        LOG("Exec: native-word \"%s\"", w2->name);
+        LOG("\x1b[35mExec: native-word \"%s\"\x1b[m", w2->name);
         TRY(w2->handler(fh, w2));
         if (fh->substate == FH_SUBSTATE_EXIT) {
           fh_setsubstate(fh, 0);
@@ -196,7 +196,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
         }
         goto instr;
       } else {
-        LOG("Exec: user-word %s (CALL)", w2->name);
+        LOG("\x1b[35mExec: user-word %s\x1b[m (CALL)", w2->name);
         w = fh_word_at(fh, instr->data);
         if (!w) {
           LOGE("CALL instr bad word addr!");
@@ -206,6 +206,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       }
 
     case FH_INSTR_JUMPZERO:
+      LOG("\x1b[35mExec: jump if zero -> 0x%08x\x1b[m", instr->data);
       if (instr->data == MAGICADDR_UNRESOLVED) {
         LOGE("Encountered unresolved jump!");
         goto end;
@@ -213,11 +214,15 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
 
       TRY(ds_pop(fh, &val));
       if (0 == val) {
+        LOG("Jumping");
         fh->execptr = instr->data;
+      } else {
+        LOG("No jump");
       }
       goto instr;
 
     case FH_INSTR_JUMP:
+      LOG("\x1b[35mExec: jump -> 0x%08x\x1b[m", instr->data);
       if (instr->data == MAGICADDR_UNRESOLVED) {
         LOGE("Encountered unresolved jump!");
         goto end;
@@ -232,7 +237,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
         LOGE("TO instr bad variable addr!");
         return FH_ERR_INTERNAL;
       }
-      LOG("Exec: %d->%s", val, w2->name);
+      LOG("\x1b[35mExec: %d TO %s\x1b[m", val, w2->name);
 
       if (w2->flags & WORDFLAG_CONSTANT) {
         LOGE("Cannot assign to constant!");
@@ -243,6 +248,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       goto instr;
 
     case FH_INSTR_DO:
+      LOG("\x1b[35mExec: do\x1b[m");
       TRY(ds_pop(fh, &index));
       TRY(ds_pop(fh, &limit)); // just make sure it exists
       TRY(fh_loop_nest(fh, index));
@@ -250,6 +256,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       goto instr;
 
     case FH_INSTR_DO_QUESTION:
+      LOG("\x1b[35mExec: ?do\x1b[m");
       if (instr->data == MAGICADDR_UNRESOLVED) {
         LOGE("Encountered unresolved jump!");
         goto end;
@@ -277,7 +284,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       // R: index,limit
       TRY(rs_peek(fh, &limit));
 
-      LOG("+LOOP, i=%d, step %d, limit %d", fh->loop_i, val, limit);
+      LOG("\x1b[35mExec: +LOOP\x1b[m, i=%d, step %d, limit %d", fh->loop_i, val, limit);
       
       const int32_t vi = (int32_t)val;
       const int32_t bdr = (int32_t)limit - (int32_t)1;
@@ -304,6 +311,7 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
       goto instr;
 
     case FH_INSTR_LEAVE:
+      LOG("\x1b[35mExec: leave\x1b[m");
       if (instr->data == MAGICADDR_UNRESOLVED) {
         LOGE("Encountered unresolved jump!");
         goto end;
@@ -318,18 +326,18 @@ enum fh_error w_user_word(struct fh_thread_s *fh, const struct fh_word_s *w0)
     case FH_INSTR_TYPESTR:
       strl = instr->data;
       if (instr->kind == FH_INSTR_ALLOCSTR) {
-        LOG("Exec: alloc-str \"%.*s\"", strl, fh_str_at(fh, fh->execptr));
+        LOG("\x1b[35mExec: alloc-str\x1b[m \"%.*s\"", strl, fh_str_at(fh, fh->execptr));
         TRY(ds_push(fh, fh->execptr)); // give pointer directly into the definition
         TRY(ds_push(fh, strl));
       } else {
-        LOG("Exec: type-str \"%.*s\"", strl, fh_str_at(fh, fh->execptr));
+        LOG("\x1b[35mExec: type-str\x1b[m \"%.*s\"", strl, fh_str_at(fh, fh->execptr));
         FHPRINT("%.*s", (int) strl, fh_str_at(fh, fh->execptr));
       }
       fh->execptr += strl;
       goto instr;
 
     case FH_INSTR_ENDWORD:
-      LOG("Exec: word-end");
+      LOG("\x1b[35mExec: word-end\x1b[m");
       TRY(rs_pop(fh, &fh->execptr));
       if (fh->execptr == MAGICADDR_EXEC_INTERACTIVE) {
         LOG("Done running compiled word");