its working

Author: no382001

TODO

@@ -54,7 +54,8 @@ the os should reach out to a 9p configuration server, could serve the bootstrap
 bootloader:
   switch to that other one instead of loading with --kernel
 
-spawn a thread with a handler on some hardcoded socket for p92000
+- error when you could have too much words, and `words` fails
+make it navigate the vfs
 
 do the vfs first
 scheme and forth?
@@ -65,3 +66,5 @@ forth should handle string and the kb callback alright
 
 fix up tinylisp to have variadic lambdas, or ribbit or zforth
 tinylisp and zzforth needs jumpbuffers, but i have task swtiching already, shouldnt be a problem
+
+https://www.complang.tuwien.ac.at/schani/oldstuff/#schemeinforth

apps/zfconf.h

@@ -36,7 +36,7 @@
  * floating point numbers */
 
 typedef float zf_cell;
-#define ZF_CELL_FMT "%x"
+#define ZF_CELL_FMT "%f"
 #define ZF_SCAN_FMT "%f"
 
 /* zf_int use for bitops, some arch int type width is less than register width,

apps/zforth.h

@@ -71,11 +71,6 @@ typedef enum {
     ZF_USERVAR_COUNT
 } zf_uservar_id;
 
-typedef struct {
-    zf_result last_error;
-    int error_occurred;
-} zf_error_state;
-
 typedef struct {
 	/* Stacks and dictionary memory */
 	zf_cell rstack[ZF_RSTACK_SIZE];

apps/zfortharch.c

@@ -1,9 +1,10 @@
 #include "drivers/screen.h"
+#include "drivers/serial.h"
+#include "libc/string.h"
 #include "libc/types.h"
 #include "zforth.h"
 
 zf_input_state zf_host_sys(zf_ctx *ctx, zf_syscall_id id, const char *input) {
-  kernel_printf("zforth syscall: %d\n", id);
   switch (id) {
   case ZF_SYSCALL_EMIT: {
     zf_cell c = zf_pop(ctx);
@@ -41,43 +42,62 @@ zf_input_state zf_host_sys(zf_ctx *ctx, zf_syscall_id id, const char *input) {
   return ZF_INPUT_INTERPRET;
 }
 
+#include "drivers/serial.h"
+
 void zf_host_trace(zf_ctx *ctx, const char *fmt, va_list va) {
-  _vprintf(kernel_putc, fmt, va);
+  _vprintf(serial_write, fmt, va);
 }
-zf_cell zf_host_parse_num(zf_ctx *ctx, const char *buf) {
 
-  if (!buf || !*buf)
-    return 0;
+int atoi2(const char *str, int *result) {
+  const char *original = str;
+  int value = 0;
+  int sign = 1;
+  int has_digits = 0;
 
-  zf_cell result = 0;
-  int negative = 0;
-  const char *p = buf;
+  while (*str == ' ' || *str == '\t' || *str == '\n' || *str == '\r' ||
+         *str == '\f' || *str == '\v') {
+    str++;
+  }
 
-  if (*p == '-') {
-    negative = 1;
-    p++;
+  if (*str == '-') {
+    sign = -1;
+    str++;
+  } else if (*str == '+') {
+    str++;
   }
 
-  if (p[0] == '0' && (p[1] == 'x' || p[1] == 'X')) {
-    p += 2;
-    while (*p) {
-      if (*p >= '0' && *p <= '9') {
-        result = result * 16 + (*p - '0');
-      } else if (*p >= 'a' && *p <= 'f') {
-        result = result * 16 + (*p - 'a' + 10);
-      } else if (*p >= 'A' && *p <= 'F') {
-        result = result * 16 + (*p - 'A' + 10);
-      } else {
-        break; // invalid hex digit
-      }
-      p++;
-    }
-  } else {
-    while (*p >= '0' && *p <= '9') {
-      result = result * 10 + (*p - '0');
-      p++;
+  while (*str >= '0' && *str <= '9') {
+    has_digits = 1;
+    value = value * 10 + (*str - '0');
+    str++;
+  }
+
+  while (*str) {
+    if (*str != ' ' && *str != '\t' && *str != '\n' && *str != '\r' &&
+        *str != '\f' && *str != '\v') {
+      return 0;
     }
+    str++;
+  }
+
+  if (!has_digits) {
+    return 0;
+  }
+
+  if (result) {
+    *result = sign * value;
+  }
+  return 1;
+}
+
+// w/ some assumptions.
+zf_cell zf_host_parse_num(zf_ctx *ctx, const char *buf) {
+  int value = 0;
+
+  if (atoi2(buf, &value)) {
+    return (zf_cell)value;
   }
 
-  return negative ? -result : result;
+  zf_abort(ctx, ZF_ABORT_NOT_A_WORD);
+  return 0;
 }

disk/root/forth/core.f

@@ -4,24 +4,20 @@
 : emit    0 sys ;
 : .       1 sys ;
 : tell    2 sys ;
-: quit    128 sys ;
-: sin     129 sys ;
-: include 130 sys ;
-: save    131 sys ;
 
 
-( dictionary access for regular variable-length cells. These are shortcuts
-  through the primitive operations are !!, @@ and ,, )
+( dictionary access for regular variable-length cells. These are shortcuts)
+( through the primitive operations are !!, @@ and ,, )
 
 : !    0 !! ;
 : @    0 @@ ;
 : ,    0 ,, ;
 : #    0 ## ;
 
-( dictionary access for jmp instructions; these make sure to always use the
-  maximium cell size for the target address to allow safe stubbing and
-  updating of a jump address. `64` is the magic number for ZF_ACCESS_VAR_MAX,
-  see zforth.c for details )
+( dictionary access for jmp instructions; these make sure to always use the )
+( maximium cell size for the target address to allow safe stubbing and )
+( updating of a jump address. `64` is the magic number for ZF_ACCESS_VAR_MAX, )
+( see zforth.c for details )
 
 : !j	 64 !! ;
 : ,j	 64 ,, ;
@@ -34,6 +30,7 @@
 
 
 ( some operators and shortcuts )
+
 : 1+ 1 + ;
 : 1- 1 - ;
 : over 1 pick ;
@@ -52,17 +49,17 @@
 : ..   dup . ;
 : here h @ ;
 
-
 ( memory management )
 
+
 : allot  h +!  ;
 : var : ' lit , here 5 allot here swap ! 5 allot postpone ; ;
 : const : ' lit , , postpone ; ;
 : constant >r : r> postpone literal postpone ; ;
 : variable >r here r> postpone , constant ;
 
-( 'begin' gets the current address, a jump or conditional jump back is generated
-  by 'again', 'until' )
+( 'begin' gets the current address, a jump or conditional jump back is generated )
+(  by 'again', 'until' )
 
 : begin   here ; immediate
 : again   ' jmp , , ; immediate
@@ -83,10 +80,10 @@
 : times ( XT n -- ) { >r dup >r exe r> r> dup x} drop drop ;
 
 
-( 'if' prepares conditional jump, the target address '0' will later be
-  overwritten by the 'else' or 'fi' words. Note that ,j and !j are used for
-  writing the jump target address to the dictionary, this makes sure that the
-  target address is always written with the same cell size)
+( 'if' prepares conditional jump, the target address '0' will later be )
+( overwritten by the 'else' or 'fi' words. Note that ,j and !j are used for )
+( writing the jump target address to the dictionary, this makes sure that the )
+( target address is always written with the same cell size )
 
 : if      ' jmp0 , here 0 ,j ; immediate
 : unless  ' not , postpone if ; immediate
@@ -111,5 +108,4 @@
 
 ( Print string literal )
 
-: ." compiling @ if postpone s" ' tell , else begin key dup 34 = if drop exit else emit fi again
-     fi ; immediate
+: ." compiling @ if postpone s" ' tell , else begin key dup 34 = if drop exit else emit fi again fi ; immediate

disk/root/forth/dict.f

@@ -2,35 +2,12 @@
 
 ( methods for handling the dictionary )
 
-( 'next' increases the given dictionary address by the size of the cell
-  located at that address )
+( 'next' increases the given dictionary address by the size of the cell )
+(  located at that address )
 
 : next dup # + ;
 
 ( 'words' generates a list of all define words )
 
 : name dup @ 31 & swap next dup next rot tell @ ;
-: words latest @ begin name br dup 0 = until cr drop ;
-: prim? ( w -- bool ) @ 32 & ;
-: a->xt ( w -- xt ) dup dup @ 31 & swap next next + swap prim? if @ fi ;
-: xt->a ( xt -- w ) latest @ begin dup a->xt 2 pick = if swap drop exit fi next @ dup 0 = until swap drop ;
-: lit?jmp? ( a -- a boolean ) dup @ dup 1 = swap dup 18 = swap 19 = + + ;
-: disas ( a -- a ) dup dup . br br @ xt->a name drop lit?jmp? if br next dup @ . fi cr ;
-
-( 'see' needs starting address on stack: e.g. ' words see )
-: see ( xt -- ) dup xt->a name cr drop begin disas next dup @ =0 until drop ;
-
-( 'dump' memory make hex dump len bytes from addr )
-: hex_t ' lit ,  here dup , s" 0123456789abcdef" allot swap ! ; immediate
-: *hex_t hex_t ;
-: .hex *hex_t + @ emit ;
-: >nib ( n -- low high ) dup 15 & swap -16 & 16 / ;
-: ffemit ( n -- ) >nib .hex .hex ;
-: ffffemit ( n -- ) >nib >nib >nib { .hex 4 x} ;
-: @LSB ( addr -- LSB ) 2 @@ 255 & ;
-: between? ( n low_lim high_lim -- bool ) 2 pick > rot rot > & ; 
-: 8hex ( a -- a_new ) { dup @LSB ffemit 32 emit 1+ 8 x} 32 emit ;
-: 16ascii ( a -- a_new ) 124 emit { dup @LSB dup 31 127 between? if emit else drop 46 emit fi 1+ 16 x} 124 emit ;
-: .addr ( a -- ) ffffemit ."    " ;
-: 16line ( a -- a_new ) dup .addr dup { 8hex 2 x} drop 16ascii cr ;
-: dump ( addr len -- ) over + swap begin 16line over over < until drop drop ; 
+: words latest @ begin name br dup 0 = until cr drop ;

drivers/serial.c

@@ -47,7 +47,7 @@ static int serial_is_transmit_empty() {
   return port_byte_in(SERIAL_COM1 + 5) & 0x20;
 }
 
-static void serial_write(char c) {
+void serial_write(char c) {
   while (!serial_is_transmit_empty())
     ;
   port_byte_out(SERIAL_COM1, c);

drivers/serial.h

@@ -7,7 +7,7 @@ void serial_init();
 void serial_puts(const char *str);
 void serial_put_hex(uint32_t num);
 void serial_debug_impl(char *file, int line, char *message);
-
+void serial_write(char c);
 // dont use this directly
 void serial_printf(int cycl, char *file, int line, const char *fmt, ...);
 extern uint32_t tick;

kernel/kernel.c

@@ -64,61 +64,88 @@ void vfs_print_current_tree(vfs *fs);
 
 static zf_ctx *g_ctx = 0;
 
+const char *zf_result_strings[] = {"OK",
+                                   "ABORT: internal error",
+                                   "ABORT: outside memory bounds",
+                                   "ABORT: data stack underrun",
+                                   "ABORT: data stack overrun",
+                                   "ABORT: return stack underrun",
+                                   "ABORT: return stack overrun",
+                                   "ABORT: not a word",
+                                   "ABORT: compile-only word",
+                                   "ABORT: invalid size",
+                                   "ABORT: division by zero",
+                                   "ABORT: invalid user variable",
+                                   "ABORT: external error"};
+
+const char *zf_result_to_string(zf_result result) {
+  if (result >= 0 &&
+      result < sizeof(zf_result_strings) / sizeof(zf_result_strings[0])) {
+    return zf_result_strings[result];
+  }
+  return "Unknown error";
+}
+
 static void enter(const char *str) {
   if (g_ctx) {
     zf_result result = zf_eval(g_ctx, str);
 
     if (result == ZF_OK) {
       kernel_printf(" ok\n");
     } else {
-      kernel_printf(" error %d\n", result);
+      kernel_printf(" error %s\n", zf_result_to_string(result));
     }
 
     kernel_printf("> ");
   }
 }
 
 static void bootstrap_zforth(zf_ctx *ctx, vfs *unified_vfs) {
-  const char *forth_files[] = {"/fd/forth/dict.f", "/fd/forth/core.f", NULL};
-
-  uint8_t buffer[1024] = {0};
+  const char *forth_files[] = {"/fd/forth/core.f", "/fd/forth/dict.f", NULL};
 
+  uint8_t buffer[RAMDISK_MAX_FILESIZE] = {0};
   for (int file_idx = 0; forth_files[file_idx] != NULL; file_idx++) {
     const char *filepath = forth_files[file_idx];
-
+    vfs_stat stat = {0};
+    if (VFS_SUCCESS != unified_vfs->stat(unified_vfs, filepath, &stat)) {
+      kernel_printf("error: file not found: %s\n", filepath);
+      continue;
+    }
+    if (RAMDISK_MAX_FILESIZE < stat.size) {
+      kernel_printf("error: file is over 64k: %s\n", filepath);
+    }
     int fd = 0;
     if (VFS_SUCCESS !=
         unified_vfs->open(unified_vfs, filepath, VFS_READ, &fd)) {
-      kernel_printf("file not found: %s\n", filepath);
-      continue; // skip this file, try next one
+      kernel_printf("error: could not open: %s\n", filepath);
+      continue;
     }
 
     memset(buffer, 0, sizeof(buffer));
-
     int bytes_read = 0;
     int ret = unified_vfs->read(unified_vfs, fd, buffer, sizeof(buffer) - 1,
                                 buffer, &bytes_read);
 
     if (ret != VFS_SUCCESS) {
-      kernel_printf("error %d reading %s\n", ret, filepath);
       unified_vfs->close(unified_vfs, fd);
       continue;
     }
 
-    if (bytes_read > 0) {
-      buffer[bytes_read] = '\0';
+    if (bytes_read <= 0) {
+      unified_vfs->close(unified_vfs, fd);
+      continue;
     }
 
+    buffer[bytes_read] = '\0';
     unified_vfs->close(unified_vfs, fd);
 
     zf_result result = zf_eval(ctx, (char *)buffer);
     if (result != ZF_OK) {
-      kernel_printf("zforth error %d in file: %s\n", result, filepath);
-    } else {
+      kernel_printf(" error %s\n", zf_result_to_string(result));
     }
   }
 
-  kernel_printf("- zforth initialization complete\n");
+  kernel_printf("- zForth initialization complete\n");
 }
 
 void kernel_main(void) {
@@ -151,10 +178,10 @@ void kernel_main(void) {
   vfs_print_current_tree(unified_vfs);
 
   zf_ctx ctx;
-  zf_init(&ctx, 1);
+  zf_init(&ctx, 0);
   zf_bootstrap(&ctx);
   bootstrap_zforth(&ctx, unified_vfs);
-
+  serial_debug("zf inited.");
   keyboard_ctx_t *kb = get_kb_ctx();
   kb->enter_handler = enter;
   g_ctx = &ctx;