From 68ddeb3e17d10c22a17e3dc051b1cb676bcf1af4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20Hru=C5=A1ka?= Date: Sat, 13 Nov 2021 17:23:09 +0100 Subject: [PATCH] split to files --- .gitignore | 1 + CMakeLists.txt | 4 + build.sh | 3 + fh_builtins.c | 185 ++++++++++ fh_builtins.h | 12 + fh_config.h | 19 + fh_error.h | 31 ++ fh_mem.c | 82 +++++ fh_mem.h | 27 ++ fh_runtime.c | 386 +++++++++++++++++++++ fh_runtime.h | 164 +++++++++ fh_stack.c | 82 +++++ fh_stack.h | 17 + forth | Bin 0 -> 27080 bytes forth.h | 48 +++ main.c | 917 +------------------------------------------------ 16 files changed, 1065 insertions(+), 913 deletions(-) create mode 100755 build.sh create mode 100644 fh_builtins.c create mode 100644 fh_builtins.h create mode 100644 fh_config.h create mode 100644 fh_error.h create mode 100644 fh_mem.c create mode 100644 fh_mem.h create mode 100644 fh_runtime.c create mode 100644 fh_runtime.h create mode 100644 fh_stack.c create mode 100644 fh_stack.h create mode 100755 forth create mode 100644 forth.h diff --git a/.gitignore b/.gitignore index 7c4c28d..113722a 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ cmake-* *.bak .idea/ a.out +./forth diff --git a/CMakeLists.txt b/CMakeLists.txt index 5d95d5d..fb36ff9 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -5,4 +5,8 @@ set(CMAKE_C_STANDARD 99) add_executable(forth main.c + fh_builtins.c + fh_runtime.c + fh_stack.c + fh_mem.c ) diff --git a/build.sh b/build.sh new file mode 100755 index 0000000..e4411be --- /dev/null +++ b/build.sh @@ -0,0 +1,3 @@ +#!/bin/bash + +cc *.c -o forth diff --git a/fh_builtins.c b/fh_builtins.c new file mode 100644 index 0000000..7a08955 --- /dev/null +++ b/fh_builtins.c @@ -0,0 +1,185 @@ +#include +#include "forth.h" +#include "fh_runtime.h" +#include "fh_builtins.h" +#include "fh_stack.h" +#include "fh_mem.h" + +static enum fh_error w_add(struct fh_thread_s *fh) +{ + enum fh_error rv; + uint32_t a = 0, b = 0; + TRY(ds_pop(fh, &a)); + TRY(ds_pop(fh, &b)); + TRY(ds_push(fh, a + b)); + return FH_OK; +} + +static enum fh_error w_sub(struct fh_thread_s *fh) +{ + enum fh_error rv; + uint32_t a = 0, b = 0; + TRY(ds_pop(fh, &a)); + TRY(ds_pop(fh, &b)); + TRY(ds_push(fh, a - b)); + return FH_OK; +} + +static enum fh_error w_mul(struct fh_thread_s *fh) +{ + enum fh_error rv; + uint32_t a = 0, b = 0; + TRY(ds_pop(fh, &a)); + TRY(ds_pop(fh, &b)); + TRY(ds_push(fh, a * b)); + return FH_OK; +} + +static enum fh_error w_colon(struct fh_thread_s *fh) +{ + if (fh->state != FH_STATE_INTERPRET) { + return FH_ERR_INVALID_STATE; + } + + fh_setstate(fh, FH_STATE_COMPILE, FH_SUBSTATE_COLONNAME); + + if (fh->dict_top >= DICT_SIZE) { + return FH_ERR_DICT_FULL; + } + fh->dict[fh->dict_top].start = fh->compile_top; + fh->dict[fh->dict_top].handler = w_user_word; + return FH_OK; +} + +static enum fh_error w_semicolon(struct fh_thread_s *fh) +{ + enum fh_error rv; + struct fh_instruction_s instr; + + if (fh->state != FH_STATE_COMPILE) { + return FH_ERR_INVALID_STATE; + } + + instr.kind = FH_INSTR_WORD; + instr.data = CPLWORD_ENDWORD; + TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); + + /* Return to interpret state */ + fh_setstate(fh, FH_STATE_INTERPRET, 0); + fh->dict_top++; + return FH_OK; +} + +static enum fh_error w_dot(struct fh_thread_s *fh) +{ + enum fh_error rv; + uint32_t a = 0; + TRY(ds_pop(fh, &a)); + + FHPRINT("%d ", (int32_t) a); + return FH_OK; +} + +static enum fh_error w_type(struct fh_thread_s *fh) +{ + enum fh_error rv; + uint32_t count = 0, addr = 0; + TRY(ds_pop(fh, &count)); + TRY(ds_pop(fh, &addr)); + + FHPRINT("%.*s", count, &fh->heap[addr]); + return FH_OK; +} + +static enum fh_error w_cr(struct fh_thread_s *fh) +{ + (void) fh; + FHPRINT("\n"); + return FH_OK; +} + +static enum fh_error w_space(struct fh_thread_s *fh) +{ + (void) fh; + FHPRINT(" "); + return FH_OK; +} + +static enum fh_error w_s_quote(struct fh_thread_s *fh) +{ + fh_setsubstate(fh, FH_SUBSTATE_SQUOTE); + return FH_OK; +} + +static enum fh_error w_dot_quote(struct fh_thread_s *fh) +{ + fh_setsubstate(fh, FH_SUBSTATE_DOTQUOTE); + return FH_OK; +} + +static enum fh_error w_backslash(struct fh_thread_s *fh) +{ + fh_setsubstate(fh, FH_SUBSTATE_LINECOMMENT); + return FH_OK; +} + +static enum fh_error w_paren(struct fh_thread_s *fh) +{ + fh_setsubstate(fh, FH_SUBSTATE_PARENCOMMENT); + return FH_OK; +} + +static enum fh_error w_bye(struct fh_thread_s *fh) +{ + LOG("state=SHUTDOWN"); + fh_setstate(fh, FH_STATE_SHUTDOWN, 0); + return FH_OK; +} + +/** Add pointers to built-in word handlers to a runtime struct */ +enum fh_error register_builtin_words(struct fh_thread_s *fh) +{ + struct name_and_handler { + const char *name; + word_exec_t handler; + bool immediate; + }; + + const struct name_and_handler builtins[] = { + {"s\"", w_s_quote, 1}, + {".\"", w_dot_quote, 1}, + /* Compiler control words */ + {"bye", w_bye, 0}, + /* Basic arithmetics */ + {"+", w_add, 0}, + {"-", w_sub, 0}, + {"*", w_mul, 0}, + /* Control words */ + {":", w_colon, 0}, + {";", w_semicolon, 1}, + {".", w_dot, 0}, + {"type", w_type, 0}, + {"cr", w_cr, 0}, + {"space", w_space, 0}, + {"\\", w_backslash, 0}, // line comment + {"(", w_paren, 0}, // enclosed comment + { /* end marker */ } + }; + + // foreach + struct fh_word_s w; + const struct name_and_handler *p = builtins; + enum fh_error rv; + while (p->handler) { + strcpy(w.name, p->name); + w.handler = p->handler; + w.builtin = 1; + w.immediate = p->immediate; + rv = fh_add_word(&w, fh); + if (rv != FH_OK) { + return rv; + } + p++; + } + return FH_OK; +} diff --git a/fh_builtins.h b/fh_builtins.h new file mode 100644 index 0000000..02e00d5 --- /dev/null +++ b/fh_builtins.h @@ -0,0 +1,12 @@ +/** + * Forth built-ins + * + * Created on 2021/11/13. + */ + +#ifndef FORTH_FH_BUILTINS_H +#define FORTH_FH_BUILTINS_H + +enum fh_error register_builtin_words(struct fh_thread_s *fh); + +#endif //FORTH_FH_BUILTINS_H diff --git a/fh_config.h b/fh_config.h new file mode 100644 index 0000000..68ff300 --- /dev/null +++ b/fh_config.h @@ -0,0 +1,19 @@ +/** + * Runtime configuration + * + * Created on 2021/11/13. + */ + +#ifndef FORTH_FH_CONFIG_H +#define FORTH_FH_CONFIG_H + +#define CONTROL_STACK_DEPTH 1024 +#define DATA_STACK_DEPTH 1024 +#define RETURN_STACK_DEPTH 1024 +#define MAX_NAME_LEN 32 +#define DICT_SIZE 1024 +#define COMPILED_BUFFER_SIZE (1024*1024) +#define HEAP_SIZE (1024*1024) +#define MAXLINE 65535 + +#endif //FORTH_FH_CONFIG_H diff --git a/fh_error.h b/fh_error.h new file mode 100644 index 0000000..0564437 --- /dev/null +++ b/fh_error.h @@ -0,0 +1,31 @@ +/** + * Forth errors + * + * Created on 2021/11/13. + */ + +#ifndef FORTH_FH_ERROR_H +#define FORTH_FH_ERROR_H + +/** Error codes */ +enum fh_error { + FH_OK = 0, + FH_ERR_CS_OVERFLOW, + FH_ERR_DS_OVERFLOW, + FH_ERR_RS_OVERFLOW, + FH_ERR_CS_UNDERFLOW, + FH_ERR_DS_UNDERFLOW, + FH_ERR_RS_UNDERFLOW, + FH_ERR_HEAP_FULL, + FH_ERR_DICT_FULL, + FH_ERR_COMPILE_FULL, + FH_ERR_NAME_TOO_LONG, + FH_ERR_INVALID_STATE, + FH_ERR_INTERNAL, + FH_ERR_UNKNOWN_WORD, + FH_ERR_MAX, +}; + +const char *fherr_name(enum fh_error e); + +#endif //FORTH_FH_ERROR_H diff --git a/fh_mem.c b/fh_mem.c new file mode 100644 index 0000000..706e193 --- /dev/null +++ b/fh_mem.c @@ -0,0 +1,82 @@ +#include +#include "forth.h" +#include "fh_runtime.h" +#include "fh_mem.h" + +/** Allocate a heap region, e.g. for a string. The address is stored to `addr` */ +enum fh_error fh_heap_reserve( + struct fh_thread_s *fh, + size_t len, + uint32_t *addr +) +{ + uint32_t p = WORDALIGNED(fh->heap_top); // FIXME this shouldn't be needed + + if (p + len > HEAP_SIZE) { + return FH_ERR_HEAP_FULL; + } + + *addr = p; + + fh->heap_top = WORDALIGNED(p + len); + + return FH_OK; +} + +/** Write bytes to heap at a given location. The region must have been previously allocated! */ +void fh_heap_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint32_t len) +{ + memcpy(&fh->heap[addr], src, len); +} + +/** Allocate heap region and write bytes to it */ +enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len) +{ + enum fh_error rv; + uint32_t addr; + TRY(fh_heap_reserve(fh, len, &addr)); + fh_heap_write(fh, addr, src, len); + return FH_OK; +} + +/** Copy bytes from compile area to heap. The region must have been previously allocated! */ +void fh_heap_copy_from_compile(struct fh_thread_s *fh, uint32_t addr, uint32_t srcaddr, uint32_t len) +{ + memcpy(&fh->heap[addr], &fh->compile[srcaddr], len); +} + +/** Reserve space in the compile memory area */ +enum fh_error fh_compile_reserve( + struct fh_thread_s *fh, + size_t len, + uint32_t *addr +) +{ + uint32_t p = WORDALIGNED(fh->compile_top); // FIXME this shouldn't be needed + + if (p + len > COMPILED_BUFFER_SIZE) { + return FH_ERR_HEAP_FULL; + } + + *addr = p; + + fh->compile_top = WORDALIGNED(p + len); + + return FH_OK; +} + +/** Write bytes to compile area at a given location. The region must have been previously allocated! */ +void fh_compile_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint32_t len) +{ + memcpy(&fh->compile[addr], src, len); +} + +/** Allocate compile region and write bytes to it */ +enum fh_error fh_compile_put(struct fh_thread_s *fh, const void *src, uint32_t len) +{ + enum fh_error rv; + uint32_t addr; + TRY(fh_compile_reserve(fh, len, &addr)); + fh_compile_write(fh, addr, src, len); + return FH_OK; +} diff --git a/fh_mem.h b/fh_mem.h new file mode 100644 index 0000000..096a569 --- /dev/null +++ b/fh_mem.h @@ -0,0 +1,27 @@ +/** + * Forth heap and compile memory + * + * Created on 2021/11/13. + */ + +#ifndef FORTH_FH_MEM_H +#define FORTH_FH_MEM_H + +enum fh_error fh_heap_reserve( + struct fh_thread_s *fh, + size_t len, + uint32_t *addr +); +void fh_heap_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint32_t len); +enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len); +void fh_heap_copy_from_compile(struct fh_thread_s *fh, uint32_t addr, uint32_t srcaddr, uint32_t len); + +enum fh_error fh_compile_reserve( + struct fh_thread_s *fh, + size_t len, + uint32_t *addr +); +void fh_compile_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint32_t len); +enum fh_error fh_compile_put(struct fh_thread_s *fh, const void *src, uint32_t len); + +#endif //FORTH_FH_MEM_H diff --git a/fh_runtime.c b/fh_runtime.c new file mode 100644 index 0000000..3d4cb39 --- /dev/null +++ b/fh_runtime.c @@ -0,0 +1,386 @@ +#include "forth.h" +#include "fh_runtime.h" +#include "fh_builtins.h" +#include "fh_stack.h" +#include "fh_mem.h" +#include +#include +#include + +struct fh_global_s fh_globals = {}; + +/** Error names */ +static const char *errornames[] = { + [FH_OK] = "OK", + [FH_ERR_CS_OVERFLOW] = "CS_OVERFLOW", + [FH_ERR_DS_OVERFLOW] = "DS_OVERFLOW", + [FH_ERR_RS_OVERFLOW] = "RS_OVERFLOW", + [FH_ERR_CS_UNDERFLOW] = "CS_UNDERFLOW", + [FH_ERR_DS_UNDERFLOW] = "DS_UNDERFLOW", + [FH_ERR_RS_UNDERFLOW] = "RS_UNDERFLOW", + [FH_ERR_HEAP_FULL] = "HEAP_FULL", + [FH_ERR_DICT_FULL] = "DICT_FULL", + [FH_ERR_COMPILE_FULL] = "COMPILE_FULL", + [FH_ERR_NAME_TOO_LONG] = "NAME_TOO_LONG", + [FH_ERR_INVALID_STATE] = "INVALID_STATE", + [FH_ERR_INTERNAL] = "INTERNAL", + [FH_ERR_UNKNOWN_WORD] = "UNKNOWN_WORD", +}; + +/** Get error name from code, returns Unknown if not defined */ +const char *fherr_name(enum fh_error e) +{ + if (e >= FH_ERR_MAX) { + return "Unknown"; + } + return errornames[e]; +} + +/** State names */ +static const char *statenames[] = { + [FH_STATE_INTERPRET] = "INTERPRET", + [FH_STATE_COMPILE] = "COMPILE", + [FH_STATE_SHUTDOWN] = "SHUTDOWN", +}; + + +/** Sub-state names */ +static const char *substatenames[] = { + [FH_SUBSTATE_NONE] = "NONE", + [FH_SUBSTATE_COLONNAME] = "COLONNAME", + [FH_SUBSTATE_SQUOTE] = "SQUOTE", + [FH_SUBSTATE_DOTQUOTE] = "DOTQUOTE", + [FH_SUBSTATE_PARENCOMMENT] = "PARENCOMMENT", + [FH_SUBSTATE_LINECOMMENT] = "LINECOMMENT", +}; + +/** Add a word to the dictionary. */ +enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh) +{ + if (fh->dict_top == DICT_SIZE) { + return FH_ERR_DICT_FULL; + } + memcpy(&fh->dict[fh->dict_top++], w, sizeof(struct fh_word_s)); + return FH_OK; +} + +/** Log current runtime state */ +static void showstate(const struct fh_thread_s *fh) +{ + if (fh->substate == 0) { + LOG("state = %s", statenames[fh->state]); + } else { + LOG("state = %s.%s", statenames[fh->state], substatenames[fh->substate]); + } +} + +/** Set runtime state and sub-state */ +void fh_setstate(struct fh_thread_s *fh, enum fh_state state, enum fh_substate substate) +{ + fh->state = state; + fh->substate = substate; + showstate(fh); +} + +/** Set runtime sub-state (state is unchanged) */ +void fh_setsubstate(struct fh_thread_s *fh, enum fh_substate substate) +{ + fh->substate = substate; + showstate(fh); +} + +enum fh_error w_user_word(struct fh_thread_s *fh) +{ + enum fh_error rv; + const struct fh_word_s *w; + const struct fh_word_s *w2; + uint32_t wn; + + call: + w = fh->exec_word; + if (!w) { return FH_ERR_INTERNAL; } + + LOG("Run user word: %s", w->name); + + TRY(rs_push(fh, fh->execptr)); + fh->execptr = w->start; + + instr:; + // make sure it's aligned + fh->execptr = WORDALIGNED(fh->execptr); + const struct fh_instruction_s *instr = (const struct fh_instruction_s *) &fh->compile[fh->execptr]; + fh->execptr += sizeof(struct fh_instruction_s); + + uint32_t strl; + uint32_t addr = 0; + switch (instr->kind) { + case FH_INSTR_NUMBER: + TRY(ds_push(fh, instr->data)); + goto instr; + + case FH_INSTR_WORD: + wn = instr->data; + switch (wn) { + /* special case for strings stored in compile memory */ + case CPLWORD_ALLOCSTR: + case CPLWORD_TYPESTR: + strl = *((uint32_t *) &fh->compile[fh->execptr]); + LOG("strl %d", strl); + fh->execptr += 4; // advance past the length + if (wn == CPLWORD_ALLOCSTR) { + TRY(fh_heap_reserve(fh, strl, &addr)); + fh_heap_copy_from_compile(fh, addr, fh->execptr, strl); + LOG("Exec: alloc-str \"%.*s\"", strl, &fh->heap[addr]); + TRY(ds_push(fh, addr)); + TRY(ds_push(fh, strl)); + fh->execptr += strl; + } else { + FHPRINT("%.*s", (int) strl, &fh->compile[fh->execptr]); + LOG("Exec: type-str \"%.*s\"", strl, &fh->compile[fh->execptr]); + } + goto instr; + + case CPLWORD_ENDWORD: + LOG("Exec: word-end (RETURN)"); + TRY(rs_pop(fh, &fh->execptr)); + if (fh->execptr == MAGICADDR_INTERACTIVE) { + goto end; + } + goto instr; + + default: + w2 = &fh->dict[instr->data]; + if (w2->builtin) { + LOG("Exec: builtin-word %s", w2->name); + w2->handler(fh); + goto instr; + } else { + LOG("Exec: user-word %s (CALL)", w2->name); + fh->exec_word = &fh->dict[instr->data]; + goto call; + } + } + } + + end: + return FH_OK; +} + + +/** Initialize a runtime */ +enum fh_error fh_init_thread(struct fh_thread_s *fh) +{ + enum fh_error rv; + + /* Make sure we have a clean state */ + memset(fh, 0, sizeof(struct fh_thread_s)); + + TRY(register_builtin_words(fh)); + + fh->execptr = MAGICADDR_INTERACTIVE; + return FH_OK; +} + +/** Process a quoted string read from input */ +static enum fh_error fh_handle_quoted_string( + struct fh_thread_s *fh, + char *start, + size_t len +) +{ + enum fh_error rv; + uint32_t addr = 0; + struct fh_instruction_s instr; + + if (fh->state == FH_STATE_INTERPRET) { + switch (fh->substate) { + case FH_SUBSTATE_SQUOTE: + TRY(fh_heap_put(fh, start, len)); + TRY(ds_push(fh, addr)); + TRY(ds_push(fh, len)); + break; + case FH_SUBSTATE_DOTQUOTE: + FHPRINT("%.*s", (int) len, start); + break; + + default: + LOGE("Bad substate in interpret mode: %s", substatenames[fh->substate]); + } + } else { + LOG("Compile a string"); + /* compile */ + if (fh->substate == FH_SUBSTATE_SQUOTE) { + instr_init(&instr, FH_INSTR_WORD, CPLWORD_ALLOCSTR); + } else { + instr_init(&instr, FH_INSTR_WORD, CPLWORD_TYPESTR); + } + uint32_t len32 = len; + /* string is encoded as a special compiler command, the size, + * and then the string, all 4-byte aligned. */ + TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); + + TRY(fh_compile_reserve(fh, len + 4, &addr)); + fh_compile_write(fh, addr, &len32, 4); + fh_compile_write(fh, addr + 4, start, len); + } + return FH_OK; +} + +/** Process a word read from input */ +static enum fh_error fh_handle_word( + struct fh_thread_s *fh, + char *start, + size_t len +) +{ + if (len >= MAX_NAME_LEN) { + return FH_ERR_NAME_TOO_LONG; + } + + /* First, try if it's a known word */ + // TODO we could use binary search if the dict was ordered + struct fh_word_s *w = &fh->dict[0]; + struct fh_instruction_s instr; + uint32_t cnt = 0; + enum fh_error rv; + while (w->handler) { + if (0 == strncasecmp(start, w->name, len) && w->name[len] == 0) { + // word found! + if (fh->state == FH_STATE_COMPILE && !w->immediate) { + LOG("Compile word call: %s", w->name); + instr_init(&instr, FH_INSTR_WORD, cnt); + TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); + } else { + /* interpret */ + LOG("Interpret word: %s", w->name); + fh->exec_word = w; + TRY(w->handler(fh)); + } + return FH_OK; + } + w++; + cnt++; + } + + /* word not found, try parsing as number */ + errno = 0; + char *endptr; + long v = strtol(start, &endptr, 0); + if (errno != 0 || endptr == start) { + LOGE("Unknown word and fail to parse as number: %.*s", (int) len, start); + return FH_ERR_UNKNOWN_WORD; + } + + if (fh->state == FH_STATE_COMPILE) { + LOG("Compile number: %ld", v); + instr_init(&instr, FH_INSTR_NUMBER, (uint32_t) v); + TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); + } else { + /* interpret */ + LOG("Interpret number: %ld", v); + TRY(ds_push(fh, (uint32_t) v)); + } + + return FH_OK; +} + +/** True if the character is CR or LF */ +static inline bool isnl(char c) +{ + return c == '\n' || c == '\r'; +} + +/** Process a line read from input */ +enum fh_error fh_process_line(struct fh_thread_s *fh, char *linebuf) +{ + enum fh_error rv; + char *rp = linebuf; + char c; + + if (!fh_globals.interactive) { + LOGI("%s", linebuf); + } + + while (0 != (c = *rp) && fh->state != FH_STATE_SHUTDOWN) { + /* end on newline */ + if (isnl(c)) { + goto done; + } + /* skip whitespace */ + if (isspace(c)) { + rp++; + continue; + } + + char *end; + size_t length; + switch (fh->substate) { + case FH_SUBSTATE_NONE: + case FH_SUBSTATE_COLONNAME: + /* try to read a word */ + end = strchr(rp, ' '); + if (end) { + length = end - rp; /* exclude the space */ + } else { + length = strlen(rp); + } + + if (fh->substate == FH_SUBSTATE_NONE) { + /* eval a word */ + LOG("Handle \"%.*s\"", (int) length, rp); + TRY(fh_handle_word(fh, rp, length)); + } else { + /* new word's name is found */ + LOG("New word name = \"%.*s\"", (int) length, rp); + strncpy(fh->dict[fh->dict_top].name, rp, length); + fh_setsubstate(fh, FH_SUBSTATE_NONE); + } + + if (end) { + rp = end + 1; + } else { + goto done; + } + break; + + case FH_SUBSTATE_SQUOTE: + case FH_SUBSTATE_DOTQUOTE: + end = strchr(rp, '"'); + if (end) { + length = end - rp; + LOG("Quoted string: \"%.*s\"", (int) length, rp); + TRY(fh_handle_quoted_string(fh, rp, length)); + fh_setsubstate(fh, FH_SUBSTATE_NONE); + rp = end + 1; + } else { + /* no end. this is weird. */ + LOGE("Unterminated quoted string!"); + goto done; + } + break; + + case FH_SUBSTATE_PARENCOMMENT: + end = strchr(rp, ')'); + if (end) { + LOG("Discard inline comment"); + fh_setsubstate(fh, FH_SUBSTATE_NONE); + rp = end + 1; + } else { + /* no end, discard all */ + LOGE("Unterminated parenthesis comment"); + goto done; + } + break; + + case FH_SUBSTATE_LINECOMMENT: + LOG("Discard line comment"); + goto done; // just discard the rest + + default: + LOGE("Bad substate %s", substatenames[fh->substate]); + } + } + done: + LOG("Line done."); + return FH_OK; +} diff --git a/fh_runtime.h b/fh_runtime.h new file mode 100644 index 0000000..605116d --- /dev/null +++ b/fh_runtime.h @@ -0,0 +1,164 @@ +/** + * Forth runtime internals + * + * Created on 2021/11/13. + */ + +#ifndef FORTH_FH_RUNTIME_H +#define FORTH_FH_RUNTIME_H + +#include +#include + +/** Bytecode instruction type marker */ +enum fb_instruction_kind { + /* Data = word pointer (dict index) */ + FH_INSTR_WORD, + + /* Data = numeric value to push onto the data stack */ + FH_INSTR_NUMBER, +}; + +/** Bytecode word indices that are not in the dict, have special effect */ +enum compiler_word { + /** End of a user defined word, pop address and jump back */ + CPLWORD_ENDWORD = DICT_SIZE + 1, + /** This is the `s"` instruction, the length (u32) and string data immediately follow */ + CPLWORD_ALLOCSTR, + /** This is the `."` instruction, same format as above. */ + CPLWORD_TYPESTR, +}; + +/** One instruction in bytecode */ +struct fh_instruction_s { + /** What is the meaning of data? */ + enum fb_instruction_kind kind; + /** Data word */ + uint32_t data; +}; + +static inline void instr_init(struct fh_instruction_s *instr, enum fb_instruction_kind kind, uint32_t data) +{ + instr->kind = kind; + instr->data = data; +} + +#define INSTR_SIZE (sizeof(struct fh_instruction_s)) + +_Static_assert(sizeof(struct fh_instruction_s) % 4 == 0, "Instruction struct is aligned"); + +/** Forth runtime major state */ +enum fh_state { + FH_STATE_INTERPRET = 0, + FH_STATE_COMPILE, + FH_STATE_SHUTDOWN, + FH_STATE_MAX, +}; + +/** Forth runtime minor state */ +enum fh_substate { + FH_SUBSTATE_NONE = 0, + FH_SUBSTATE_COLONNAME, + FH_SUBSTATE_SQUOTE, + FH_SUBSTATE_DOTQUOTE, + FH_SUBSTATE_PARENCOMMENT, + FH_SUBSTATE_LINECOMMENT, + FH_SUBSTATE_MAX, +}; + +/** Word struct as they are stored in the dictionary */ +struct fh_word_s { + /** Word name */ + char name[MAX_NAME_LEN]; + /** + * Handler function. + * Builtin functions use pre-defined native handlers. + * User words use a shared handler that executes compiled + * bytecode at 'start' address of the compile-memory area. + */ + word_exec_t handler; + /** Indicates that this is a built-in instruction and not a word call */ + bool builtin; + /** Indicates that this instruction should always be treated as interpreted, + * in practice this is only used for `;` */ + bool immediate; + /** Start address in case of user words */ + uint32_t start; +}; + +/** + * Forth runtime instance - state variables and memory areas. + * + * Some memory areas, such as the dict or heap, could be moved + * to a shared pointer if multi-threading and synchronization is added. + */ +struct fh_thread_s { + /** Control stack */ + uint32_t control_stack[CONTROL_STACK_DEPTH]; + size_t control_stack_top; + size_t control_stack_hwm; + + /** Data stack */ + uint32_t data_stack[DATA_STACK_DEPTH]; + size_t data_stack_top; + size_t data_stack_hwm; + + /** Return stack */ + uint32_t return_stack[RETURN_STACK_DEPTH]; + size_t return_stack_top; + size_t return_stack_hwm; + + /** Data heap */ + uint8_t heap[HEAP_SIZE]; + size_t heap_top; + + /** Compile buffer, used for both word data and literals */ + uint8_t compile[COMPILED_BUFFER_SIZE]; + size_t compile_top; + /** Pointer into the compile buffer for execution */ + uint32_t execptr; + + /** Word dict */ + struct fh_word_s dict[DICT_SIZE]; + uint32_t dict_top; + + /** Forth state */ + enum fh_state state; + + /** Forth sub-state */ + enum fh_substate substate; + + /** Word currently being executed - a pointer is placed here + * before calling the handler */ + struct fh_word_s *exec_word; +}; + +enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh); + +void fh_setstate(struct fh_thread_s *fh, enum fh_state state, enum fh_substate substate); +void fh_setsubstate(struct fh_thread_s *fh, enum fh_substate substate); + +enum fh_error w_user_word(struct fh_thread_s *fh); + +/* if the return address is this, we should drop back to interactive mode */ +#define MAGICADDR_INTERACTIVE 0xFFFFFFFFULL + +/** Get a value rounded up to multiple of word size */ +#define WORDALIGNED(var) (((var) + 3) & ~3) + +_Static_assert(WORDALIGNED(0) == 0, "word align"); +_Static_assert(WORDALIGNED(1) == 4, "word align"); +_Static_assert(WORDALIGNED(2) == 4, "word align"); +_Static_assert(WORDALIGNED(3) == 4, "word align"); +_Static_assert(WORDALIGNED(4) == 4, "word align"); +_Static_assert(WORDALIGNED(5) == 8, "word align"); +_Static_assert(WORDALIGNED(1023) == 1024, "word align"); +_Static_assert(WORDALIGNED(1024) == 1024, "word align"); + +#define TRY(x) \ + do { \ + if (FH_OK != (rv = (x))) return rv; \ + } while (0) + + +#endif //FORTH_FH_RUNTIME_H diff --git a/fh_stack.c b/fh_stack.c new file mode 100644 index 0000000..1898550 --- /dev/null +++ b/fh_stack.c @@ -0,0 +1,82 @@ +#include "forth.h" +#include "fh_runtime.h" +#include "fh_stack.h" + +/** Pop from data stack */ +enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out) +{ + if (fh->data_stack_top == 0) { + LOG("DS pop UNDERFLOW"); + return FH_ERR_DS_UNDERFLOW; + } + *out = fh->data_stack[--fh->data_stack_top]; + LOG("DS pop %d", *out); + return FH_OK; +} + +/** Pop from return stack */ +enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out) +{ + if (fh->return_stack_top == 0) { + LOG("RS pop UNDERFLOW"); + return FH_ERR_RS_UNDERFLOW; + } + *out = fh->return_stack[--fh->return_stack_top]; + LOG("RS pop %d", *out); + return FH_OK; +} + +/** Pop from control stack */ +enum fh_error cs_pop(struct fh_thread_s *fh, uint32_t *out) +{ + if (fh->control_stack_top == 0) { + LOG("CS pop UNDERFLOW"); + return FH_ERR_CS_UNDERFLOW; + } + *out = fh->control_stack[--fh->control_stack_top]; + LOG("CS pop %d", *out); + return FH_OK; +} + +#define UPDATE_HWM(hwm, top) \ + do { \ + if((hwm) < (top)) { \ + (hwm) = (top); \ + } \ + } while(0) + +/** Push to data stack */ +enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in) +{ + LOG("DS push %d", in); + if (fh->data_stack_top == DATA_STACK_DEPTH) { + return FH_ERR_DS_OVERFLOW; + } + fh->data_stack[fh->data_stack_top++] = in; + UPDATE_HWM(fh->data_stack_hwm, fh->data_stack_top); + return FH_OK; +} + +/** Push to return stack */ +enum fh_error rs_push(struct fh_thread_s *fh, uint32_t in) +{ + LOG("RS push %d", in); + if (fh->return_stack_top == RETURN_STACK_DEPTH) { + return FH_ERR_RS_OVERFLOW; + } + fh->return_stack[fh->return_stack_top++] = in; + UPDATE_HWM(fh->return_stack_hwm, fh->return_stack_top); + return FH_OK; +} + +/** Push to control stack */ +enum fh_error cs_push(struct fh_thread_s *fh, uint32_t in) +{ + LOG("CS push %d", in); + if (fh->control_stack_top == CONTROL_STACK_DEPTH) { + return FH_ERR_CS_OVERFLOW; + } + fh->control_stack[fh->control_stack_top++] = in; + UPDATE_HWM(fh->control_stack_hwm, fh->control_stack_top); + return FH_OK; +} diff --git a/fh_stack.h b/fh_stack.h new file mode 100644 index 0000000..f5f7584 --- /dev/null +++ b/fh_stack.h @@ -0,0 +1,17 @@ +/** + * Forth internal stack operations + * + * Created on 2021/11/13. + */ + +#ifndef FORTH_FH_STACK_H +#define FORTH_FH_STACK_H + +enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out); +enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out); +enum fh_error cs_pop(struct fh_thread_s *fh, uint32_t *out); +enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in); +enum fh_error rs_push(struct fh_thread_s *fh, uint32_t in); +enum fh_error cs_push(struct fh_thread_s *fh, uint32_t in); + +#endif //FORTH_FH_STACK_H diff --git a/forth b/forth new file mode 100755 index 0000000000000000000000000000000000000000..86a2b5d0c2308c5c5aadb37c2734e1b8e8d88690 GIT binary patch literal 27080 zcmeHw4R}=5ng5-T(HKc4Drl-GBT5A!F@RV;YXTX((R>*b(G{Hx$%LdPnK&POD74WK zWgMrQzltAScT2nOmVecMt-2UdF!({R(i&UWMx`1Rb!L;=)S``D%Ixob&pCJQTr$+{ z?z8*+pNIP}_dVzRI`4VUdp_>DH;3=I%2#CAY?`_zXy4Q*S9FTN6ib4>S|$LBwFO!Z z?&oM{YbPL|$v8nT764Rn4Q8amEQy~0NOJj<7za)fXiY(7AwiN$cXdt_6a}?BktaDj zC1u_U=U*WB6jXGhykbE&Dkk&2vOERNa^#y>g^-I~p9;6jddDPGa^xt*!b6!S1sjQT|$o)24(#e zROMX>Ir7U_y;L*T$nw&)L%xhp1!eKtMXfEXFS+=l*2aR?miEy4g7ph7DY)d~!ho-E zE}KAh72!uQby;PdmeHy85l+e5G+RnOL*~K47x7NQkK9i3TR(k&YyAb6eerB!Ny~jl z{99f>@72k~L-in?#6uV1=%+3+|8)F_hy7!7YMq+KwIX~|ohNVMXA#wnfJwcokUcdO z#kt%x_(Q-unIrW^<&UT5;xzb@G3H26GJ%n6$HDga_U zJL}WnH>SZ;KO9fbmNfXOY3%t2@K3|fdaVIsJpDA>ouYkB+vX7xYCH%@e4hoc1%m#D zjtyFqufy9;nRd##-GQK|;YN2u^NsE%PfIHZjV(+L`dYP?fF~G)$Qo}jKq9S>Z1c7S zyg>+h{r+~JyVcj=3AXqcFBCQeH*|R2tBFF|z$Qxb1iTGx9a_^me@oCysD@_0*3{u| zX%99*UBh~hyQ!t!)7o;g7g_Y)2C~f`bhmk65#_1#UZP!AUbbwxdv4)8BQ@t@BbiLi zEu62p%W5m!u)w>fB@p!bYb%zw`r5s5CiRlxxcV#|wX3I&WGlo1} zYW`8}?36(NDZbP)NZ1dXYI1 zz$TJ>ch-vx;pGy65i?A9^E_N+!c*DmT2L=iq=)BcNhmhqiKZ^SUZe=8`Xphh>*=m( zgh$6Vu50Q=lJF-RSWT-p;pGyQsm&%l&GG8$s23^H<4{Pz_4Oh{cr_Lgrn8>z!X7zf zaDGcY1GdvV@AR1PlLgE1`*9B(_rU+M2matV=TCaqNR}S4zlCQ3y}K`%kr>dsUdnor zElbS*0O-W@gSb1U79&OZW}?N161b+nO?etR;{%-kCFN>`P(Q@Lt@;?`I{+EQ%*dO^M1Ki~KSD%y^ za!l=nZtX=0!T%)+)T8r1BQW!b9v;>Ae0r(AXKaFQ+pE8RBsd8Q=1T=xiJ>OP)Y7Cp z+1I)Bw~*CB^Xl}jrKf^Z)59MHbM(m49mpgmYq-Z6P`SPKm%wPd{>7$3$JEVahW27p zGEMDG`r>QATL&Eolp;O6X|Pd`WKN&KdR=34`ubfXB--y9C7?&^M)ZhlP!GSUhx=o< zouz4E*P*UWhqRzQ;yN^ZIT%Jw3?3`P%t+lx#5HPrftaL{vn@*Oy)VH87>rFb^K%?>DF0a&D3iSo7|d*02qUcu}Ek6s8d4_XZLdNq9NZ_y!r;r$>8=iiD^1=)?>JDoj6*O`qRBlT7ayc01D9z2i%h<79-| z-@lwh_w1zT6!93f7YcQ;$x4$E8%pYtailV()O#p~EwM_u#&*+;M{WKH;vyXn&4R>p z$1!+lCM2GQWAM=INj#U1&*Ru(|FlfgHunY3gCpNYlHA~ckaEMN7`#bAE-HjT8WUlw zs_+LdQ^BH7NFw8-_|3X&?9-E)RQm7?5cl(q@opP>EZ595chU( z!5u>u3psWa=WXc@lTc(U#X+iyB7}ChyB7GaU3AxiSrN_-pR0GVf_!rc-F=SkcGR51 zhDLJpEFS;d=*$=a^>AoN57!MMOk;Yav#2Of>*|}(HFP-aIvlAx4D^t08_<{1<0)pA z6A^;Lg}@Gi7|t_sKuU+09;Ue(YBA>Ii7>xjEg76Nw}nH8P+lxtF&e2G#ezkTZjqzY zm~Pu6WHCRz7W)D0>@h|H8ZFt_aNPk*ABj{PkOLtYc=DKvx~GhkXGKDz#1^R=5+(G< zC{D)p&nt%v|8$Kglf!kR;R-C9Mqsoay_4!je${P1)1&^ZNFAyHBm$6;uag&0g?FJ! zRpDq~)5QGW?07Q(4=K?2`bXZDDyg*P4U+H^Q)?Mdi}z2_kqPmj0`>(NOsBQP-++pkzojgXmP zI6_Q3;SlK@jdb!d2^+gwNG_AEOyZ+Dx+4m^lbEOl2YB%_z>A+~PcfWK%+w!*>&AAX z$uSDE|9<~j+Sx18Sq+WdeW6Os9Z$f*&3%r||45=#PhRNJG;LJki)BQbl!58x7OGD) zXU2I{4h1(ibF2}C4L3qtBWnv@D>P9tDVh$jrisurZb8vxL8o#-^Ix4t1<6v5{5~1K zT_fyCbYD~Z^w1iWb;E5vR61p7>iZI-lnVW%s9-&m%KD2G)?#$@eU=^$v3(evt|9$l z3`kv@hO|&NzY~tPp)KKuRj3JO0MJ7OckTigH;x zT21{<3ii7OICRkwBedL~hjp@}`|b%`ek@X*$*laW_YT$=(n`l>ANmtn+NL;*GsCXI zTQ?2TirTR`fhC2?+}4nxX&AB#GC(5rchmrpv}ZhvBPi(r{F+(9emxgH9W92II*heB z`llWvvO6E?HYU;~xv=>7n;6eINjm8_QeSUIFP{vVWOEFB3A@UTt%7_zaH zfJryO4m9=Lh-*MvE-FKdTbNm<%$$EAn<-;?E^Lg{aoM8Hqq&ARMVp^TUPAq-Y1rR4 zS~+Z~#<>pgL$qwj_-|-kU^MbkPQ{SH+U?sfg}u@F4^Jg0O6%_Zl&f|hNHjLw{TEfC zqV-_r_L$#nR#gU7@hhPKu3EwRc%3>INm{4oqaD;b^)ewBYk~+jiZRH+-|T`;n@5UQ1KyJZ&3^*4AYIArryA#F%~^D(2&bv=-+?S=)NG?yOBkl^_@dD zC%bR^Z@Ca~R6E(;aDU>LaW9I7ioZ!!u}rAA*P>#UQ1O@Tl$}%$_t3Bt-+<+4&$#P_ z2S<$gORN{Dr^j~ILuxlXLv0+}3Le5zIt%kG7FU?X_{sM0@M%Qp=dOc3Efyulx~CY! zA@+Jg16VX!hsA!^K`ww+V{*5^(Vd_o8AHQy*H}g{yK8Jh@aFi#g20<871R%)mRC#P z!}?S`YG+}I6MqI{N2Kl`v4|*G%~2p8#+l=OdSIb`LL;DLTAE~XZ0;ZxP}Qy&_o7vQ zvV^422g9$2KSK}rA@)a%9&qqZ!CJke#C4!*> zEb;+uA#o${PXR>*{;Mq7A8UgM)j*U7XNB_hsB3g54OvFxdH#sG_H@QiFyqUBXD6Ut z$JxPn(&Sd`%#93ti5V-0OsrPfxzhi?!9rL0pBa}#LI=S^aWwc0O5_kapPwS&@;wpP z!Dt7DSRTyKhzKdrhHc}A=bz%H@T{iE717j(XzFcD-DbqB+BmH>_@X$yL224Sr z4ag2*0GQb|YC}VP3vKq`B4Z4IcKfZ!qLt@j|I$1Ld<*rVs-u~V7J42YlufYDyoprA zo)y!26HS)S!#b37QEEwNh?3qrGqofQC6Upn>5v=-$mo>8CuMB(Ksyf+@s;F-F4s^| zmumoPN)jq|Vn^E1y$6e(*y*uEq8~1y3RcjgSKm&~2vVdG zy81#FBh`!bX2iaFA*3U9@W1Fxi`aTOow%T)mp9#iPKBg+o?KlBVR#*@CHt8|4?;L+ zj>Q29ln>b$dO3L;bwW$@$F9TxHlDX%z(QX6qZZyCu0=^NEig)Y97$MAB^~%0sY-U; zt;v#Ls~B{CdqQ&RLAQ8gc>ImtGa)KQ%kbD1*Wu1hhqHqx;GTm8K3Ocqx`wb1Z{E7* zF%?S)@-*x`8^&=cIyS$`D=NE9n2SiuDYcmU@y8fx9tN9Zx9dZA~O6`RR* z$I%73(%*=&?ICzmHDWHD-6*F%h(`u}sJ2#f-^x z-0>$)*w&uX70ciiTpWma8HE`dXg4%-)0_>%P@ysO4jd=x`o!Qu_^l z#7vk))xd`k^S}rB-{7{o5QI^Vu_Kqr7Lzfi=W{W=C{2sKPip9KI8wnQl^h7}#zYx* z9qih45UbF;z=+{0{x+;d0Z&68!Y*0B-&+d!0y~(-jL^vikd4QD9vd{C$N0GsRpiI9 z7Y>qnu0dmvxC!COesOF*1?GSTH}%=5{o{kmk<+9j-ymt_NXO;~p-s+2U54jd>hd}e z9NyAd%gl9oimf@yS!awH&Z0Hw!T3*wAxW#B#e-gosRhhoZ=ljJt6^KpnAJWxopAlJ z`%zf@VpSzeKc#cpe=AjHn_d={5hfnGmKCx#wvj>wX?8{^Oc-4HEia?dH zwlVy2wzRDX%DF2Ti?uvVuXy_9y@oM7u;w`-jm|Y6N}q)$xgzZwUrlqZelXkUa9sW4isKbXyl4HzuD3EnHgOpkCY$QlDS0#;q0tgttz+(L04UKC&wpq}McL*i)@Et&sw;6M677f=zgE>@| z%H1uDaoVuQOcDEA2+%w8oG^yADx+ICa$JYPnRg1-o_wZJfQk5B_(I@xNfKfpg_&!d zz!7%8hL}ODliklEDeSI0Ew$Nx@Sb5e2Z6F1b6?VK5jearM|O*7VY@k6%y!S9K;;JM zWHyuCLX7PuuC#Wak+ge)VfX(%HP!C;yN2D|@XBtCx7zUENDD-;7OL*zXE=2a)UA zMRzT@Ai`OUH2)7PcG{Cf5WT& zt$kbU2Z4o-CkceR*Q1dB?pEB%9r17D9^tHxw=8mhGtx~))2toAY@jVEaCE;2=40~F zOf7gf-~Uy3=_Lya87_6~?!FO;uCcYDllI!@!%ExmMULHD2??{OklE3kF=`6akYY#u zMAiFwsldu~dcz#vN_uHNVZEKZNRbwLAkIsjV^tMz%^%}pcw^;s{LYkM+I-)4F1)Yxfp#4o}jfTbUN&JQ{8jennK$L*I?<3Zwv5m zAZ6tndfKsr3)$Qkvd5o-0ZOq7SoX|H+8;5;Y-l>_9GFclv}Y#`$?7RSg8fi3_(w2! zc#RR*|4IvRUcY`5LXoXh-7sFs(3V4^5aA9Ln+iFMveUpNou*h{GG7a>6%bS*Tjyc*`eoXbTB^XsXcu9qkx z>cBwWp@oC;&OyN&3xkaXXuvnW2poEgo}7;U9;swyd2}hgj4ipkEc|9kU0L|^lG>8+ z;W|B9Fa_wV%4hzWzG;h1g#vxgpC<&T&Ur_EUsWFdtUUZ_Y50?p#H9E1t`}|k!rz4c zjlOrg?)s8dCD)hSP~tX!14Z9IQRgSf-^m$Y#sPW!I_`nv9ysoS;~qHff#V)H?t%Xg zJz&FMH=T9eym^b~v`uexo^@TDkt@6~V9I8j(#(cGt_*sYUZvO7mR7B-%+>J46PmR6u$s4dbKYlRy9F{jpmKjG}~GmXvFCl~+`vF7B08HKkfz`;G0sb?t&$UE`|Nq(V*AS*xt7 zbO8&Mq+Yw~%DO73E3K*(iRzLXS0#ihT$Qz2d0C}PrP+1PrOxRAxQ*P%=|alZgxZ~< zfY^PnM&>IP)lpDrM-X{xLCnYwkVu)#`2Q#a!AmHn3;o^S>|bU212VvEn3>0 z_-kCRzr*hhI@^4WUaA1%CRT(ivQ^kU zP7mrqe|78(`kWmee*pRe&h}8-YOf#KMEoX8G6=2kWwM+UG-@@sP1>wOJxo?!uJo=G zrM7$8sKFHe%8)PUg%h}5iwv~%PaV~#4S$zRJU5wH&t=DywgehH@OVo*jv4Se8+>hT z-u56|Jf1x22x7B0&=OFbDN0gRjMqZ4YUNZ`qp#gtn2nz2?C^CsjlN`HDCBC6B1#Mq zmmfux7$TC|P@tIumt<6$SX9~+M=rnL=Z6=ZO+J6H8Htvl5j=(~xI;RdT0Lt(Yv8K; zIXIH>DD=?Zs3XdtrU_AJD02F46v1oauc@i3L6kau?M`;z^hVaJW!HEEzL3Ac8=(G( zu80avZ(KRsiOMiUMHn`FJsn6bo9*oI`_}k9Z6edy(hx*yeRj6CYyE3cyytU4VB1z7O~)pkom7fOi6p0A7nn?}>QYzZY;e z;PZgxfSa&q*9!Oxz`FpaU>o~Uz{7Y~u^(_6Uc-z4-h!QsiP)mQ6z{la1JdjJa=<>o zR>1Z6Fyb!2B7C^=DB$~m`vFUT4|%|+058VJz}SoC%XV{(W?P?UJ8R;JSv~MC;qi@y zR)luI?ji(F#BPu;m|Fc1V4){9}7X*{~pEl?R zfc`q-<*^j{c7uKx_$NWXHHE&>pidz`Aij9>#jyWLgT4gxM?t^DEPoS|Mg2j4;TZId zpbvshJ~ixjC*>ak{lGEk&w)O44Eh1k4<3Vl81xwEE6wF+)EM=ff_^d;{pw~w!@dcj z3}To9)Dqw~pdYoR$Tu7Et3cli`VupJU9x@~LH_{sb!K{o-;jR@^o7(fQ|Ol&^yfhL zf}XDY1E4B^siem?V8>Dy-s=mnr-3p(kamZbhwpf3jf7Bf9# ztzrL0(C-8NwG{f#4EjT$yWU777Mtlpoc;eC==Gpu?=V?@Q?mR6px+4kZj3j{_IoCi zIH>&&gMJdmoh!}q8RbU#Qy{kp^h)?CDPNXsf6$w;1v`{Nf5)J&0(}O?v9Fu;dy@8T z1icXSYXOt`YYqDz0)7o%MZRQ~&v@Rj?>W#<#<-Y{egO2JfW9k5zSodH40<`n({%lN z3dY%k$Dl6(eIvec_-Ts%M-Ba}K+nMk9d#%tS-)zoUnx)QT&C+N8gx=y?-x41obK}l{=N$!kgxz1&|`O9+imgQ#AdnWBA z=vfav0LQPt(gW(e7j?c1hDN^lbs16zFC;tx z?{w)pUBa(RD6q-<_WESnoLXNja<@o$hlKY?_K84*Q+>aX`gyGhmVm@Bk_GY_5BP}0Z{bB7o-gD?@jZ!ermqok zNwW5R;K!@)kJI4O^&|Rj(x#oNJ;jTCQHHvYr=LCq$1cE8{bGRiOxCR9_FIx)&Cg0V z?IqAjf9jk~g{RM7Y#JK3USR~h9QX`c4ao6XQ76Msr^3(9ZwQQC5~ed=aV6ohH2ABf zo+so2VVxB50`E+U8>t?QUrxlywt54_iCfd?zgOzlrV9R9QtTho@b3VAymJuuNj>rN zgn}!jo?io>2YY%v5+T7<;?HnsYQ3bW?@B$hWx%Tb{xRbfR}y}i20saYkV93H8L0~x zpR4($KZ_-m&VQx$x<&R2entbWG>x8>lK+zeq2MK{=Y}-=8`I#w3q1K}TfI~u!QU}| zuJ#B&Okzzh@jpzXhrU#IrmEoF%W3!rfj=c9U)x@vD)dnr{y#E4SDPi{gr6ZHN`F9e z3I%_$(1R>rry@cAd|VE|UWuQ^c$qPQMUwx!ay;Q@K+rFjc)M&bezphxRU7&3YubP% zuCAB-2QBe)ue85N&c7GQvb~c38M#1L!_9Xj{sf6%BKe~d|MEEku~_0C1fJ}%#`!-< z{))MRk)QpL{ISBzc$3Yn{R`uzQWNNx{13_nu=2yNCH|o~g88RX=Djp}J_DZG-D>9% z;GL%OR5Bj}7q#Ou=?69boGBwDDU>5Mxl&}e|kobXPntZpf2$E$_H2AnmDj63LAqtU)N5DordAQ-|)O$}P|cv5$; z&D}r;lm;Ns=yR`W^{w`_x*LN&f57btt=I5!p`+D{7ZF%gj>|y@sJ6I0e!pjf8!sCC zIJy=4*JsI868dNt+TWJxM(vs=DH3c##&Zck$)?szwZdt0a#_XZ!VBb>LbMWq{k zL16eTAsGBbso9N_Wl=B^{!n|crHvfd z(vH_MY^sKHWPN^mb%T>=<@+j`Yxb?<*HYzr=U3x8E5|%Abr9g+D4#UNI-|f<+2EDXKb6-|o zwXCGvUA1DxRjyihZOJmc$pj;xYugYAaZ@3WYMD;aEmnuy(&@FZp3dk^!NF{b0=yJ) zcZ5*zF%Gze_&CxyyH~kS9`Bo?pO61d!JtGAm0+{q>wz1*jh>)KYYd=#G$IPYp};8u z)+2=t;>E;`Lw^kfRnk-;aWF6th&(s9lsIcRg`W!cbtp%&`}u(26ed2fI0b|50<*5yj+Tli8=1%|;m2id~W81TtBqr;HRKE^@B>)iClRhaKCt3ru5PnmFVU9$1X zqoRGqsmLiMzyo*_g%?)=2()w8P;Kt_Lit)R*MQs)R(gGfnCRGm-tEHxBBH~f7*3^z zr&rZ5V>L93z~!Tro0<`XZt6_paA>PBT!JdOK{mWN#yN%6?ZyGis{2r2j(eQ4GMU1c zlyPI44}VV4sZ^+;i5(lD+KJJThDy_c(}wIkc$bczHV_nRT47*AThOx_5besaS*65# zZ>^9=>^1G7LNq~#*N@Y$lPDS<8w*+*C8}guSpkjdg~Z-WLt0_uhISMoV9+lpYrXye z9gxjzGUEo#?``#vfJ}9?2DL(ti^8CHJ<>FmgXZJ@R_JY(qjz&7WK~W`h+$kvs5BIN zFiN9T4A68d zY5hx=g2kLm-i&!xqG(xXmR~RB6+AyF$|)=_Qm!)O%<^jAML}l@H$79PUMrEsA4&U^ z{c4|7LE49*OYM_d?Wg6&$@nRGwU4S`u_Ta<5{NhR+!|^z|ZQx9{@)zNDu1gC<7f1!N(lZssYWSAKHi|YRkvD&Nh3cd$fhe=-T zXO30?iA(W`Tr#il!yr)XsPfhRj{1LKhR8X%DE{eEa;hB<0Y@xKUY)-_SVi1;Pbq+L zSMmye35r=>tCy_R0zM$K3Me@RGazi1-&QX;w@LX?B`BfOlFx!L=~DJ@^9Y8XD+MgF z@H;K}99h1VPsv-Ky~tL&%uvOiposf+S^nrrB2V)Wm7(gb#t$MZ+Xbh%KX9FZ_gLaj Wm8*D9L1H}lSsuZ0x<$Z})&2t}23fEG literal 0 HcmV?d00001 diff --git a/forth.h b/forth.h new file mode 100644 index 0000000..00e0d8f --- /dev/null +++ b/forth.h @@ -0,0 +1,48 @@ +/** + * TODO file description + * + * Created on 2021/11/13. + */ + +#ifndef FORTH_H +#define FORTH_H + +#include +#include + +/* for printing */ +#include +#include + +#include "fh_config.h" +#include "fh_error.h" + +struct fh_thread_s; +struct fh_word_s; +struct fh_instruction_s; + +/** Word handler typedef */ +typedef enum fh_error (*word_exec_t)(struct fh_thread_s *fh); + +/** Forth runtime global state */ +struct fh_global_s { + /** Verbose logging enabled */ + bool verbose; + /** Interactive mode (i.e. not started with a file argument) */ + bool interactive; +}; + +extern struct fh_global_s fh_globals; + +/* logging */ +#define LOG(format, ...) do { if(fh_globals.verbose) { fprintf(stderr, format "\n", ##__VA_ARGS__); } } while (0) +#define LOGI(format, ...) fprintf(stderr, "\x1b[32m" format "\x1b[m\n", ##__VA_ARGS__) +#define LOGE(format, ...) fprintf(stderr, "\x1b[31;1m" format "\x1b[m\n", ##__VA_ARGS__) +/* Forth standard output. XXX should be stdout, but then colors get mangled if logging is used */ +#define FHPRINT(format, ...) fprintf(stderr, "\x1b[33;1m" format "\x1b[m", ##__VA_ARGS__) +#define FHPRINT_SVC(format, ...) fprintf(stderr, "" format "", ##__VA_ARGS__) + +enum fh_error fh_init_thread(struct fh_thread_s *fh); +enum fh_error fh_process_line(struct fh_thread_s *fh, char *linebuf); + +#endif //FORTH_H diff --git a/main.c b/main.c index e103ed4..df7b18d 100644 --- a/main.c +++ b/main.c @@ -5,919 +5,10 @@ #include #include #include +#include -#define CONTROL_STACK_DEPTH 1024 -#define DATA_STACK_DEPTH 1024 -#define RETURN_STACK_DEPTH 1024 -#define MAX_NAME_LEN 32 -#define DICT_SIZE 1024 -#define COMPILED_BUFFER_SIZE (1024*1024) -#define HEAP_SIZE (1024*1024) -#define MAXLINE 65535 - -struct fh_thread_s; -struct fh_word_s; -struct fh_instruction_s; - -/** Forth runtime global state */ -struct fh_global_s { - /** Verbose logging enabled */ - bool verbose; - /** Interactive mode (i.e. not started with a file argument) */ - bool interactive; -} fh_globals = {}; - -/* if the return address is this, we should drop back to interactive mode */ -#define MAGICADDR_INTERACTIVE 0xFFFFFFFFULL - -/** Get a value rounded up to multiple of word size */ -#define WORDALIGNED(var) (((var) + 3) & ~3) - -_Static_assert(WORDALIGNED(0) == 0, "word align"); -_Static_assert(WORDALIGNED(1) == 4, "word align"); -_Static_assert(WORDALIGNED(2) == 4, "word align"); -_Static_assert(WORDALIGNED(3) == 4, "word align"); -_Static_assert(WORDALIGNED(4) == 4, "word align"); -_Static_assert(WORDALIGNED(5) == 8, "word align"); -_Static_assert(WORDALIGNED(1023) == 1024, "word align"); -_Static_assert(WORDALIGNED(1024) == 1024, "word align"); - -/* logging */ -#define LOG(format, ...) do { if(fh_globals.verbose) { fprintf(stderr, format "\n", ##__VA_ARGS__); } } while (0) -#define LOGI(format, ...) fprintf(stderr, "\x1b[32m" format "\x1b[m\n", ##__VA_ARGS__) -#define LOGE(format, ...) fprintf(stderr, "\x1b[31;1m" format "\x1b[m\n", ##__VA_ARGS__) -/* Forth standard output. XXX should be stdout, but then colors get mangled if logging is used */ -#define FHPRINT(format, ...) fprintf(stderr, "\x1b[33;1m" format "\x1b[m", ##__VA_ARGS__) -#define FHPRINT_SVC(format, ...) fprintf(stderr, "" format "", ##__VA_ARGS__) - -/** Error codes */ -enum fh_error { - FH_OK = 0, - FH_ERR_CS_OVERFLOW, - FH_ERR_DS_OVERFLOW, - FH_ERR_RS_OVERFLOW, - FH_ERR_CS_UNDERFLOW, - FH_ERR_DS_UNDERFLOW, - FH_ERR_RS_UNDERFLOW, - FH_ERR_HEAP_FULL, - FH_ERR_DICT_FULL, - FH_ERR_COMPILE_FULL, - FH_ERR_NAME_TOO_LONG, - FH_ERR_INVALID_STATE, - FH_ERR_INTERNAL, - FH_ERR_UNKNOWN_WORD, - FH_ERR_MAX, -}; - -/** Error names */ -static const char *errornames[] = { - [FH_OK] = "OK", - [FH_ERR_CS_OVERFLOW] = "CS_OVERFLOW", - [FH_ERR_DS_OVERFLOW] = "DS_OVERFLOW", - [FH_ERR_RS_OVERFLOW] = "RS_OVERFLOW", - [FH_ERR_CS_UNDERFLOW] = "CS_UNDERFLOW", - [FH_ERR_DS_UNDERFLOW] = "DS_UNDERFLOW", - [FH_ERR_RS_UNDERFLOW] = "RS_UNDERFLOW", - [FH_ERR_HEAP_FULL] = "HEAP_FULL", - [FH_ERR_DICT_FULL] = "DICT_FULL", - [FH_ERR_COMPILE_FULL] = "COMPILE_FULL", - [FH_ERR_NAME_TOO_LONG] = "NAME_TOO_LONG", - [FH_ERR_INVALID_STATE] = "INVALID_STATE", - [FH_ERR_INTERNAL] = "INTERNAL", - [FH_ERR_UNKNOWN_WORD] = "UNKNOWN_WORD", -}; - -/** Get error name from code, returns Unknown if not defined */ -const char *fherr_name(enum fh_error e) -{ - if (e >= FH_ERR_MAX) { - return "Unknown"; - } - return errornames[e]; -} - -/** Word handler typedef */ -typedef enum fh_error (*word_exec_t)(struct fh_thread_s *fh); - -/** Word struct as they are stored in the dictionary */ -struct fh_word_s { - /** Word name */ - char name[MAX_NAME_LEN]; - /** - * Handler function. - * Builtin functions use pre-defined native handlers. - * User words use a shared handler that executes compiled - * bytecode at 'start' address of the compile-memory area. - */ - word_exec_t handler; - /** Indicates that this is a built-in instruction and not a word call */ - bool builtin; - /** Indicates that this instruction should always be treated as interpreted, - * in practice this is only used for `;` */ - bool immediate; - /** Start address in case of user words */ - uint32_t start; -}; - -/** Bytecode instruction type marker */ -enum fb_instruction_kind { - /* Data = word pointer (dict index) */ - FH_INSTR_WORD, - - /* Data = numeric value to push onto the data stack */ - FH_INSTR_NUMBER, -}; - -/** One instruction in bytecode */ -struct fh_instruction_s { - /** What is the meaning of data? */ - enum fb_instruction_kind kind; - /** Data word */ - uint32_t data; -}; - -static inline void instr_init(struct fh_instruction_s *instr, enum fb_instruction_kind kind, uint32_t data) -{ - instr->kind = kind; - instr->data = data; -} - -#define INSTR_SIZE (sizeof(struct fh_instruction_s)) - -/** Bytecode word indices that are not in the dict, have special effect */ -enum compiler_word { - /** End of a user defined word, pop address and jump back */ - CPLWORD_ENDWORD = DICT_SIZE + 1, - /** This is the `s"` instruction, the length (u32) and string data immediately follow */ - CPLWORD_ALLOCSTR, - /** This is the `."` instruction, same format as above. */ - CPLWORD_TYPESTR, -}; - -_Static_assert(sizeof(struct fh_instruction_s) % 4 == 0, "Instruction struct is aligned"); - -/** Forth runtime major state */ -enum fh_state { - FH_STATE_INTERPRET = 0, - FH_STATE_COMPILE, - FH_STATE_SHUTDOWN, - FH_STATE_MAX, -}; - -/** State names */ -static const char *statenames[] = { - [FH_STATE_INTERPRET] = "INTERPRET", - [FH_STATE_COMPILE] = "COMPILE", - [FH_STATE_SHUTDOWN] = "SHUTDOWN", -}; - -/** Forth runtime minor state */ -enum fh_substate { - FH_SUBSTATE_NONE = 0, - FH_SUBSTATE_COLONNAME, - FH_SUBSTATE_SQUOTE, - FH_SUBSTATE_DOTQUOTE, - FH_SUBSTATE_PARENCOMMENT, - FH_SUBSTATE_LINECOMMENT, - FH_SUBSTATE_MAX, -}; - -/** Sub-state names */ -static const char *substatenames[] = { - [FH_SUBSTATE_NONE] = "NONE", - [FH_SUBSTATE_COLONNAME] = "COLONNAME", - [FH_SUBSTATE_SQUOTE] = "SQUOTE", - [FH_SUBSTATE_DOTQUOTE] = "DOTQUOTE", - [FH_SUBSTATE_PARENCOMMENT] = "PARENCOMMENT", - [FH_SUBSTATE_LINECOMMENT] = "LINECOMMENT", -}; - -/** - * Forth runtime instance - state variables and memory areas. - * - * Some memory areas, such as the dict or heap, could be moved - * to a shared pointer if multi-threading and synchronization is added. - */ -struct fh_thread_s { - /** Control stack */ - uint32_t control_stack[CONTROL_STACK_DEPTH]; - size_t control_stack_top; - size_t control_stack_hwm; - - /** Data stack */ - uint32_t data_stack[DATA_STACK_DEPTH]; - size_t data_stack_top; - size_t data_stack_hwm; - - /** Return stack */ - uint32_t return_stack[RETURN_STACK_DEPTH]; - size_t return_stack_top; - size_t return_stack_hwm; - - /** Data heap */ - uint8_t heap[HEAP_SIZE]; - size_t heap_top; - - /** Compile buffer, used for both word data and literals */ - uint8_t compile[COMPILED_BUFFER_SIZE]; - size_t compile_top; - /** Pointer into the compile buffer for execution */ - uint32_t execptr; - - /** Word dict */ - struct fh_word_s dict[DICT_SIZE]; - uint32_t dict_top; - - /** Forth state */ - enum fh_state state; - - /** Forth sub-state */ - enum fh_substate substate; - - /** Word currently being executed - a pointer is placed here - * before calling the handler */ - struct fh_word_s *exec_word; -}; - -#define TRY(x) \ - do { \ - if (FH_OK != (rv = (x))) return rv; \ - } while (0) - -/** Add a word to the dictionary. */ -enum fh_error fh_add_word(const struct fh_word_s *w, struct fh_thread_s *fh) -{ - if (fh->dict_top == DICT_SIZE) { - return FH_ERR_DICT_FULL; - } - memcpy(&fh->dict[fh->dict_top++], w, sizeof(struct fh_word_s)); - return FH_OK; -} - -/** Pop from data stack */ -static inline enum fh_error ds_pop(struct fh_thread_s *fh, uint32_t *out) -{ - if (fh->data_stack_top == 0) { - LOG("DS pop UNDERFLOW"); - return FH_ERR_DS_UNDERFLOW; - } - *out = fh->data_stack[--fh->data_stack_top]; - LOG("DS pop %d", *out); - return FH_OK; -} - -/** Pop from return stack */ -static inline enum fh_error rs_pop(struct fh_thread_s *fh, uint32_t *out) -{ - if (fh->return_stack_top == 0) { - LOG("RS pop UNDERFLOW"); - return FH_ERR_RS_UNDERFLOW; - } - *out = fh->return_stack[--fh->return_stack_top]; - LOG("RS pop %d", *out); - return FH_OK; -} - -/** Pop from control stack */ -static inline enum fh_error cs_pop(struct fh_thread_s *fh, uint32_t *out) -{ - if (fh->control_stack_top == 0) { - LOG("CS pop UNDERFLOW"); - return FH_ERR_CS_UNDERFLOW; - } - *out = fh->control_stack[--fh->control_stack_top]; - LOG("CS pop %d", *out); - return FH_OK; -} - -#define UPDATE_HWM(hwm, top) \ - do { \ - if((hwm) < (top)) { \ - (hwm) = (top); \ - } \ - } while(0) - -/** Push to data stack */ -static inline enum fh_error ds_push(struct fh_thread_s *fh, uint32_t in) -{ - LOG("DS push %d", in); - if (fh->data_stack_top == DATA_STACK_DEPTH) { - return FH_ERR_DS_OVERFLOW; - } - fh->data_stack[fh->data_stack_top++] = in; - UPDATE_HWM(fh->data_stack_hwm, fh->data_stack_top); - return FH_OK; -} - -/** Push to return stack */ -static inline enum fh_error rs_push(struct fh_thread_s *fh, uint32_t in) -{ - LOG("RS push %d", in); - if (fh->return_stack_top == RETURN_STACK_DEPTH) { - return FH_ERR_RS_OVERFLOW; - } - fh->return_stack[fh->return_stack_top++] = in; - UPDATE_HWM(fh->return_stack_hwm, fh->return_stack_top); - return FH_OK; -} - -/** Push to control stack */ -static inline enum fh_error cs_push(struct fh_thread_s *fh, uint32_t in) -{ - LOG("CS push %d", in); - if (fh->control_stack_top == CONTROL_STACK_DEPTH) { - return FH_ERR_CS_OVERFLOW; - } - fh->control_stack[fh->control_stack_top++] = in; - UPDATE_HWM(fh->control_stack_hwm, fh->control_stack_top); - return FH_OK; -} - -/** Log current runtime state */ -static void showstate(const struct fh_thread_s *fh) -{ - if (fh->substate == 0) { - LOG("state = %s", statenames[fh->state]); - } else { - LOG("state = %s.%s", statenames[fh->state], substatenames[fh->substate]); - } -} - -/** Set runtime state and sub-state */ -void fh_setstate(struct fh_thread_s *fh, enum fh_state state, enum fh_substate substate) -{ - fh->state = state; - fh->substate = substate; - showstate(fh); -} - -/** Set runtime sub-state (state is unchanged) */ -void fh_setsubstate(struct fh_thread_s *fh, enum fh_substate substate) -{ - fh->substate = substate; - showstate(fh); -} - -/** Allocate a heap region, e.g. for a string. The address is stored to `addr` */ -enum fh_error fh_heap_reserve( - struct fh_thread_s *fh, - size_t len, - uint32_t *addr -) -{ - uint32_t p = WORDALIGNED(fh->heap_top); // FIXME this shouldn't be needed - - if (p + len > HEAP_SIZE) { - return FH_ERR_HEAP_FULL; - } - - *addr = p; - - fh->heap_top = WORDALIGNED(p + len); - - return FH_OK; -} - -/** Write bytes to heap at a given location. The region must have been previously allocated! */ -void fh_heap_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint32_t len) -{ - memcpy(&fh->heap[addr], src, len); -} - -/** Allocate heap region and write bytes to it */ -enum fh_error fh_heap_put(struct fh_thread_s *fh, const void *src, uint32_t len) -{ - enum fh_error rv; - uint32_t addr; - TRY(fh_heap_reserve(fh, len, &addr)); - fh_heap_write(fh, addr, src, len); - return FH_OK; -} - -/** Copy bytes from compile area to heap. The region must have been previously allocated! */ -void fh_heap_copy_from_compile(struct fh_thread_s *fh, uint32_t addr, uint32_t srcaddr, uint32_t len) -{ - memcpy(&fh->heap[addr], &fh->compile[srcaddr], len); -} - -/** Reserve space in the compile memory area */ -enum fh_error fh_compile_reserve( - struct fh_thread_s *fh, - size_t len, - uint32_t *addr -) -{ - uint32_t p = WORDALIGNED(fh->compile_top); // FIXME this shouldn't be needed - - if (p + len > COMPILED_BUFFER_SIZE) { - return FH_ERR_HEAP_FULL; - } - - *addr = p; - - fh->compile_top = WORDALIGNED(p + len); - - return FH_OK; -} - -/** Write bytes to compile area at a given location. The region must have been previously allocated! */ -void fh_compile_write(struct fh_thread_s *fh, uint32_t addr, const void *src, uint32_t len) -{ - memcpy(&fh->compile[addr], src, len); -} - -/** Allocate compile region and write bytes to it */ -enum fh_error fh_compile_put(struct fh_thread_s *fh, const void *src, uint32_t len) -{ - enum fh_error rv; - uint32_t addr; - TRY(fh_compile_reserve(fh, len, &addr)); - fh_compile_write(fh, addr, src, len); - return FH_OK; -} - -enum fh_error w_add(struct fh_thread_s *fh) -{ - enum fh_error rv; - uint32_t a = 0, b = 0; - TRY(ds_pop(fh, &a)); - TRY(ds_pop(fh, &b)); - TRY(ds_push(fh, a + b)); - return FH_OK; -} - -enum fh_error w_sub(struct fh_thread_s *fh) -{ - enum fh_error rv; - uint32_t a = 0, b = 0; - TRY(ds_pop(fh, &a)); - TRY(ds_pop(fh, &b)); - TRY(ds_push(fh, a - b)); - return FH_OK; -} - -enum fh_error w_mul(struct fh_thread_s *fh) -{ - enum fh_error rv; - uint32_t a = 0, b = 0; - TRY(ds_pop(fh, &a)); - TRY(ds_pop(fh, &b)); - TRY(ds_push(fh, a * b)); - return FH_OK; -} - -enum fh_error w_user_word(struct fh_thread_s *fh) -{ - enum fh_error rv; - const struct fh_word_s *w; - const struct fh_word_s *w2; - uint32_t wn; - - call: - w = fh->exec_word; - if (!w) { return FH_ERR_INTERNAL; } - - LOG("Run user word: %s", w->name); - - TRY(rs_push(fh, fh->execptr)); - fh->execptr = w->start; - - instr:; - // make sure it's aligned - fh->execptr = WORDALIGNED(fh->execptr); - const struct fh_instruction_s *instr = (const struct fh_instruction_s *) &fh->compile[fh->execptr]; - fh->execptr += sizeof(struct fh_instruction_s); - - uint32_t strl; - uint32_t addr = 0; - switch (instr->kind) { - case FH_INSTR_NUMBER: - TRY(ds_push(fh, instr->data)); - goto instr; - - case FH_INSTR_WORD: - wn = instr->data; - switch (wn) { - /* special case for strings stored in compile memory */ - case CPLWORD_ALLOCSTR: - case CPLWORD_TYPESTR: - strl = *((uint32_t *) &fh->compile[fh->execptr]); - LOG("strl %d", strl); - fh->execptr += 4; // advance past the length - if (wn == CPLWORD_ALLOCSTR) { - TRY(fh_heap_reserve(fh, strl, &addr)); - fh_heap_copy_from_compile(fh, addr, fh->execptr, strl); - LOG("Exec: alloc-str \"%.*s\"", strl, &fh->heap[addr]); - TRY(ds_push(fh, addr)); - TRY(ds_push(fh, strl)); - fh->execptr += strl; - } else { - FHPRINT("%.*s", (int) strl, &fh->compile[fh->execptr]); - LOG("Exec: type-str \"%.*s\"", strl, &fh->compile[fh->execptr]); - } - goto instr; - - case CPLWORD_ENDWORD: - LOG("Exec: word-end (RETURN)"); - TRY(rs_pop(fh, &fh->execptr)); - if (fh->execptr == MAGICADDR_INTERACTIVE) { - goto end; - } - goto instr; - - default: - w2 = &fh->dict[instr->data]; - if (w2->builtin) { - LOG("Exec: builtin-word %s", w2->name); - w2->handler(fh); - goto instr; - } else { - LOG("Exec: user-word %s (CALL)", w2->name); - fh->exec_word = &fh->dict[instr->data]; - goto call; - } - } - } - - end: - return FH_OK; -} - -enum fh_error w_colon(struct fh_thread_s *fh) -{ - if (fh->state != FH_STATE_INTERPRET) { - return FH_ERR_INVALID_STATE; - } - - fh_setstate(fh, FH_STATE_COMPILE, FH_SUBSTATE_COLONNAME); - - if (fh->dict_top >= DICT_SIZE) { - return FH_ERR_DICT_FULL; - } - fh->dict[fh->dict_top].start = fh->compile_top; - fh->dict[fh->dict_top].handler = w_user_word; - return FH_OK; -} - -enum fh_error w_semicolon(struct fh_thread_s *fh) -{ - enum fh_error rv; - struct fh_instruction_s instr; - - if (fh->state != FH_STATE_COMPILE) { - return FH_ERR_INVALID_STATE; - } - - instr.kind = FH_INSTR_WORD; - instr.data = CPLWORD_ENDWORD; - TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); - - /* Return to interpret state */ - fh_setstate(fh, FH_STATE_INTERPRET, 0); - fh->dict_top++; - return FH_OK; -} - -enum fh_error w_dot(struct fh_thread_s *fh) -{ - enum fh_error rv; - uint32_t a = 0; - TRY(ds_pop(fh, &a)); - - FHPRINT("%d ", (int32_t) a); - return FH_OK; -} - -enum fh_error w_type(struct fh_thread_s *fh) -{ - enum fh_error rv; - uint32_t count = 0, addr = 0; - TRY(ds_pop(fh, &count)); - TRY(ds_pop(fh, &addr)); - - FHPRINT("%.*s", count, &fh->heap[addr]); - return FH_OK; -} - -enum fh_error w_cr(struct fh_thread_s *fh) -{ - (void) fh; - FHPRINT("\n"); - return FH_OK; -} - -enum fh_error w_space(struct fh_thread_s *fh) -{ - (void) fh; - FHPRINT(" "); - return FH_OK; -} - -enum fh_error w_s_quote(struct fh_thread_s *fh) -{ - fh_setsubstate(fh, FH_SUBSTATE_SQUOTE); - return FH_OK; -} - -enum fh_error w_dot_quote(struct fh_thread_s *fh) -{ - fh_setsubstate(fh, FH_SUBSTATE_DOTQUOTE); - return FH_OK; -} - -enum fh_error w_backslash(struct fh_thread_s *fh) -{ - fh_setsubstate(fh, FH_SUBSTATE_LINECOMMENT); - return FH_OK; -} - -enum fh_error w_paren(struct fh_thread_s *fh) -{ - fh_setsubstate(fh, FH_SUBSTATE_PARENCOMMENT); - return FH_OK; -} - -enum fh_error w_bye(struct fh_thread_s *fh) -{ - LOG("state=SHUTDOWN"); - fh_setstate(fh, FH_STATE_SHUTDOWN, 0); - return FH_OK; -} - -/** Add pointers to built-in word handlers to a runtime struct */ -enum fh_error register_builtin_words(struct fh_thread_s *fh) -{ - struct name_and_handler { - const char *name; - word_exec_t handler; - bool immediate; - }; - - const struct name_and_handler builtins[] = { - {"s\"", w_s_quote, 1}, - {".\"", w_dot_quote, 1}, - /* Compiler control words */ - {"bye", w_bye, 0}, - /* Basic arithmetics */ - {"+", w_add, 0}, - {"-", w_sub, 0}, - {"*", w_mul, 0}, - /* Control words */ - {":", w_colon, 0}, - {";", w_semicolon, 1}, - {".", w_dot, 0}, - {"type", w_type, 0}, - {"cr", w_cr, 0}, - {"space", w_space, 0}, - {"\\", w_backslash, 0}, // line comment - {"(", w_paren, 0}, // enclosed comment - { /* end marker */ } - }; - - // foreach - struct fh_word_s w; - const struct name_and_handler *p = builtins; - enum fh_error rv; - while (p->handler) { - strcpy(w.name, p->name); - w.handler = p->handler; - w.builtin = 1; - w.immediate = p->immediate; - rv = fh_add_word(&w, fh); - if (rv != FH_OK) { - return rv; - } - p++; - } - return FH_OK; -} - -#undef ADDWORD - -/** Initialize a runtime */ -enum fh_error fh_init_thread(struct fh_thread_s *fh) -{ - enum fh_error rv; - - /* Make sure we have a clean state */ - memset(fh, 0, sizeof(struct fh_thread_s)); - - TRY(register_builtin_words(fh)); - - fh->execptr = MAGICADDR_INTERACTIVE; - return FH_OK; -} - -/** Process a quoted string read from input */ -static enum fh_error fh_handle_quoted_string( - struct fh_thread_s *fh, - char *start, - size_t len -) -{ - enum fh_error rv; - uint32_t addr = 0; - struct fh_instruction_s instr; - - if (fh->state == FH_STATE_INTERPRET) { - switch (fh->substate) { - case FH_SUBSTATE_SQUOTE: - TRY(fh_heap_put(fh, start, len)); - TRY(ds_push(fh, addr)); - TRY(ds_push(fh, len)); - break; - case FH_SUBSTATE_DOTQUOTE: - FHPRINT("%.*s", (int) len, start); - break; - - default: - LOGE("Bad substate in interpret mode: %s", substatenames[fh->substate]); - } - } else { - LOG("Compile a string"); - /* compile */ - if (fh->substate == FH_SUBSTATE_SQUOTE) { - instr_init(&instr, FH_INSTR_WORD, CPLWORD_ALLOCSTR); - } else { - instr_init(&instr, FH_INSTR_WORD, CPLWORD_TYPESTR); - } - uint32_t len32 = len; - /* string is encoded as a special compiler command, the size, - * and then the string, all 4-byte aligned. */ - TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); - - TRY(fh_compile_reserve(fh, len + 4, &addr)); - fh_compile_write(fh, addr, &len32, 4); - fh_compile_write(fh, addr + 4, start, len); - } - return FH_OK; -} - -/** Process a word read from input */ -static enum fh_error fh_handle_word( - struct fh_thread_s *fh, - char *start, - size_t len -) -{ - if (len >= MAX_NAME_LEN) { - return FH_ERR_NAME_TOO_LONG; - } - - /* First, try if it's a known word */ - // TODO we could use binary search if the dict was ordered - struct fh_word_s *w = &fh->dict[0]; - struct fh_instruction_s instr; - uint32_t cnt = 0; - enum fh_error rv; - while (w->handler) { - if (0 == strncasecmp(start, w->name, len) && w->name[len] == 0) { - // word found! - if (fh->state == FH_STATE_COMPILE && !w->immediate) { - LOG("Compile word call: %s", w->name); - instr_init(&instr, FH_INSTR_WORD, cnt); - TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); - } else { - /* interpret */ - LOG("Interpret word: %s", w->name); - fh->exec_word = w; - TRY(w->handler(fh)); - } - return FH_OK; - } - w++; - cnt++; - } - - /* word not found, try parsing as number */ - errno = 0; - char *endptr; - long v = strtol(start, &endptr, 0); - if (errno != 0 || endptr == start) { - LOGE("Unknown word and fail to parse as number: %.*s", (int) len, start); - return FH_ERR_UNKNOWN_WORD; - } - - if (fh->state == FH_STATE_COMPILE) { - LOG("Compile number: %ld", v); - instr_init(&instr, FH_INSTR_NUMBER, (uint32_t) v); - TRY(fh_compile_put(fh, &instr, INSTR_SIZE)); - } else { - /* interpret */ - LOG("Interpret number: %ld", v); - TRY(ds_push(fh, (uint32_t) v)); - } - - return FH_OK; -} - -/** True if the character is whitespace */ -static inline bool iswhite(char c) -{ - return c == ' ' || c == '\n' || c == '\t' || c == '\r'; -} - -/** True if the character is CR or LF */ -static inline bool isnl(char c) -{ - return c == '\n' || c == '\r'; -} - -/** Process a line read from input */ -static enum fh_error fh_process_line(struct fh_thread_s *fh, char *linebuf) -{ - enum fh_error rv; - char *rp = linebuf; - char c; - - if (!fh_globals.interactive) { - LOGI("%s", linebuf); - } - - while (0 != (c = *rp) && fh->state != FH_STATE_SHUTDOWN) { - /* end on newline */ - if (isnl(c)) { - goto done; - } - /* skip whitespace */ - if (iswhite(c)) { - rp++; - continue; - } - - char *end; - size_t length; - switch (fh->substate) { - case FH_SUBSTATE_NONE: - case FH_SUBSTATE_COLONNAME: - /* try to read a word */ - end = strchr(rp, ' '); - if (end) { - length = end - rp; /* exclude the space */ - } else { - length = strlen(rp); - } - - if (fh->substate == FH_SUBSTATE_NONE) { - /* eval a word */ - LOG("Handle \"%.*s\"", (int) length, rp); - TRY(fh_handle_word(fh, rp, length)); - } else { - /* new word's name is found */ - LOG("New word name = \"%.*s\"", (int) length, rp); - strncpy(fh->dict[fh->dict_top].name, rp, length); - fh_setsubstate(fh, FH_SUBSTATE_NONE); - } - - if (end) { - rp = end + 1; - } else { - goto done; - } - break; - - case FH_SUBSTATE_SQUOTE: - case FH_SUBSTATE_DOTQUOTE: - end = strchr(rp, '"'); - if (end) { - length = end - rp; - LOG("Quoted string: \"%.*s\"", (int) length, rp); - TRY(fh_handle_quoted_string(fh, rp, length)); - fh_setsubstate(fh, FH_SUBSTATE_NONE); - rp = end + 1; - } else { - /* no end. this is weird. */ - LOGE("Unterminated quoted string!"); - goto done; - } - break; - - case FH_SUBSTATE_PARENCOMMENT: - end = strchr(rp, ')'); - if (end) { - LOG("Discard inline comment"); - fh_setsubstate(fh, FH_SUBSTATE_NONE); - rp = end + 1; - } else { - /* no end, discard all */ - LOGE("Unterminated parenthesis comment"); - goto done; - } - break; - - case FH_SUBSTATE_LINECOMMENT: - LOG("Discard line comment"); - goto done; // just discard the rest - - default: - LOGE("Bad substate %s", substatenames[fh->substate]); - } - } - done: - LOG("Line done."); - return FH_OK; -} - +#include "forth.h" +#include "fh_runtime.h" int main(int argc, char *argv[]) { @@ -968,7 +59,7 @@ int main(int argc, char *argv[]) // trim size_t end = strlen(linebuf) - 1; - while (iswhite(linebuf[end])) { + while (isspace(linebuf[end])) { linebuf[end] = 0; }