diff options
| -rw-r--r-- | .gitattributes | 1 | ||||
| -rw-r--r-- | readme.md | 15 | ||||
| -rw-r--r-- | sanctuary.s | 134 |
3 files changed, 150 insertions, 0 deletions
diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..793b39b --- /dev/null +++ b/.gitattributes @@ -0,0 +1 @@ +*.s linguist-language=nasm @@ -21,6 +21,9 @@ the following is a list of words available in this forth. ### `#tib ( -- a )` variable containing the amount of characters in the input buffer. +### `>body ( xt -- a )` +yield the code field of xt. + ### `>in ( -- a )` variable containing the index of the first unparsed character in the input buffer. @@ -57,10 +60,22 @@ grows the user memory space by u bytes. ### `here ( -- a )` yields the address of the first available byte in user memory. +### `interpret ( -- )` +interprets the contents of the terminal input buffer +until it runs out. + ### `latest ( -- a )` a variable containing the execution token of 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 )` +convert given string into a number along with a flag. +if parsing a number fails then -1 (false) is returned +and no number is provided. + ### `parse ( "name<c>" c -- a u )` parse one word from the input buffer, separated by a newline or the character c, diff --git a/sanctuary.s b/sanctuary.s index 30a9f5b..8cad3f8 100644 --- a/sanctuary.s +++ b/sanctuary.s @@ -276,6 +276,139 @@ defcode "find", find, 0 pspush r13 ret +; interpret {{{ +; r11: word found flag +; r12: state +; TODO INCOMPLETE +defcode "interpret", interpret, 0 +.loop: + call parse_name + cmp qword [r15], 0 + je .eof + call find + mov r12, qword [state] + cmp r12, INTERPRET + jne .compl + + pspop r11 + test r11, r11 ; set SF if negative (word found) + js .intrpnum + +.intrpnum: + ; TODO + +.compl: + + jmp .loop +.eof: + lea r15, [r15+16] ; drop a u + ret +; }}} + +defcode ">body", to_body, 0 + pspop r11 + add r11, 9 + xor r12, r12 + mov r12b, byte [r11] + inc r11 + add r11, r12 + pspush r11 + ret + +defcode "literal", literal, immediate_mask|comp_only_mask + ; 4d 8d 7f f8 + ; 49 bb VAL + ; 4d 89 1f + pspop r11 + mov r12, qword [here] + + mov dword [r12], 0xf87f8d4d + add r12, 4 + mov word [r12], 0xbb49 + add r12, 2 + mov qword [r12], r11 + add r12, 8 + mov word [r12], 0x894d + add r12, 2 + mov byte [r12], 0x1f + inc r12 + + mov qword [here], r12 + ret + +; TODO compile, + +; number {{{ +defcode "number", number, 0 ; ( c-addr u -- ?n flag ) + pspop r11 ; u + pspop r12 ; c-addr + xor r13, r13 ; r13: result + xor r14, r14 ; r14b: current char + xor r10, r10 ; r10: negative flag + mov r9, qword [base] + + cmp r11, 0 + je .no + + mov r14b, byte [r12] + cmp r14b, '-' + jnz .enterloop + mov r10, true + inc r12 + dec r11 + +.loop: + mov r14b, byte [r12] + +.enterloop: + ; non numeral = goodbye + cmp r14b, 48 + jl .no + + sub r14b, 48 + cmp r14b, 10 ; 48+10: < ':', <= '9' + jl .basecmp + cmp r14b, 17 ; ':' - '@' + jl .no + sub r14b, 7 ; keep 10 so 'A' = 10 + cmp r14b, 36 ; < '[' <= 'Z' + jl .basecmp + cmp r14b, 42 ; < 'a' + jl .no + sub r14b, 32 + cmp r14b, 36 ; < '{' <= 'z' + jl .basecmp + jmp .no + +.basecmp: + cmp r14, r9 + jge .no + + imul r13, r9 + add r13, r14 + + inc r12 + dec r11 + + cmp r11, 0 + jne .loop + + test r10, r10 + jz .bye + neg r13 + +.bye: + pspush r13 + mov r13, true + pspush r13 + ret + +.no: + mov r13, false + pspush r13 + ret +; }}} + ; .s {{{ defcode ".s", dots, 0 push r11 @@ -316,6 +449,7 @@ defcode ".s", dots, 0 ; }}} defvar "state", state, 0, INTERPRET +defvar "base", base, 0, 10 defvar "dp", dp, 0, 0 defvar "dp0", dp0, 0, 0 defvar "dp$", dp$, 0, 0 |