diff --git a/src/Makefile b/src/Makefile
index 40037834d3b2831f92a9897ea51336060addfc24..fcf80c324f03b9bd70b42e6096e8eadc8d77993a 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -184,6 +184,7 @@ sources+=\
$(call List,Sourcefile)\
$(call List,blua/Sourcefile)\
$(call List,netcode/Sourcefile)\
+ $(call List,forth/Sourcefile)\
depends:=$(basename $(filter %.c %.s,$(sources)))
objects:=$(basename $(filter %.c %.s %.nas,$(sources)))
diff --git a/src/Sourcefile b/src/Sourcefile
index 60ee5db5baf16fe20657c93e5143afe60615bc89..784be80e2f2a4e320318558803e60e5e753435ed 100644
--- a/src/Sourcefile
+++ b/src/Sourcefile
@@ -98,3 +98,4 @@ lua_hudlib.c
lua_hudlib_drawlist.c
lua_inputlib.c
lua_colorlib.c
+forth_script.c
diff --git a/src/filesrch.c b/src/filesrch.c
index 7f104f8cac58ba1e109605b5b0598f14b3a86ce6..cac749afedac8e7961450076378bbc39d97aac71 100644
--- a/src/filesrch.c
+++ b/src/filesrch.c
@@ -914,7 +914,7 @@ char exttable[NUM_EXT_TABLE][7] = { // maximum extension length (currently 4) pl
#ifdef USE_KART
"\6.kart",
#endif
- "\5.pk3", "\5.soc", "\5.lua"}; // addfile
+ "\5.pk3", "\5.soc", "\5.lua", "\4.fs"}; // addfile
static char (*filenamebuf)[MAX_WADPATH];
diff --git a/src/filesrch.h b/src/filesrch.h
index a934c48d61bc9cfa4e31f550c2001bd582908e31..2824261da15d0a1ca8b39d214f084d136729fcf6 100644
--- a/src/filesrch.h
+++ b/src/filesrch.h
@@ -69,6 +69,7 @@ typedef enum
EXT_PK3,
EXT_SOC,
EXT_LUA,
+ EXT_FORTH,
NUM_EXT,
NUM_EXT_TABLE = NUM_EXT-EXT_START,
EXT_LOADED = 0x80
diff --git a/src/forth/Sourcefile b/src/forth/Sourcefile
new file mode 100644
index 0000000000000000000000000000000000000000..9836101318227f1505e0dd993f0e84bc24392752
--- /dev/null
+++ b/src/forth/Sourcefile
@@ -0,0 +1,3 @@
+srbf_context.c
+srbf_word.c
+srbf_address.c
diff --git a/src/forth/srbf.h b/src/forth/srbf.h
new file mode 100644
index 0000000000000000000000000000000000000000..049779f70aa53ef23104f5c9330bba118448c29f
--- /dev/null
+++ b/src/forth/srbf.h
@@ -0,0 +1,149 @@
+// SONIC ROBO BLAST 2
+//-----------------------------------------------------------------------------
+// Copyright (C) 2012-2016 by John "JTE" Muniz.
+// Copyright (C) 2012-2025 by Sonic Team Junior.
+//
+// This program is free software distributed under the
+// terms of the GNU General Public License, version 2.
+// See the 'LICENSE' file for more details.
+//-----------------------------------------------------------------------------
+/// \file srbf.h
+/// \brief Header for the Forth scripting runtime
+
+#ifndef SRBF_H
+#define SRBF_H
+
+#include <assert.h>
+#include <stdint.h>
+#include <stddef.h>
+
+#define SRBF_STACK_SIZE 32
+#define SRBF_MAX_WORD_LEN 256
+
+#define SRBF_CELL_MIN INT32_MIN
+#define SRBF_CELL_MAX INT32_MAX
+#define SRBF_UCELL_MAX UINT32_MAX
+#define SRBF_CHAR_MIN SCHAR_MIN
+#define SRBF_CHAR_MAX SCHAR_MAX
+#define SRBF_UCHAR_MAX UCHAR_MAX
+
+typedef int32_t srbf_cell_t;
+typedef signed char srbf_char_t;
+typedef uint32_t srbf_ucell_t;
+typedef unsigned char srbf_uchar_t;
+
+enum
+{
+ SRBF_INTERPRET,
+ SRBF_COMPILE,
+ SRBF_EXECUTE,
+};
+
+typedef struct srbf_context_s srbf_context_t;
+
+typedef struct srbf_word_s
+{
+ // TODO: add a hash lookup
+ const char *word;
+ int (*func)(srbf_context_t *context);
+ size_t num_words;
+ const char **words;
+ unsigned char immediate;
+} srbf_word_t;
+
+typedef struct
+{
+ const char *data;
+ const char *file;
+ size_t len;
+ size_t pos;
+
+ size_t line, col;
+} srbf_parser_t;
+
+struct srbf_context_s
+{
+ char *error;
+ size_t datastack_pos;
+ srbf_cell_t datastack[SRBF_STACK_SIZE];
+ size_t returnstack_pos;
+ srbf_cell_t returnstack[SRBF_STACK_SIZE];
+ size_t controlstack_pos;
+ srbf_cell_t controlstack[SRBF_STACK_SIZE];
+
+ size_t wordtable_len;
+ srbf_word_t *wordtable;
+
+ size_t memory_size;
+ size_t memory_cap;
+ union {
+ srbf_cell_t *cell_memory;
+ srbf_char_t *memory;
+ };
+
+ srbf_parser_t *parser;
+ srbf_word_t *current_word;
+
+ int state;
+ srbf_cell_t base;
+};
+
+#define SRBF_BASE_ADDRESS 0xc0000000
+
+#define SRBF_NATIVE_WORD(name, f, comp) { .word = name, .func = f, .num_words = 0, .words = NULL, .immediate = comp }
+
+#define SRBF_STACK_UNDERFLOW "Stack underflow"
+#define SRBF_STACK_OVERFLOW "Stack overflow"
+
+#define SRBF_ASSERT_STACK_SIZE(context, size) \
+ if ((context)->datastack_pos < (size)) \
+ { \
+ SRBF_PushError(context, SRBF_STACK_UNDERFLOW); \
+ return 0; \
+ }
+
+#define SRBF_ASSERT_STACK_FREE(context, size) \
+ if ((context)->datastack_pos + (size) > SRBF_STACK_SIZE) \
+ { \
+ SRBF_PushError(context, SRBF_STACK_OVERFLOW); \
+ return 0; \
+ }
+
+static inline void SRBF_Push(srbf_context_t *context, srbf_cell_t cell)
+{
+ assert(context->datastack_pos < SRBF_MAX_WORD_LEN);
+ context->datastack[context->datastack_pos++] = cell;
+}
+
+static inline srbf_cell_t SRBF_Pop(srbf_context_t *context)
+{
+ assert(context->datastack_pos > 0);
+ return context->datastack[--context->datastack_pos];
+}
+
+void SRBF_ClearError(srbf_context_t *context);
+void SRBF_PushError(srbf_context_t *context, const char *error, ...);
+
+static inline const char *SRBF_GetError(srbf_context_t *context)
+{
+ return context->error;
+}
+
+srbf_context_t *SRBF_CreateContext(char const **error);
+void SRBF_DestroyContext(srbf_context_t *context);
+
+size_t SRBF_ReadNextToken(srbf_parser_t *parser, char *buf, size_t len);
+int SRBF_AddWords(srbf_context_t *context, const srbf_word_t *word, size_t count);
+
+int SRBF_InterpretData(srbf_context_t *context, const char *data, size_t size, const char *filename);
+
+int SRBF_LoadWordtable(srbf_context_t *context);
+int SRBF_InvokeWord(srbf_context_t *context, const char *word);
+
+int SRBF_ReadCell(srbf_context_t *context, srbf_ucell_t address, srbf_ucell_t *data);
+int SRBF_ReadChar(srbf_context_t *context, srbf_ucell_t address, srbf_uchar_t *data);
+int SRBF_WriteCell(srbf_context_t *context, srbf_ucell_t address, srbf_ucell_t data);
+int SRBF_WriteChar(srbf_context_t *context, srbf_ucell_t address, srbf_uchar_t data);
+int SRBF_AllocateMemory(srbf_context_t *context, srbf_cell_t amount);
+
+#endif // SRBF_H
diff --git a/src/forth/srbf_address.c b/src/forth/srbf_address.c
new file mode 100644
index 0000000000000000000000000000000000000000..fb5f6a7d29a0e6c99b8c4ae6cb9c80a0afed75c4
--- /dev/null
+++ b/src/forth/srbf_address.c
@@ -0,0 +1,137 @@
+// SONIC ROBO BLAST 2
+//-----------------------------------------------------------------------------
+// Copyright (C) 2012-2016 by John "JTE" Muniz.
+// Copyright (C) 2012-2025 by Sonic Team Junior.
+//
+// This program is free software distributed under the
+// terms of the GNU General Public License, version 2.
+// See the 'LICENSE' file for more details.
+//-----------------------------------------------------------------------------
+/// \file srbf_word.c
+/// \brief Logic for Forth's virtual memory map
+
+#include <stdlib.h>
+#include <string.h>
+
+#include "srbf.h"
+
+static void *GetMemoryAddress(srbf_context_t *context, srbf_ucell_t address, size_t size, int write)
+{
+ if (address % size) // disallow accessing memory if addresses aren't aligned
+ return NULL;
+
+ switch (address >> 30)
+ {
+ case 0:
+ case 1:
+ // low 31 bits is memory (max 2 GiB)
+ if (address+size > context->memory_size)
+ return NULL;
+
+ return &context->memory[address];
+
+ case 2:
+ // 0x80000000 - 0xbfffffff is script data, used for metaprogramming
+ if (context->parser == NULL)
+ return NULL;
+ if ((address - 0x80000000)+size > context->parser->len)
+ return NULL;
+ if (write)
+ return NULL; // source data is read-only
+
+ return &context->parser->data[address];
+
+ case 3:
+ // 0xc0000000 - 0xffffffff is io memory, used for misc stuff
+ if (address == SRBF_BASE_ADDRESS)
+ {
+ if (size != sizeof(srbf_cell_t))
+ return NULL;
+ return &context->base;
+ }
+
+ return NULL;
+ }
+
+ abort();
+}
+
+int SRBF_ReadCell(srbf_context_t *context, srbf_ucell_t address, srbf_ucell_t *data)
+{
+ srbf_ucell_t *addr = GetMemoryAddress(context, address, sizeof(*data), 0);
+ if (addr == NULL)
+ {
+ SRBF_PushError(context, "Invalid read from memory at 0x%08X", address);
+ return 0;
+ }
+
+ *data = *addr;
+ return 1;
+}
+
+int SRBF_ReadChar(srbf_context_t *context, srbf_ucell_t address, srbf_uchar_t *data)
+{
+ srbf_uchar_t *addr = GetMemoryAddress(context, address, sizeof(*data), 0);
+ if (addr == NULL)
+ {
+ SRBF_PushError(context, "Invalid read from memory at 0x%08X", address);
+ return 0;
+ }
+
+ *data = *addr;
+ return 1;
+}
+
+int SRBF_WriteCell(srbf_context_t *context, srbf_ucell_t address, srbf_ucell_t data)
+{
+ srbf_ucell_t *addr = GetMemoryAddress(context, address, sizeof(data), 1);
+ if (addr == NULL)
+ {
+ SRBF_PushError(context, "Invalid write to memory at 0x%08X", address);
+ return 0;
+ }
+
+ *addr = data;
+ return 1;
+}
+
+int SRBF_WriteChar(srbf_context_t *context, srbf_ucell_t address, srbf_uchar_t data)
+{
+ srbf_uchar_t *addr = GetMemoryAddress(context, address, sizeof(data), 1);
+ if (addr == NULL)
+ {
+ SRBF_PushError(context, "Invalid write to memory at 0x%08X", address);
+ return 0;
+ }
+
+ *addr = data;
+ return 1;
+}
+
+int SRBF_AllocateMemory(srbf_context_t *context, srbf_cell_t amount)
+{
+ if (context->memory_size + amount > 0x80000000)
+ {
+ SRBF_PushError(context, "Allocation too large to fit address space");
+ return 0;
+ }
+
+ while (context->memory_size + amount > context->memory_cap)
+ {
+ srbf_uchar_t *tmp;
+ tmp = realloc(context->memory, context->memory_cap << 1);
+ if (tmp == NULL)
+ {
+ SRBF_PushError(context, "Out of memory");
+ return 0;
+ }
+
+ context->memory = tmp;
+ // zero out the memory so we don't leak anything sensitive to scripts
+ memset(&context->memory[context->memory_cap], 0, context->memory_cap);
+ context->memory_cap <<= 1;
+ }
+
+ context->memory_size += amount;
+ return 1;
+}
diff --git a/src/forth/srbf_context.c b/src/forth/srbf_context.c
new file mode 100644
index 0000000000000000000000000000000000000000..5f225d5b6e46f7909200d952ebd6c46d68a6d5a6
--- /dev/null
+++ b/src/forth/srbf_context.c
@@ -0,0 +1,193 @@
+// SONIC ROBO BLAST 2
+//-----------------------------------------------------------------------------
+// Copyright (C) 2012-2016 by John "JTE" Muniz.
+// Copyright (C) 2012-2025 by Sonic Team Junior.
+//
+// This program is free software distributed under the
+// terms of the GNU General Public License, version 2.
+// See the 'LICENSE' file for more details.
+//-----------------------------------------------------------------------------
+/// \file srbf_context.c
+/// \brief Context management for Forth
+
+#include <stdarg.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+
+#include "srbf.h"
+
+size_t SRBF_ReadNextToken(srbf_parser_t *parser, char *buf, size_t len)
+{
+ size_t written = 0;
+ while (parser->pos < parser->len && isspace(parser->data[parser->pos]))
+ {
+ parser->pos++;
+ parser->col++;
+ if (parser->data[parser->pos-1] == '\n')
+ {
+ parser->col = 1;
+ parser->line++;
+ }
+ }
+
+ if (parser->pos == parser->len)
+ return 0;
+
+ while (written < len-1 && parser->pos < parser->len && !isspace(parser->data[parser->pos]))
+ {
+ buf[written++] = toupper(parser->data[parser->pos++]);
+ parser->col++;
+ }
+ buf[written] = '\0';
+
+ // skip remaining chars if they didn't fit in buf
+ while (parser->pos < parser->len && !isspace(parser->data[parser->pos]))
+ {
+ parser->pos++;
+ parser->col++;
+ }
+
+ return written;
+}
+
+srbf_context_t *SRBF_CreateContext(char const **error)
+{
+ srbf_context_t *context = malloc(sizeof(srbf_context_t));
+ if (context == NULL)
+ {
+ if (error)
+ *error = "Out of memory";
+ return NULL;
+ }
+
+ context->error = NULL;
+ context->datastack_pos = 0;
+ context->returnstack_pos = 0;
+ context->controlstack_pos = 0;
+
+ context->memory_size = 0;
+ context->memory_cap = 256;
+ context->memory = malloc(context->memory_cap);
+ if (context->memory == NULL)
+ {
+ if (error)
+ *error = "Out of memory";
+ free(context);
+ return NULL;
+ }
+
+ context->parser = NULL;
+ context->current_word = NULL;
+
+ context->state = SRBF_INTERPRET;
+ context->base = 10;
+
+ if (!SRBF_LoadWordtable(context))
+ {
+ if (error)
+ *error = "Out of memory";
+ free(context->memory);
+ free(context);
+ return NULL;
+ }
+ return context;
+}
+
+void SRBF_DestroyContext(srbf_context_t *context)
+{
+ if (context == NULL)
+ return;
+ free(context->wordtable);
+ free(context);
+}
+
+void SRBF_ClearError(srbf_context_t *context)
+{
+ free(context->error);
+ context->error = NULL;
+}
+
+void SRBF_PushError(srbf_context_t *context, const char *error, ...)
+{
+ va_list args;
+ size_t len, pos;
+ char *s;
+ if (context->error != NULL)
+ free(context->error);
+
+ if (context->parser != NULL)
+ {
+ if (context->parser->file != NULL)
+ len = snprintf(NULL, 0, "%s:%zu:%zu: ", context->parser->file, context->parser->line, context->parser->col);
+ else
+ len = snprintf(NULL, 0, "(none):%zu:%zu: ", context->parser->line, context->parser->col);
+
+ va_start(args, error);
+ len += vsnprintf(NULL, 0, error, args);
+ va_end(args);
+ s = malloc(len+1);
+ if (s == NULL)
+ return;
+
+ if (context->parser->file != NULL)
+ pos = snprintf(s, len+1, "%s:%zu:%zu: ", context->parser->file, context->parser->line, context->parser->col);
+ else
+ pos = snprintf(s, len+1, "(none):%zu:%zu: ", context->parser->line, context->parser->col);
+ va_start(args, error);
+ vsnprintf(&s[pos], len+1-pos, error, args);
+ va_end(args);
+ context->error = s;
+ }
+ else
+ {
+ va_start(args, error);
+ len = vsnprintf(NULL, 0, error, args);
+ va_end(args);
+ s = malloc(len+1);
+ if (s == NULL)
+ return;
+
+ va_start(args, error);
+ vsnprintf(s, len+1, error, args);
+ va_end(args);
+ context->error = s;
+ }
+}
+
+int SRBF_InterpretData(srbf_context_t *context, const char *data, size_t size, const char *filename)
+{
+ srbf_parser_t parser =
+ {
+ .data = data,
+ .file = filename,
+ .len = size,
+ .pos = 0,
+
+ .line = 1,
+ .col = 1,
+ };
+
+ context->parser = &parser;
+ char *buf = malloc(SRBF_MAX_WORD_LEN);
+ if (buf == NULL)
+ return 0;
+
+ for (;;)
+ {
+ if (!SRBF_ReadNextToken(&parser, buf, SRBF_MAX_WORD_LEN))
+ break;
+
+ if (!SRBF_InvokeWord(context, buf))
+ {
+ context->parser = NULL;
+ free(buf);
+ return 0;
+ }
+ }
+
+ context->parser = NULL;
+ free(buf);
+ return 1;
+}
diff --git a/src/forth/srbf_word.c b/src/forth/srbf_word.c
new file mode 100644
index 0000000000000000000000000000000000000000..93881604a04af1362ee148708f148e5a83a69083
--- /dev/null
+++ b/src/forth/srbf_word.c
@@ -0,0 +1,364 @@
+// SONIC ROBO BLAST 2
+//-----------------------------------------------------------------------------
+// Copyright (C) 2012-2016 by John "JTE" Muniz.
+// Copyright (C) 2012-2025 by Sonic Team Junior.
+//
+// This program is free software distributed under the
+// terms of the GNU General Public License, version 2.
+// See the 'LICENSE' file for more details.
+//-----------------------------------------------------------------------------
+/// \file srbf_word.c
+/// \brief Word logic for Forth
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#include "srbf.h"
+
+static int Add(srbf_context_t *context)
+{
+ SRBF_ASSERT_STACK_SIZE(context, 2);
+ SRBF_Push(context, SRBF_Pop(context) + SRBF_Pop(context));
+ return 1;
+}
+
+static int Sub(srbf_context_t *context)
+{
+ srbf_cell_t cell;
+ SRBF_ASSERT_STACK_SIZE(context, 2);
+ cell = SRBF_Pop(context);
+ SRBF_Push(context, SRBF_Pop(context) - cell);
+ return 1;
+}
+
+static int Mul(srbf_context_t *context)
+{
+ SRBF_ASSERT_STACK_SIZE(context, 2);
+ SRBF_Push(context, SRBF_Pop(context) * SRBF_Pop(context));
+ return 1;
+}
+
+static int Div(srbf_context_t *context)
+{
+ srbf_cell_t cell;
+ SRBF_ASSERT_STACK_SIZE(context, 2);
+ cell = SRBF_Pop(context);
+ SRBF_Push(context, SRBF_Pop(context) / cell);
+ return 1;
+}
+
+static int Drop(srbf_context_t *context)
+{
+ SRBF_ASSERT_STACK_SIZE(context, 1);
+ context->datastack_pos--;
+ return 1;
+}
+
+static int ReadCell(srbf_context_t *context)
+{
+ srbf_ucell_t cell;
+ SRBF_ASSERT_STACK_SIZE(context, 1);
+ cell = SRBF_Pop(context);
+ if (!SRBF_ReadCell(context, cell, &cell))
+ return 0;
+
+ SRBF_Push(context, cell);
+ return 1;
+}
+
+static int ReadChar(srbf_context_t *context)
+{
+ srbf_cell_t cell;
+ srbf_uchar_t c;
+ SRBF_ASSERT_STACK_SIZE(context, 1);
+ cell = SRBF_Pop(context);
+ if (!SRBF_ReadChar(context, cell, &c))
+ return 0;
+
+ SRBF_Push(context, c);
+ return 1;
+}
+
+static int WriteCell(srbf_context_t *context)
+{
+ srbf_cell_t cell, data;
+ SRBF_ASSERT_STACK_SIZE(context, 2);
+ cell = SRBF_Pop(context);
+ data = SRBF_Pop(context);
+ if (!SRBF_WriteCell(context, cell, data))
+ return 0;
+ return 1;
+}
+
+static int WriteChar(srbf_context_t *context)
+{
+ srbf_cell_t cell;
+ srbf_uchar_t data;
+ SRBF_ASSERT_STACK_SIZE(context, 2);
+ cell = SRBF_Pop(context);
+ data = SRBF_Pop(context);
+ if (!SRBF_WriteChar(context, cell, data))
+ return 0;
+ return 1;
+}
+
+static int ReserveCell(srbf_context_t *context)
+{
+ SRBF_ASSERT_STACK_SIZE(context, 1);
+ while (context->memory_size % sizeof(srbf_ucell_t))
+ context->memory_size++; // make sure we're aligned
+
+ if (!SRBF_AllocateMemory(context, sizeof(srbf_ucell_t)))
+ return 0;
+
+ context->cell_memory[context->memory_size - sizeof(srbf_ucell_t)] = SRBF_Pop(context);
+ return 1;
+}
+
+static int ReserveChar(srbf_context_t *context)
+{
+ SRBF_ASSERT_STACK_SIZE(context, 1);
+ while (context->memory_size % sizeof(srbf_uchar_t))
+ context->memory_size++; // make sure we're aligned
+
+ if (!SRBF_AllocateMemory(context, sizeof(srbf_uchar_t)))
+ return 0;
+
+ context->memory[context->memory_size - sizeof(srbf_uchar_t)] = SRBF_Pop(context);
+ return 1;
+}
+
+static int Allocate(srbf_context_t *context)
+{
+ SRBF_ASSERT_STACK_SIZE(context, 1);
+ return SRBF_AllocateMemory(context, SRBF_Pop(context));
+}
+
+static int GetDataSpace(srbf_context_t *context)
+{
+ SRBF_ASSERT_STACK_FREE(context, 1);
+ SRBF_Push(context, context->memory_size);
+ return 1;
+}
+
+static int Colon(srbf_context_t *context)
+{
+ char *buf = malloc(SRBF_MAX_WORD_LEN);
+ size_t len;
+ if (context->state != SRBF_INTERPRET)
+ {
+ SRBF_PushError(context, "Cannot compile word here");
+ return 0;
+ }
+
+ len = SRBF_ReadNextToken(context->parser, buf, SRBF_MAX_WORD_LEN);
+ if (len == 0)
+ {
+ SRBF_PushError(context, "Unexpected EOF");
+ free(buf);
+ return 0;
+ }
+
+ // relieve some space - shouldn't be able to fail since it shrinks it
+ buf = realloc(buf, len+1);
+ assert(buf != NULL);
+
+ context->current_word = malloc(sizeof(*context->current_word));
+ if (context->current_word == NULL)
+ {
+ SRBF_PushError(context, "Out of memory");
+ free(buf);
+ return 0;
+ }
+
+ // TODO: overwrite words
+ context->current_word->word = buf;
+ context->current_word->func = NULL;
+ context->current_word->num_words = 0;
+ context->current_word->words = NULL;
+ context->current_word->immediate = 0;
+
+ context->state = SRBF_COMPILE;
+ return 1;
+}
+
+static int Semicolon(srbf_context_t *context)
+{
+ srbf_word_t *tmp;
+ if (context->state != SRBF_COMPILE)
+ {
+ SRBF_PushError(context, "No compilation to end");
+ return 0;
+ }
+
+ tmp = realloc(context->wordtable, sizeof(context->wordtable[0]) * (context->wordtable_len + 1));
+ if (tmp == NULL)
+ {
+ SRBF_PushError(context, "Out of memory");
+ return 0;
+ }
+
+ context->wordtable = tmp;
+ memcpy(&context->wordtable[context->wordtable_len], context->current_word, sizeof(*context->current_word));
+ context->wordtable_len++;
+ free(context->current_word);
+ context->current_word = NULL;
+ context->state = SRBF_INTERPRET;
+ return 1;
+}
+
+static int Base(srbf_context_t *context)
+{
+ srbf_cell_t cell;
+ SRBF_ASSERT_STACK_FREE(context, 1);
+ SRBF_Push(context, SRBF_BASE_ADDRESS);
+ return 1;
+}
+
+static const srbf_word_t standard_words[] =
+{
+ SRBF_NATIVE_WORD("+", Add, 0),
+ SRBF_NATIVE_WORD("-", Sub, 0),
+ SRBF_NATIVE_WORD("*", Mul, 0),
+ SRBF_NATIVE_WORD("/", Div, 0),
+ SRBF_NATIVE_WORD("DROP", Drop, 0),
+ SRBF_NATIVE_WORD("@", ReadCell, 0),
+ SRBF_NATIVE_WORD("C@", ReadChar, 0),
+ SRBF_NATIVE_WORD("!", WriteCell, 0),
+ SRBF_NATIVE_WORD("C!", WriteChar, 0),
+ SRBF_NATIVE_WORD(",", ReserveCell, 0),
+ SRBF_NATIVE_WORD("C,", ReserveChar, 0),
+ SRBF_NATIVE_WORD("ALLOT", Allocate, 0),
+ SRBF_NATIVE_WORD("HERE", GetDataSpace, 0),
+ SRBF_NATIVE_WORD(":", Colon, 0),
+ SRBF_NATIVE_WORD(";", Semicolon, 1),
+ SRBF_NATIVE_WORD("BASE", Base, 0),
+};
+
+int SRBF_LoadWordtable(srbf_context_t *context)
+{
+ context->wordtable_len = sizeof(standard_words) / sizeof(standard_words[0]);
+ context->wordtable = malloc(sizeof(standard_words));
+ if (context->wordtable == NULL)
+ return 0;
+
+ memcpy(context->wordtable, standard_words, sizeof(standard_words));
+ return 1;
+}
+
+int SRBF_AddWords(srbf_context_t *context, const srbf_word_t *word, size_t count)
+{
+ srbf_word_t *tmp = realloc(context->wordtable, sizeof(context->wordtable[0]) * (context->wordtable_len + count));
+ if (tmp == NULL)
+ {
+ SRBF_PushError(context, "Out of memory");
+ return 0;
+ }
+
+ context->wordtable = tmp;
+
+ memcpy(&context->wordtable[context->wordtable_len], word, sizeof(*word) * count);
+ context->wordtable_len += count;
+ return 1;
+}
+
+static int PushWord(srbf_context_t *context, const char *name)
+{
+ srbf_word_t *word = context->current_word;
+ const char **tmp;
+ tmp = realloc(word->words, sizeof(*word->words) * (word->num_words + 1));
+ if (tmp == NULL)
+ {
+ SRBF_PushError(context, "Out of memory");
+ return 0;
+ }
+
+ word->words = tmp;
+ word->words[word->num_words] = name;
+ word->num_words++;
+ return 1;
+}
+
+int SRBF_InvokeWord(srbf_context_t *context, const char *name)
+{
+ size_t i;
+ unsigned char base = context->base;
+ char *end;
+ long out;
+
+ // TODO: optimize!
+ for (i = 0; i < context->wordtable_len; i++)
+ {
+ if (strcmp(context->wordtable[i].word, name) == 0)
+ {
+ if (context->state == SRBF_COMPILE && !context->wordtable[i].immediate)
+ return PushWord(context, context->wordtable[i].word);
+
+ if (context->wordtable[i].func != NULL)
+ {
+ return context->wordtable[i].func(context);
+ }
+ else
+ {
+ int laststate = context->state;
+ size_t j;
+ context->state = SRBF_EXECUTE;
+ for (j = 0; j < context->wordtable[i].num_words; j++)
+ {
+ if (!SRBF_InvokeWord(context, context->wordtable[i].words[j]))
+ return 0;
+ }
+ context->state = laststate;
+ return 1;
+ }
+ }
+ }
+
+ if (name[0] == '\'')
+ {
+ // TODO: handle unicode
+ if (name[1] == '\0' || name[2] != '\'' || name[3] != '\0')
+ {
+ SRBF_PushError(context, "Unknown name");
+ return 0;
+ }
+
+ SRBF_ASSERT_STACK_FREE(context, 1);
+ if (context->state == SRBF_COMPILE)
+ return PushWord(context, strdup(name));
+ else
+ context->datastack[context->datastack_pos++] = name[1];
+ return 1;
+ }
+
+ if (name[0] == '#')
+ {
+ base = 10;
+ name++;
+ }
+ else if (name[0] == '$')
+ {
+ base = 16;
+ name++;
+ }
+ else if (name[0] == '%')
+ {
+ base = 2;
+ name++;
+ }
+
+ out = strtol(name, &end, base);
+ if (*end != '\0')
+ {
+ SRBF_PushError(context, "Unknown word");
+ return 0;
+ }
+
+ SRBF_ASSERT_STACK_FREE(context, 1);
+ if (context->state == SRBF_COMPILE)
+ return PushWord(context, strdup(name));
+ else
+ context->datastack[context->datastack_pos++] = out;
+ return 1;
+}
diff --git a/src/forth_script.c b/src/forth_script.c
new file mode 100644
index 0000000000000000000000000000000000000000..536b6334c01b85e397ec93bfa41b1a48e86e7c15
--- /dev/null
+++ b/src/forth_script.c
@@ -0,0 +1,52 @@
+// SONIC ROBO BLAST 2
+//-----------------------------------------------------------------------------
+// Copyright (C) 2012-2016 by John "JTE" Muniz.
+// Copyright (C) 2012-2025 by Sonic Team Junior.
+//
+// This program is free software distributed under the
+// terms of the GNU General Public License, version 2.
+// See the 'LICENSE' file for more details.
+//-----------------------------------------------------------------------------
+/// \file forth_script.c
+/// \brief Forth scripting basics
+
+#include "forth/srbf.h"
+#include "w_wad.h"
+#include "z_zone.h"
+#include "forth_script.h"
+
+static srbf_context_t *forth_context;
+
+static int Dot(srbf_context_t *context)
+{
+ SRBF_ASSERT_STACK_SIZE(context, 1);
+ CONS_Printf("%d\n", SRBF_Pop(context));
+ return 1;
+}
+
+static const srbf_word_t words[] =
+{
+ SRBF_NATIVE_WORD(".", Dot, 0),
+};
+
+void FORTH_DoLump(UINT16 wad, UINT16 lump)
+{
+ size_t size = W_LumpLengthPwad(wad, lump);
+ char *data = Z_Malloc(size, PU_STATIC, NULL);
+ W_ReadLumpPwad(wad, lump, data);
+
+ if (forth_context == NULL)
+ {
+ char const *err;
+ forth_context = SRBF_CreateContext(&err);
+ if (forth_context == NULL)
+ I_Error("Failed to initialize Forth context: %s", err);
+
+ if (!SRBF_AddWords(forth_context, words, sizeof(words) / sizeof(words[0])))
+ I_Error("Failed to allocate Forth words: %s", SRBF_GetError(forth_context));
+ }
+
+ if (!SRBF_InterpretData(forth_context, data, size, wadfiles[wad]->filename))
+ CONS_Alert(CONS_ERROR, "Parser error: %s\n", SRBF_GetError(forth_context));
+ Z_Free(data);
+}
diff --git a/src/forth_script.h b/src/forth_script.h
new file mode 100644
index 0000000000000000000000000000000000000000..c5ce2d0c28adfb7d26d2d2475516b172588a149a
--- /dev/null
+++ b/src/forth_script.h
@@ -0,0 +1,18 @@
+// SONIC ROBO BLAST 2
+//-----------------------------------------------------------------------------
+// Copyright (C) 2012-2016 by John "JTE" Muniz.
+// Copyright (C) 2012-2024 by Sonic Team Junior.
+//
+// This program is free software distributed under the
+// terms of the GNU General Public License, version 2.
+// See the 'LICENSE' file for more details.
+//-----------------------------------------------------------------------------
+/// \file lua_script.h
+/// \brief Lua scripting basics
+
+#ifndef FORTH_SCRIPT_H
+#define FORTH_SCRIPT_H
+
+void FORTH_DoLump(UINT16 wad, UINT16 lump);
+
+#endif // FORTH_SCRIPT_H
diff --git a/src/m_menu.c b/src/m_menu.c
index 37d191a0df84158e31d0d782d6f4b2d6b819eadc..66cb6ef138db3b9add1575529a50f3c69af34749 100644
--- a/src/m_menu.c
+++ b/src/m_menu.c
@@ -6253,6 +6253,7 @@ static void M_LoadAddonsPatches(void)
addonsp[EXT_PK3] = W_CachePatchName("M_FPK3", PU_PATCH);
addonsp[EXT_SOC] = W_CachePatchName("M_FSOC", PU_PATCH);
addonsp[EXT_LUA] = W_CachePatchName("M_FLUA", PU_PATCH);
+ addonsp[EXT_FORTH] = W_CachePatchName("M_FLUA", PU_PATCH);
addonsp[NUM_EXT] = W_CachePatchName("M_FUNKN", PU_PATCH);
addonsp[NUM_EXT+1] = W_CachePatchName("M_FSEL", PU_PATCH);
addonsp[NUM_EXT+2] = W_CachePatchName("M_FLOAD", PU_PATCH);
@@ -6748,6 +6749,7 @@ static void M_HandleAddons(INT32 choice)
M_AddonExec(KEY_ENTER);
break;
case EXT_LUA:
+ case EXT_FORTH:
case EXT_SOC:
case EXT_WAD:
#ifdef USE_KART
diff --git a/src/w_wad.c b/src/w_wad.c
index 50ba622a9b32f538b18d50dcdf29fbfd457f7355..ed30fefd617946c2bfcdf77678e3a69fc374ca72 100644
--- a/src/w_wad.c
+++ b/src/w_wad.c
@@ -66,6 +66,7 @@
#include "md5.h"
#include "lua_script.h"
#include "lua_hook.h"
+#include "forth_script.h"
#ifdef SCANTHINGS
#include "p_setup.h" // P_ScanThings
#endif
@@ -224,6 +225,22 @@ static void W_LoadDehackedLumpsPK3(UINT16 wadnum, boolean mainfile)
}
}
+ posStart = W_CheckNumForFullNamePK3("Init.fs", wadnum, 0);
+ if (posStart != INT16_MAX)
+ {
+ FORTH_DoLump(wadnum, posStart);
+ }
+ else
+ {
+ posStart = W_CheckNumForFolderStartPK3("Forth/", wadnum, 0);
+ if (posStart != INT16_MAX)
+ {
+ posEnd = W_CheckNumForFolderEndPK3("Forth/", wadnum, posStart);
+ for (; posStart < posEnd; posStart++)
+ FORTH_DoLump(wadnum, posStart);
+ }
+ }
+
posStart = W_CheckNumForFolderStartPK3("SOC/", wadnum, 0);
if (posStart != INT16_MAX)
{
@@ -255,6 +272,13 @@ static void W_LoadDehackedLumps(UINT16 wadnum, boolean mainfile)
if (memcmp(lump_p->name,"LUA_",4)==0)
LUA_DoLump(wadnum, lump, true);
}
+ {
+
+ lumpinfo_t *lump_p = wadfiles[wadnum]->lumpinfo;
+ for (lump = 0; lump < wadfiles[wadnum]->numlumps; lump++, lump_p++)
+ if (memcmp(lump_p->name,"FS_",3)==0)
+ FORTH_DoLump(wadnum, lump);
+ }
{
lumpinfo_t *lump_p = wadfiles[wadnum]->lumpinfo;
@@ -349,6 +373,8 @@ static restype_t ResourceFileDetect (const char* filename)
return RET_SOC;
if (!stricmp(&filename[strlen(filename) - 4], ".lua"))
return RET_LUA;
+ if (!stricmp(&filename[strlen(filename) - 3], ".fs"))
+ return RET_FORTH;
return RET_WAD;
}
@@ -929,6 +955,9 @@ UINT16 W_InitFile(const char *filename, boolean mainfile, boolean startup)
case RET_LUA:
lumpinfo = ResGetLumpsStandalone(handle, &numlumps, "LUA_INIT");
break;
+ case RET_FORTH:
+ lumpinfo = ResGetLumpsStandalone(handle, &numlumps, "FS_INIT");
+ break;
case RET_PK3:
lumpinfo = ResGetLumpsZip(handle, &numlumps);
break;
@@ -1006,6 +1035,9 @@ UINT16 W_InitFile(const char *filename, boolean mainfile, boolean startup)
case RET_LUA:
LUA_DoLump(numwadfiles - 1, 0, true);
break;
+ case RET_FORTH:
+ FORTH_DoLump(numwadfiles - 1, 0);
+ break;
default:
break;
}
@@ -2658,6 +2690,7 @@ static lumpchecklist_t folderblacklist[] =
{
{"Lua/", 4},
{"SOC/", 4},
+ {"Forth/", 6},
{"Sprites/", 8},
{"LongSprites/", 12},
{"Textures/", 9},
@@ -2815,7 +2848,8 @@ static int W_VerifyFile(const char *filename, lumpchecklist_t *checklist,
{
// detect wad file by the absence of the other supported extensions
if (stricmp(&filename[strlen(filename) - 4], ".soc")
- && stricmp(&filename[strlen(filename) - 4], ".lua"))
+ && stricmp(&filename[strlen(filename) - 4], ".lua")
+ && stricmp(&filename[strlen(filename) - 3], ".fs"))
{
goodfile = W_VerifyWAD(handle, checklist, status);
}
diff --git a/src/w_wad.h b/src/w_wad.h
index 84aafa3a40e2e48f662c723d5a5854138806b5b0..4a50384ef91a67dbc06640e2218781edc6257b60 100644
--- a/src/w_wad.h
+++ b/src/w_wad.h
@@ -116,6 +116,7 @@ typedef enum restype
RET_WAD,
RET_SOC,
RET_LUA,
+ RET_FORTH,
RET_PK3,
RET_FOLDER,
RET_UNKNOWN,