From 9d2f471ed1cde0c6e448ab6af29e734b49abe972 Mon Sep 17 00:00:00 2001 From: kitty Date: Wed, 18 Mar 2026 15:58:31 +1100 Subject: vaguely working interpretation --- readme.md | 22 ++++++++-- sanctuary.fs | 4 +- sanctuary.s | 131 +++++++++++++++++++++++++++++++++++++++++++++++++---------- 3 files changed, 130 insertions(+), 27 deletions(-) diff --git a/readme.md b/readme.md index 6416c28..a9fa679 100644 --- a/readme.md +++ b/readme.md @@ -1,6 +1,6 @@ -# sanctuary forth (working title) +# sanctuary (working title) -sanctuary forth is a 64-bit subroutine threaded forth system +sanctuary is a 64-bit subroutine threaded forth system for amd64 linux systems. ## stack effect notation @@ -21,12 +21,23 @@ the following is a list of words available in this forth. ### `#tib ( -- a )` variable containing the amount of characters in the input buffer. +### `(header) ( a u -- xt )` +create a dictionary header for a word named the provided string. +this word does not set the code field. +this word returns an incompleted xt and does not update latest. + ### `[ ( -- ) IMMEDIATE` set the system to interpret mode. ### `] ( -- ) IMMEDIATE` set the system to compiling mode. +### `: ( "name" -- )` +start compilation of the word 'name'. + +### `; ( -- ) IMMEDIATE` +end compilation of the currently compiling word. + ### `>body ( xt -- a )` yield the code field of xt. @@ -83,9 +94,9 @@ the most recently created word. ### `literal ( n -- ) IMMEDIATE COMPILE-ONLY` compile a push of the literal value n into the currently compiling word. -### `number ( a u -- n 0 | -1 )` +### `number ( a u -- n -1 | 0 )` convert given string into a number along with a flag. -if parsing a number fails then -1 (false) is returned +if parsing a number fails then 0 (false) is returned and no number is provided. ### `parse ( "name" c -- a u )` @@ -99,6 +110,9 @@ and return as a string. tabs (ascii 0x09), newlines (ascii 0x10), and spaces (ascii 0x20) are considered whitespace. +### `smudge ( -- )` +toggles the smudge bit on the xt in latest. + ### `state ( -- a )` a variable containing a boolean value. if 0 (false), the system is in interpreting mode, diff --git a/sanctuary.fs b/sanctuary.fs index 55cb17e..43dc7bb 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -1 +1,3 @@ -.s +: .s2 1 2 3 [ 7 ] literal .s ; +4 5 6 .s2 +bye diff --git a/sanctuary.s b/sanctuary.s index eda1466..a2ba5dd 100644 --- a/sanctuary.s +++ b/sanctuary.s @@ -44,8 +44,8 @@ %assign immediate_mask 0x2 %assign comp_only_mask 0x4 -%assign true 0x0 -%assign false (~0x0) +%assign false 0x0 +%assign true (~0x0) %assign INTERPRET 0x0 %assign COMPILING (~0x0) @@ -55,6 +55,8 @@ %assign __NR_brk 12 %assign __NR_exit 60 +%assign init_brk 0x9c400 + section .bss resq 4091 wstk: resq 1 @@ -68,9 +70,15 @@ _start: pspop r11 mov qword [dp], r11 mov qword [dp0], r11 - mov r11, 0x9c400 + mov r11, init_brk pspush r11 call grow + ; TODO grow should call executable automatically + mov r11, qword [dp0] + pspush r11 + mov r11, init_brk + pspush r11 + call executable call interpret call bye @@ -279,6 +287,7 @@ defcode "find", find, 0 ; r11: word found flag ; r12: state ; TODO respect comp-only flag (do this once error handling is impld) +; TODO it doesnt work right defcode "interpret", interpret, 0 .loop: call parse_name @@ -286,47 +295,53 @@ defcode "interpret", interpret, 0 je .eof call find mov r12, qword [state] - cmp r12, INTERPRET - jne .compl - + cmp r12, COMPILING + je .compl + pspop r11 - test r11, r11 ; set SF if negative (word found) - js .intrpnum + cmp r11, false + je .intrpnum .callw: ; label here for immed jump call to_body - pspop r14 - call r14 + pspop r13 + call r13 jmp .loop .intrpnum: call number pspop r11 - test r11, r11 - js .notfound + cmp r11, false + je .notfound jmp .loop .compl: + ; call dots pspop r11 - test r11, r11 - js .complnum + cmp r11, false + je .complnum ; dup immediate? if [imm] else normal then + ; i think this is broken (; not working) call dup + ; call dots call immediate_q + ; call dots pspop r13 - test r13, r13 - jns .callw + cmp r13, true + je .callw call to_body call compile_comma jmp .loop .complnum: + ; call dots call number + ; call dots pspop r11 - test r11, r11 - js .notfound + cmp r11, false + je .notfound call literal jmp .loop @@ -345,6 +360,9 @@ defcode "immediate?", immediate_q, 0 mov r12b, byte [r11] xor r13, r13 test r12b, immediate_mask + setnz r13b + neg r13 + pspush r13 ret defcode ">body", to_body, 0 @@ -362,7 +380,7 @@ defcode "literal", literal, immediate_mask|comp_only_mask ; 49 bb VAL ; 4d 89 1f pspop r11 - mov r12, qword [here] + mov r12, qword [dp] mov dword [r12], 0xf87f8d4d add r12, 4 @@ -375,12 +393,12 @@ defcode "literal", literal, immediate_mask|comp_only_mask mov byte [r12], 0x1f inc r12 - mov qword [here], r12 + mov qword [dp], r12 ret defcode "compile,", compile_comma, 0 pspop r11 - mov r12, [here] + mov r12, [dp] ; compile mov r11, [cfa] mov word [r12], 0xbb49 @@ -394,7 +412,7 @@ defcode "compile,", compile_comma, 0 mov byte [r12], 0xd3 inc r12 - mov qword [here], r12 + mov qword [dp], r12 ret defcode "[", lbrac, immediate_mask @@ -405,6 +423,63 @@ defcode "]", rbrac, immediate_mask mov qword [state], COMPILING ret +defcode "(header)", brac_header, 0 + pspop r9 + pspop r10 + mov r11, qword [latest] + mov r12, qword [dp] + push r12 + + mov qword [r12], r11 + add r12, 8 + mov byte [r12], 0 + inc r12 + mov byte [r12], r9b + inc r12 + + mov rcx, r9 + mov rsi, r10 + mov rdi, r12 + rep movsb + add r12, r9 + + mov qword [dp], r12 + pop r12 + pspush r12 + ret + +defcode ":", colon, 0 + call parse_name + ; todo check zero + call brac_header + pspop r11 + mov qword [latest], r11 + call smudge + mov qword [state], COMPILING + ret + +defcode ";", semicolon, immediate_mask + mov r12, [latest] + add r12, 8 + mov r13b, [r12] + and r13b, ~smudge_mask ; does this syntax work? equiv SMUDGEMASK NOT + mov byte [r12], r13b + + mov r11, qword [dp] + mov byte [r11], 0xc3 ; ret + inc r11 + mov qword [dp], r11 + mov qword [state], INTERPRET + ret + +defcode "smudge", smudge, 0 + mov r12, [latest] + add r12, 8 + mov r13b, [r12] + xor r13b, smudge_mask + mov byte [r12], r13b + ret + ; number {{{ defcode "number", number, 0 ; ( c-addr u -- ?n flag ) pspop r11 ; u @@ -481,6 +556,7 @@ defcode "dup", dup, 0 pspush r11 ret +; TEMPORARY WONKY DEBUGGING FUNCTIONS {{{ ; .s {{{ defcode ".s", dots, 0 push r11 @@ -520,6 +596,17 @@ defcode ".s", dots, 0 .dmsg: db "DONEDONEYIPPEEEE" ; }}} +defcode "HEREDUMP", heredump, 0 + mov rdx, [dp] + mov r11, [dp0] + sub rdx, r11 + mov rsi, [dp0] + mov rdi, 1 + mov rax, __NR_write + syscall + ret +; }}} + defvar "state", state, 0, INTERPRET defvar "base", base, 0, 10 defvar "dp", dp, 0, 0 -- cgit v1.2.3