ed/forth_bootslop
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

progress

Browse Source
This commit is contained in:
Edward R. Gonzalez
2026-02-19 17:33:34 -05:00
parent b9d39d9d79
commit 0c6c895a1f
1 changed files with 243 additions and 132 deletions
Download Patch File Download Diff File Expand all files Collapse all files

385
attempt_1/main.c
View File

@@ -5,84 +5,100 @@
#include "duffle.amd64.win32.h" #include "duffle.amd64.win32.h"
// --- Win32 Minimal Definitions --- // --- WinAPI Minimal Definitions ---
typedef void* HWND; typedef int MS_BOOL;
typedef void* HMENU; typedef unsigned long MS_DWORD;
typedef void* HINSTANCE; typedef void* MS_HANDLE;
typedef void* HICON; typedef MS_HANDLE MS_HWND;
typedef void* HCURSOR; typedef MS_HANDLE MS_HMENU;
typedef void* HBRUSH; typedef MS_HANDLE MS_HINSTANCE;
typedef void* HDC; typedef MS_HANDLE MS_HICON;
typedef MS_HANDLE MS_HCURSOR;
typedef MS_HANDLE MS_HBRUSH;
typedef MS_HANDLE MS_HDC;
typedef MS_HANDLE MS_HFONT;
typedef long MS_LONG;
typedef char const* MS_LPCSTR;
typedef void* MS_LPVOID;
typedef S8 MS_LRESULT;
typedef U8 MS_WPARAM;
typedef S8 MS_LPARAM;
typedef U4 MS_UINT;
typedef struct { typedef struct MS_WNDCLASSA {
U4 style; MS_UINT style;
S8 (*lpfnWndProc)(HWND, U4, U8, S8); MS_LRESULT (*lpfnWndProc)(MS_HWND, MS_UINT, MS_WPARAM, MS_LPARAM);
U4 cbClsExtra; int cbClsExtra;
U4 cbWndExtra; int cbWndExtra;
HINSTANCE hInstance; MS_HINSTANCE hInstance;
HICON hIcon; MS_HICON hIcon;
HCURSOR hCursor; MS_HCURSOR hCursor;
HBRUSH hbrBackground; MS_HBRUSH hbrBackground;
const char* lpszMenuName; MS_LPCSTR lpszMenuName;
const char* lpszClassName; MS_LPCSTR lpszClassName;
} WNDCLASSA; } MS_WNDCLASSA;
typedef struct { typedef struct MS_POINT {
S4 x, y; MS_LONG x, y;
} POINT; } MS_POINT;
typedef struct { typedef struct MS_MSG {
HWND hwnd; MS_HWND hwnd;
U4 message; MS_UINT message;
U8 wParam; MS_WPARAM wParam;
S8 lParam; MS_LPARAM lParam;
U4 time; MS_DWORD time;
POINT pt; MS_POINT pt;
} MSG; } MS_MSG;
typedef struct { typedef struct MS_RECT {
S4 left, top, right, bottom; MS_LONG left, top, right, bottom;
} RECT; } MS_RECT;
typedef struct { typedef struct MS_PAINTSTRUCT {
HDC hdc; MS_HDC hdc;
U4 fErase; MS_BOOL fErase;
RECT rcPaint; MS_RECT rcPaint;
U4 fRestore; MS_BOOL fRestore;
U4 fIncUpdate; MS_BOOL fIncUpdate;
U1 rgbReserved[32]; U1 rgbReserved[32];
} PAINTSTRUCT; } MS_PAINTSTRUCT;
// Win32 API declarations // Win32 API declarations
WinAPI void* ms_virtual_alloc(void* addr, U8 size, U4 allocation_type, U4 protect) asm("VirtualAlloc"); WinAPI MS_LPVOID VirtualAlloc(MS_LPVOID lpAddress, U8 dwSize, MS_DWORD flAllocationType, MS_DWORD flProtect);
WinAPI void ms_exit_process(U4 status) asm("ExitProcess"); WinAPI void ExitProcess(MS_UINT uExitCode);
WinAPI U2 ms_register_class(const WNDCLASSA* lpWndClass) asm("RegisterClassA"); WinAPI U2 RegisterClassA(const MS_WNDCLASSA* lpWndClass);
WinAPI HWND ms_create_window(U4 dwExStyle, const char* lpClassName, const char* lpWindowName, U4 dwStyle, S4 X, S4 Y, S4 nWidth, S4 nHeight, HWND hWndParent, HMENU hMenu, HINSTANCE hInstance, void* lpParam) asm("CreateWindowExA"); WinAPI MS_HWND CreateWindowExA(MS_DWORD dwExStyle, MS_LPCSTR lpClassName, MS_LPCSTR lpWindowName, MS_DWORD dwStyle, int X, int Y, int nWidth, int nHeight, MS_HWND hWndParent, MS_HMENU hMenu, MS_HINSTANCE hInstance, MS_LPVOID lpParam);
WinAPI B4 ms_show_window(HWND hWnd, S4 nCmdShow) asm("ShowWindow"); WinAPI MS_BOOL ShowWindow(MS_HWND hWnd, int nCmdShow);
WinAPI B4 ms_get_message(MSG* lpMsg, HWND hWnd, U4 wMsgFilterMin, U4 wMsgFilterMax) asm("GetMessageA"); WinAPI MS_BOOL GetMessageA(MS_MSG* lpMsg, MS_HWND hWnd, MS_UINT wMsgFilterMin, MS_UINT wMsgFilterMax);
WinAPI B4 ms_translate_message(const MSG* lpMsg) asm("TranslateMessage"); WinAPI MS_BOOL TranslateMessage(const MS_MSG* lpMsg);
WinAPI S8 ms_dispatch_message(const MSG* lpMsg) asm("DispatchMessageA"); WinAPI MS_LRESULT DispatchMessageA(const MS_MSG* lpMsg);
WinAPI S8 ms_def_window_proc(HWND hWnd, U4 Msg, U8 wParam, S8 lParam) asm("DefWindowProcA"); WinAPI MS_LRESULT DefWindowProcA(MS_HWND hWnd, MS_UINT Msg, MS_WPARAM wParam, MS_LPARAM lParam);
WinAPI void ms_post_quit_message(S4 nExitCode) asm("PostQuitMessage"); WinAPI void PostQuitMessage(int nExitCode);
WinAPI MS_BOOL InvalidateRect(MS_HWND hWnd, const MS_RECT* lpRect, MS_BOOL bErase);
WinAPI HDC ms_begin_paint(HWND hWnd, PAINTSTRUCT* lpPaint) asm("BeginPaint"); WinAPI MS_HDC BeginPaint(MS_HWND hWnd, MS_PAINTSTRUCT* lpPaint);
WinAPI B4 ms_end_paint(HWND hWnd, const PAINTSTRUCT* lpPaint) asm("EndPaint"); WinAPI MS_BOOL EndPaint(MS_HWND hWnd, const MS_PAINTSTRUCT* lpPaint);
WinAPI U4 ms_set_text_color(HDC hdc, U4 color) asm("SetTextColor"); WinAPI MS_DWORD SetTextColor(MS_HDC hdc, MS_DWORD color);
WinAPI U4 ms_set_bk_color(HDC hdc, U4 color) asm("SetBkColor"); WinAPI MS_DWORD SetBkColor(MS_HDC hdc, MS_DWORD color);
WinAPI B4 ms_text_out(HDC hdc, S4 x, S4 y, const char* lpString, S4 c) asm("TextOutA"); WinAPI MS_BOOL TextOutA(MS_HDC hdc, int x, int y, MS_LPCSTR lpString, int c);
WinAPI void* ms_get_stock_object(S4 i) asm("GetStockObject"); WinAPI MS_HANDLE GetStockObject(int i);
WinAPI MS_HFONT CreateFontA(int cHeight, int cWidth, int cEscapement, int cOrientation, int cWeight, MS_DWORD bItalic, MS_DWORD bUnderline, MS_DWORD bStrikeOut, MS_DWORD iCharSet, MS_DWORD iOutPrecision, MS_DWORD iClipPrecision, MS_DWORD iQuality, MS_DWORD iPitchAndFamily, MS_LPCSTR pszFaceName);
WinAPI MS_HANDLE SelectObject(MS_HDC hdc, MS_HANDLE h);
#define MEM_COMMIT 0x00001000 #define MS_MEM_COMMIT 0x00001000
#define MEM_RESERVE 0x00002000 #define MS_MEM_RESERVE 0x00002000
#define PAGE_READWRITE 0x04 #define MS_PAGE_READWRITE 0x04
#define WM_DESTROY 0x0002 #define MS_WM_DESTROY 0x0002
#define WM_PAINT 0x000F #define MS_WM_PAINT 0x000F
#define WS_OVERLAPPEDWINDOW 0x00CF0000 #define MS_WM_KEYDOWN 0x0100
#define WS_VISIBLE 0x10000000 #define MS_WS_OVERLAPPEDWINDOW 0x00CF0000
#define SW_SHOW 5 #define MS_WS_VISIBLE 0x10000000
#define COLOR_WINDOW 5
#define MS_VK_PRIOR 0x21 // Page Up
#define MS_VK_NEXT 0x22 // Page Down
// --- Semantic Tags (The "Colors" of ColorForth) --- // --- Semantic Tags (The "Colors" of ColorForth) ---
#define TAG_DEFINE 0x0 // RED: New word definition #define TAG_DEFINE 0x0 // RED: New word definition
@@ -99,20 +115,24 @@ WinAPI void* ms_get_stock_object(S4 i) asm("GetStockObject");
// The Tape Drive (Memory Arena) // The Tape Drive (Memory Arena)
global U4* tape; global U4* tape;
global U8 tape_pos = 0; global U8 tape_pos = 0;
global U8 view_block = 0; // Current block being viewed
#define TOKENS_PER_BLOCK 256
// Virtual Machine State (Onat's 2-item stack)
global U8 vm_rax = 0;
global U8 vm_rdx = 0;
internal void scatter(U4 token) { internal void scatter(U4 token) {
tape[tape_pos++] = token; tape[tape_pos++] = token;
} }
// Helper to convert hex value to string without CRT // Minimal u64 to hex string helper
internal void u32_to_hex(U4 val, char* buf) { internal void u64_to_hex(U8 val, char* buf, int chars) {
static const char hex_chars[] = "0123456789ABCDEF"; static const char hex_chars[] = "0123456789ABCDEF";
buf[0] = '0'; buf[1] = 'x'; for(S1 i = chars - 1; i >= 0; --i) {
for(S1 i = 8; i >= 1; --i) { buf[i] = hex_chars[val & 0xF];
buf[i+1] = hex_chars[val & 0xF];
val >>= 4; val >>= 4;
} }
buf[10] = '\0';
} }
// Provide memset for the compiler's implicit struct zeroing (-nostdlib) // Provide memset for the compiler's implicit struct zeroing (-nostdlib)
@@ -124,27 +144,89 @@ void* memset(void* dest, int c, U8 count) {
return dest; return dest;
} }
// --- Window Procedure (Event Loop) --- // --- The Tiny Interpreter ---
S8 win_proc(HWND hwnd, U4 msg, U8 wparam, S8 lparam) { internal void vm_execute(U4 val) {
switch (msg) { // Very rudimentary simulated execution.
case WM_PAINT: { // 0x1 = DUP
PAINTSTRUCT ps; // 0x2 = MULT
HDC hdc = ms_begin_paint(hwnd, &ps); // Normally this would look up the address in the dictionary.
if (val == 0x1) {
// DUP (push rax into rdx, simulating a 2-reg stack)
vm_rdx = vm_rax;
} else if (val == 0x2) {
// MULT (rax = rax * rdx)
vm_rax = vm_rax * vm_rdx;
} else if (val == 0x51415245) {
// Call "SQUARE". For this tiny mock, we just execute its body directly: DUP *
vm_execute(0x1); // DUP
vm_execute(0x2); // MULT
}
}
// Dark background (0x00bbggrr) internal void vm_eval_tape() {
U4 bg_color = 0x001E1E1E; for (U8 i = 0; i < tape_pos; ++i) {
ms_set_bk_color(hdc, bg_color);
S4 x = 20;
S4 y = 20;
S4 line_height = 20;
for (U8 i = 0; i < tape_pos; i++) {
U4 t = tape[i]; U4 t = tape[i];
U4 tag = UNPACK_TAG(t); U4 tag = UNPACK_TAG(t);
U4 val = UNPACK_VAL(t); U4 val = UNPACK_VAL(t);
U4 color = 0x00FFFFFF; // Default White if (tag == TAG_DATA) {
// Push data onto the 2-register stack (simulate the xchg setup)
vm_rdx = vm_rax;
vm_rax = val;
} else if (tag == TAG_IMM) {
// Execute immediately
vm_execute(val);
}
}
}
// --- Window Procedure (Event Loop) ---
MS_LRESULT win_proc(MS_HWND hwnd, MS_UINT msg, MS_WPARAM wparam, MS_LPARAM lparam) {
switch (msg) {
case MS_WM_KEYDOWN: {
if (wparam == MS_VK_NEXT) { // Page Down
if ((view_block + 1) * TOKENS_PER_BLOCK < tape_pos) view_block++;
InvalidateRect(hwnd, NULL, true);
} else if (wparam == MS_VK_PRIOR) { // Page Up
if (view_block > 0) view_block--;
InvalidateRect(hwnd, NULL, true);
}
return 0;
}
case MS_WM_PAINT: {
MS_PAINTSTRUCT ps;
MS_HDC hdc = BeginPaint(hwnd, &ps);
// Modern Monospace Font (Consolas)
MS_HFONT hFont = CreateFontA(22, 0, 0, 0, 400, 0, 0, 0, 0, 0, 0, 0, 0, "Consolas");
MS_HANDLE hOldFont = SelectObject(hdc, hFont);
// Dark background
U4 bg_color = 0x001E1E1E;
SetBkColor(hdc, bg_color);
int x = 20;
int y = 20;
int line_height = 24;
// Render Block Header
SetTextColor(hdc, 0x00AAAAAA);
char header_str[32] = "Block 0x000";
u64_to_hex(view_block, header_str + 8, 3);
TextOutA(hdc, x, y, header_str, 11);
y += line_height * 2;
// Render Tokens for current block
U8 start_idx = view_block * TOKENS_PER_BLOCK;
U8 end_idx = start_idx + TOKENS_PER_BLOCK;
if (end_idx > tape_pos) end_idx = tape_pos;
for (U8 i = start_idx; i < end_idx; i++) {
U4 t = tape[i];
U4 tag = UNPACK_TAG(t);
U4 val = UNPACK_VAL(t);
U4 color = 0x00FFFFFF;
const char* prefix = ""; const char* prefix = "";
switch (tag) { switch (tag) {
@@ -152,74 +234,103 @@ S8 win_proc(HWND hwnd, U4 msg, U8 wparam, S8 lparam) {
case TAG_CALL: color = 0x0033FF33; prefix = "~ "; break; // GREEN case TAG_CALL: color = 0x0033FF33; prefix = "~ "; break; // GREEN
case TAG_DATA: color = 0x00FFFF33; prefix = "$ "; break; // CYAN case TAG_DATA: color = 0x00FFFF33; prefix = "$ "; break; // CYAN
case TAG_IMM: color = 0x0033FFFF; prefix = "^ "; break; // YELLOW case TAG_IMM: color = 0x0033FFFF; prefix = "^ "; break; // YELLOW
case TAG_COMMENT: color = 0x00AAAAAA; prefix = ". "; break; // DIM/WHITE case TAG_COMMENT: color = 0x00AAAAAA; prefix = ". "; break; // DIM
} }
ms_set_text_color(hdc, color); SetTextColor(hdc, color);
TextOutA(hdc, x, y, prefix, 2);
// Print prefix char val_str[8];
ms_text_out(hdc, x, y, prefix, 2); u64_to_hex(val, val_str, 7);
val_str[7] = '\0';
// Print hex value TextOutA(hdc, x + 24, y, val_str, 7);
char val_str[12];
u32_to_hex(val, val_str);
ms_text_out(hdc, x + 20, y, val_str, 10);
y += line_height; y += line_height;
// Simple column wrapping inside the block
if (y > 500) {
y = 20 + line_height * 2;
x += 160;
}
} }
ms_end_paint(hwnd, &ps); // Render VM State at the bottom right
y = 480;
x = 600;
SetTextColor(hdc, 0x00FFFFFF);
TextOutA(hdc, x, y, "VM State (2-Reg Stack)", 22);
y += line_height;
char rax_str[16] = "RAX: 0x00000000";
char rdx_str[16] = "RDX: 0x00000000";
u64_to_hex(vm_rax, rax_str + 7, 8);
u64_to_hex(vm_rdx, rdx_str + 7, 8);
SetTextColor(hdc, 0x0033FF33);
TextOutA(hdc, x, y, rax_str, 15);
y += line_height;
SetTextColor(hdc, 0x00FFFF33);
TextOutA(hdc, x, y, rdx_str, 15);
SelectObject(hdc, hOldFont);
EndPaint(hwnd, &ps);
return 0; return 0;
} }
case WM_DESTROY: { case MS_WM_DESTROY: {
ms_post_quit_message(0); PostQuitMessage(0);
return 0; return 0;
} }
} }
return ms_def_window_proc(hwnd, msg, wparam, lparam); return DefWindowProcA(hwnd, msg, wparam, lparam);
} }
void main() { void main() {
// 1. Initialize the Sourceless Memory Arena (Win32 VirtualAlloc) tape = (U4*)VirtualAlloc(NULL, 64 * 1024, MS_MEM_COMMIT | MS_MEM_RESERVE, MS_PAGE_READWRITE);
tape = (U4*)ms_virtual_alloc(NULL, 64 * 1024, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE); if (!tape) ExitProcess(1);
if (!tape) ms_exit_process(1);
// 2. "Bootstrap" the content (Preemptive Scatter) // Bootstrap Block 0
scatter(PACK_TOKEN(TAG_DEFINE, 0x51415245)); // ":SQUARE" scatter(PACK_TOKEN(TAG_DEFINE, 0x51415245)); // ":SQUARE"
scatter(PACK_TOKEN(TAG_CALL, 0x00000001)); // DUP scatter(PACK_TOKEN(TAG_CALL, 0x00000001)); // DUP
scatter(PACK_TOKEN(TAG_CALL, 0x00000002)); // * scatter(PACK_TOKEN(TAG_CALL, 0x00000002)); // MULT
scatter(PACK_TOKEN(TAG_CALL, 0x00000003)); // ; (Return) scatter(PACK_TOKEN(TAG_CALL, 0x00000003)); // RET
scatter(PACK_TOKEN(TAG_COMMENT, 0x4E4F5445)); // "NOTE" scatter(PACK_TOKEN(TAG_COMMENT, 0x4E4F5445)); // ".NOTE"
scatter(PACK_TOKEN(TAG_DATA, 5)); // 5 scatter(PACK_TOKEN(TAG_DATA, 5)); // $5
scatter(PACK_TOKEN(TAG_IMM, 0x51415245)); // EXECUTE SQUARE scatter(PACK_TOKEN(TAG_IMM, 0x51415245)); // ^SQUARE
// 3. Initialize Win32 Window // Fill some padding so we can test pagination (Page Down)
WNDCLASSA wc = {0}; for(int i=0; i < 300; i++) {
wc.lpfnWndProc = win_proc; scatter(PACK_TOKEN(TAG_COMMENT, 0x0));
wc.hInstance = (HINSTANCE)ms_get_stock_object(0); // dummy instance
wc.lpszClassName = "ColorForthWindow";
// Get black brush
wc.hbrBackground = (HBRUSH)ms_get_stock_object(4); // BLACK_BRUSH
if (!ms_register_class(&wc)) ms_exit_process(1);
HWND hwnd = ms_create_window(
0,
wc.lpszClassName,
"Sourceless Tape Drive Editor",
WS_OVERLAPPEDWINDOW | WS_VISIBLE,
100, 100, 800, 600,
NULL, NULL, wc.hInstance, NULL
);
if (!hwnd) ms_exit_process(1);
// 4. Message Loop
MSG msg;
while (ms_get_message(&msg, NULL, 0, 0)) {
ms_translate_message(&msg);
ms_dispatch_message(&msg);
} }
ms_exit_process(0); // Block 1 content
scatter(PACK_TOKEN(TAG_DATA, 10)); // $10
scatter(PACK_TOKEN(TAG_IMM, 0x51415245)); // ^SQUARE
// Run Interpreter
vm_eval_tape();
// Window Setup
MS_WNDCLASSA wc;
memset(&wc, 0, sizeof(wc));
wc.lpfnWndProc = win_proc;
wc.hInstance = (MS_HINSTANCE)GetStockObject(0);
wc.lpszClassName = "ColorForthWindow";
wc.hbrBackground = (MS_HBRUSH)GetStockObject(4);
if (!RegisterClassA(&wc)) ExitProcess(1);
MS_HWND hwnd = CreateWindowExA(
0, wc.lpszClassName, "Sourceless Tape Drive Editor",
MS_WS_OVERLAPPEDWINDOW | MS_WS_VISIBLE,
100, 100, 800, 600, NULL, NULL, wc.hInstance, NULL
);
if (!hwnd) ExitProcess(1);
MS_MSG msg;
while (GetMessageA(&msg, NULL, 0, 0)) {
TranslateMessage(&msg);
DispatchMessageA(&msg);
}
ExitProcess(0);
} }