implement source ID, better error handling in nested input

include/fh_config.h

@@ -7,8 +7,8 @@
 #ifndef FORTH_FH_CONFIG_H
 #define FORTH_FH_CONFIG_H
 
-#define DATA_STACK_DEPTH 256
-#define RETURN_STACK_DEPTH 256
+#define DATA_STACK_DEPTH 16
+#define RETURN_STACK_DEPTH 16
 #define MAX_NAME_LEN 32
 #define HEAP_SIZE (1024*1024)
 #define MAXLINE 65535
@@ -33,6 +33,7 @@
 #define MAGICADDR_INPTR            0xFFFFF175ULL
 #define MAGICADDR_UNRESOLVED       0xFFFFFBADULL
 #define MAGICADDR_ENDCASE_UNRESOLVED 0xFFFC5BADULL
+#define MAGICADDR_SOURCEID         0xFFFF5C1DULL
 
 #define FH_PROMPT_STR "> "
 

include/fh_error.h

@@ -30,6 +30,7 @@ enum fh_error {
   FH_ERR_NOT_APPLICABLE,
   FH_ERR_PICTNUM_FULL,
   FH_ERR_BAD_DEFER,
+  FH_ERR_ABORT, // technical error used to abort from nested input source
   FH_ERR_MAX,
 };
 

include/fh_input.h

@@ -29,6 +29,7 @@ struct fh_input_spec_s {
   fh_input_error_method_t save_input;
   fh_input_error_method_t restore_input;
   uint32_t linenum;
+  int32_t source_id;
   char *cwd; // CWD of the input, used for relative includes. malloc'd (strdup)
 
   // saved values, filled when pushing

src/fh_builtins_arith.c

@@ -13,6 +13,14 @@ enum fh_error wp_const(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_source_id(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  TRY(ds_push(fh, fh->input->source_id));
+  return FH_OK;
+}
+
 static enum fh_error w_plus(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -557,6 +565,7 @@ static enum fh_error w_sm_rem(struct fh_thread_s *fh, const struct fh_word_s *w)
 const struct name_and_handler fh_builtins_arith[] = {
     /* Arithmetics */
     {"base",    wp_const,          0, MAGICADDR_BASE},
+    {"source-id", w_source_id,          0, 0},
     {"decimal", wp_setbase,        0, 10},
     {"hex",     wp_setbase,        0, 16},
     {"false",   wp_const,          0, 0},

src/fh_builtins_control.c

@@ -244,67 +244,6 @@ static enum fh_error w_of(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
-static enum fh_error w_abort(struct fh_thread_s *fh, const struct fh_word_s *w)
-{
-  (void) w;
-  enum fh_error rv;
-  fh_abort(fh);
-  return FH_OK;
-}
-
-static enum fh_error w_quit(struct fh_thread_s *fh, const struct fh_word_s *w)
-{
-  (void) w;
-  enum fh_error rv;
-  fh_quit(fh);
-  return FH_OK;
-}
-
-static enum fh_error w_abort_quote(struct fh_thread_s *fh, const struct fh_word_s *w)
-{
-  (void) w;
-  enum fh_error rv;
-  size_t len;
-  
-  // this is copied from ."
-
-  // leave space for the instr in case of compiled version
-  uint32_t addr = fh->here + (fh->state == FH_STATE_INTERPRET ? 0 : INSTR_SIZE);
-
-  /* read the string straight into HEAP, but don't advance the heap pointer, so the string is immediately discarded again */
-
-  fh_input_consume_spaces(fh);
-  char *start;
-  uint32_t capacity = HEAP_END - addr;
-  
-  start = NULL;
-  char c = '"';
-  TRY(fh_input_read_delimited(fh, &start, &len, fh_chartest_equals_or_end, &c));
-  if (len > capacity) {
-    LOGE("String too long for heap");
-    return FH_ERR_HEAP_FULL;
-  }
-  if (fh->state == FH_STATE_COMPILE) {
-    fh_heap_copyptr(fh, addr, start, len);
-  }
-
-  if (fh->state == FH_STATE_INTERPRET) {
-    uint32_t val;
-    TRY(ds_pop(fh, &val));
-    if (val) {
-      FHPRINT("%.*s", (int) len, start);      
-      fh_abort(fh);
-    }
-    // the string is invalidated immediately, heap pointer is NOT advanced.
-  } else {
-    LOG("Compile abort string: \"%.*s\"", (int) len, start);
-    TRY(fh_put_instr(fh, FH_INSTR_ABORTSTR, len));
-    fh->here = WORDALIGNED(addr + len); // at the end of the string
-  }
-
-  return FH_OK;
-}
-
 static enum fh_error w_endof(struct fh_thread_s *fh, const struct fh_word_s *w)
 {
   (void) w;
@@ -371,9 +310,6 @@ const struct name_and_handler fh_builtins_control[] = {
     {"else",    w_else,    1, 0},
     {"then",    w_then,    1, 0},
     {"recurse", w_recurse, 1, 0},
-    {"quit",   w_quit,   0, 0},
-    {"abort",   w_abort,   0, 0},
-    {"abort\"", w_abort_quote, 1, 0},
     {"do",      wp_do,     1, 0},
     {"?do",     wp_do,     1, 1},
     {"loop",    wp_loop,   1, 0},

src/fh_builtins_meta.c

@@ -739,8 +739,7 @@ static enum fh_error w_evaluate(struct fh_thread_s *fh, const struct fh_word_s *
   enum fh_error rv;
   uint32_t addr, count;
   TRY(ds_pop_addr_len(fh, &addr, &count));
-  fh_runtime_start(fh, fh_create_input_from_string(fh_str_at(fh, addr), count, fh->input->cwd));
-  return FH_OK;
+  return fh_runtime_start(fh, fh_create_input_from_string(fh_str_at(fh, addr), count, fh->input->cwd));
 }
 
 static enum fh_error w_save_input(struct fh_thread_s *fh, const struct fh_word_s *w)

src/fh_builtins_system.c

@@ -37,11 +37,76 @@ static enum fh_error w_exit(struct fh_thread_s *fh, const struct fh_word_s *w)
   return FH_OK;
 }
 
+static enum fh_error w_abort(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  fh_abort(fh);
+  return FH_OK;
+}
+
+static enum fh_error w_quit(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  fh_quit(fh);
+  return FH_OK;
+}
+
+static enum fh_error w_abort_quote(struct fh_thread_s *fh, const struct fh_word_s *w)
+{
+  (void) w;
+  enum fh_error rv;
+  size_t len;
+  
+  // this is copied from ."
+
+  // leave space for the instr in case of compiled version
+  uint32_t addr = fh->here + (fh->state == FH_STATE_INTERPRET ? 0 : INSTR_SIZE);
+
+  /* read the string straight into HEAP, but don't advance the heap pointer, so the string is immediately discarded again */
+
+  fh_input_consume_spaces(fh);
+  char *start;
+  uint32_t capacity = HEAP_END - addr;
+  
+  start = NULL;
+  char c = '"';
+  TRY(fh_input_read_delimited(fh, &start, &len, fh_chartest_equals_or_end, &c));
+  if (len > capacity) {
+    LOGE("String too long for heap");
+    return FH_ERR_HEAP_FULL;
+  }
+  if (fh->state == FH_STATE_COMPILE) {
+    fh_heap_copyptr(fh, addr, start, len);
+  }
+
+  if (fh->state == FH_STATE_INTERPRET) {
+    uint32_t val;
+    TRY(ds_pop(fh, &val));
+    if (val) {
+      FHPRINT("%.*s", (int) len, start);      
+      fh_abort(fh);
+    }
+    // the string is invalidated immediately, heap pointer is NOT advanced.
+  } else {
+    LOG("Compile abort string: \"%.*s\"", (int) len, start);
+    TRY(fh_put_instr(fh, FH_INSTR_ABORTSTR, len));
+    fh->here = WORDALIGNED(addr + len); // at the end of the string
+  }
+
+  return FH_OK;
+}
+
+
 const struct name_and_handler fh_builtins_system[] = {
     {"reset", w_reset, 1, 0},
     {"bye",   w_bye,   0, 0},
     {"debug", w_debug, 0, 0},
     {"exit",  w_exit,  1, 0},
+    {"quit",   w_quit,   0, 0},
+    {"abort",   w_abort,   0, 0},
+    {"abort\"", w_abort_quote, 1, 0},
 
     { /* end marker */ }
 };

src/fh_error.c

@@ -23,6 +23,7 @@ static const char *errornames[FH_ERR_MAX] = {
     [FH_ERR_PICTNUM_FULL] = "PICTNUM_FULL",
     [FH_ERR_NOT_APPLICABLE] = "NOT_APPLICABLE",
     [FH_ERR_BAD_DEFER] = "BAD_DEFER",
+    [FH_ERR_ABORT] = "ABORT",
 };
 
 /** Get error name from code, returns Unknown if not defined */

src/fh_input.c

@@ -278,6 +278,7 @@ struct fh_input_spec_s *fh_create_input_from_filestruct(FILE *f, const char *cwd
   spec->spec.save_input = file_save_input;
   spec->spec.restore_input = file_restore_input;
   spec->file = f;
+  spec->spec.source_id = fileno(f); // stdin is 0
   if (cwd) {
     spec->spec.cwd = strdup(cwd);
   }
@@ -307,6 +308,7 @@ struct fh_input_spec_s *fh_create_input_from_filename(char *path)
   spec->spec.save_input = file_save_input;
   spec->spec.restore_input = file_restore_input;
   spec->file = f;
+  spec->spec.source_id = fileno(f); // stdin is 0
 
   char pwd[PATH_MAX+1];
   realpath(path, pwd);
@@ -339,6 +341,7 @@ struct fh_input_spec_s *fh_create_input_from_string(char *str, size_t len, const
   spec->str = str;
   spec->len = len;
   spec->spec.cwd = cwd ? strdup(cwd) : NULL;
+  spec->spec.source_id = -1;
   return (struct fh_input_spec_s*) spec;
 }
 
@@ -346,6 +349,7 @@ void fh_input_teardown(struct fh_thread_s *fh)
 {
   struct fh_input_spec_s *s = fh->input;
   if (!s) return;
+  fh->input = NULL;
 
   while (s) {    
     struct fh_input_spec_s *prev = s->previous;
@@ -354,4 +358,8 @@ void fh_input_teardown(struct fh_thread_s *fh)
     }
     s = prev;
   }
+  
+  fh->inputptr = 0;
+  fh->inputlen = 0;
+  fh->inputaddr = INPUTBUF_ADDR;
 }

src/fh_mem.c

@@ -27,6 +27,11 @@ enum fh_error fh_fetch(struct fh_thread_s *fh, uint32_t addr, uint32_t *dst)
       LOG("Fetch here %d", *dst);
       break;
 
+    case MAGICADDR_SOURCEID:
+      *dst = fh->input->source_id;
+      LOG("Fetch SOURCE-ID %d", *dst);
+      break;
+
     case MAGICADDR_STATE:
       *dst = TOBOOL(fh->state == FH_STATE_COMPILE);
       LOG("Fetch state %d", *dst);
@@ -81,6 +86,10 @@ enum fh_error fh_store(struct fh_thread_s *fh, uint32_t addr, uint32_t val)
       LOGE("STATE is read-only!");
       return FH_ERR_ILLEGAL_STORE;
 
+    case MAGICADDR_SOURCEID:
+      LOGE("SOURCE-ID is read-only!");
+      return FH_ERR_ILLEGAL_STORE;
+
     case MAGICADDR_INPTR:
       LOG("set >IN %d", val);
       fh->inputptr = val;

src/fh_parse.c

@@ -276,18 +276,21 @@ enum fh_error fh_runtime_start(struct fh_thread_s *fh, struct fh_input_spec_s *i
       rv = fh_process_line(fh);
 
       if (rv == FH_OK) {
+        if (fh->state == FH_STATE_SHUTDOWN) {
+          return FH_OK;
+        }
         if (fh_globals.interactive || fh_globals.echo) {
           FHPRINT_SVC(" ok\n");
         }
-        if (fh->state == FH_STATE_SHUTDOWN) {
-          return 1;
-        }
       } else {        
-        LOGE("ERROR %s on line %d", fherr_name(rv), fh->input->linenum);
+        LOGE("Error %s on line %d in source %d", fherr_name(rv), fh->input->linenum, fh->input->source_id);
         if (fh_globals.interactive || fh_globals.rescue) {
+          LOGE("Drop to interactive");
           fh_drop_to_interactive(fh);
         } else {
-          return 1;
+          LOGE("Shutting down due to error");
+          fh->state = FH_STATE_SHUTDOWN;
+          return FH_OK;
         }
       }
 

testfiles/combinedtest.f

@@ -1788,6 +1788,7 @@ TESTING REFILL SOURCE-ID
 \ REFILL and SOURCE-ID from the user input device can't be tested from a file,
 \ can only be tested from a string via EVALUATE
 
+1 debug
 T{ : RF1  S" REFILL" EVALUATE ; RF1 -> FALSE }T
 T{ : SID1  S" SOURCE-ID" EVALUATE ; SID1 -> -1 }T
 

testfiles/refill_sid.f

@@ -0,0 +1,4 @@
+ 
+: RF1  S" REFILL" EVALUATE ;
+
+RF1