diff options
| -rw-r--r-- | readme.md | 77 | ||||
| -rw-r--r-- | sanctuary.fs | 16 | ||||
| -rw-r--r-- | sanctuary.s | 51 |
3 files changed, 105 insertions, 39 deletions
@@ -10,6 +10,7 @@ sanctuary is a 64-bit subroutine threaded forth for amd64 linux systems. - `u`: unsigned integer - `?`: boolean flag - `xt`: execution token +- `ht`: header token - `""`: string in input buffer - `|`: 'or' @@ -31,15 +32,12 @@ have a closing bracket: ). ### `(0handler) ( -- )` the very early error handler, which simply quits the program. -### `(execute) ( a -- )` -call the function at the address. - -### `(header) ( a u -- xt )` +### `(header) ( a u -- ht )` 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. +this word does not update latest. -### `* ( u1 u2 -- u)` +### `* ( u1 u2 -- u )` multiply u1 and u2. ### `*/mod ( n1 n2 n3 -- n4 n5 )` @@ -98,22 +96,34 @@ return true if n1 is less than or equal to n2. ### `<> ( n1 n2 -- ? )` return true if n1 and n2 are not equal. +### `<mark ( -- a )` +mark the destination of a backward branch. + +### `<resolve ( a -- )` +mark the source of a backward branch. + ### `> ( n1 n2 -- ? )` return true if n1 is greater than n2. ### `>= ( n1 n2 -- ? )` return true if n1 is greater than or equal to n2. -### `>body ( xt -- a )` -yield the code field of xt. +### `>body ( ht -- xt )` +yield the code field of header token. ### `>in ( -- a )` variable containing the index of the first unparsed character in the input buffer. +### `>mark ( -- a )` +mark the source of a forward branch. + ### `>r ( u -- ) ( R: -- u )` move a value from the working stack to the return stack. +### `>resolve ( a -- )` +mark the destination of a forward branch. + ### `?branch ( -- )` compile into user memory an incomplete conditional branch. if the value on the stack is zero the branch is taken. @@ -153,6 +163,12 @@ duplicate the two topmost values on the stack. call the error handler (the address of which is in the variable `handler`) +### `again ( -- ) IMMEDIATE` +complete an infinite loop began by the word `begin`. + +### `allot ( u -- )` +reserve u bytes of user memory. + ### `and ( u1 u2 -- u )` perform bitwise AND on u1 and u2. @@ -160,6 +176,10 @@ perform bitwise AND on u1 and u2. a variable containing the current numeric input/output base. by default this is 10. +### `begin ( -- ) IMMEDIATE` +mark the beginning of a begin-again, begin-until, +or begin-while-repeat loop. + ### `binary ( -- )` set current base to binary. @@ -196,6 +216,9 @@ bytes are copied in high memory to low memory order. ### `d, ( n -- )` write a 32 bit value to user memory and increment the user memory pointer. +### `d! ( u a -- )` +store the 32 bit value u into the memory address a. + ### `decimal ( -- )` set current base to decimal. @@ -214,6 +237,11 @@ remove the value at the top of the stack. ### `dup ( u -- u u )` duplicate the value at the top of the stack. +### `else ( -- ) IMMEDIATE` +update the current if statement to branch here +when the flag is false, +and skip to `then` if the corresponding `if` was true. + ### `executable ( a u -- )` marks the u bytes starting at address a as executable. this is used primarily to mark the program break, @@ -222,11 +250,11 @@ which is used as the user memory space. ### `execute ( xt -- )` call the word xt. -### `find ( a u -- a u 0 | xt -1 )` +### `find ( a u -- a u 0 | a -1 )` look in the dictionary for the word a (of u characters). a zero is returned along with the original given string if no word was found. if a word was found, -its xt is returned along with the true flag. +its link field address is returned along with the true flag. ### `grow ( u -- )` grows, and marks as executable, the user memory space by u bytes. @@ -240,11 +268,15 @@ yields the address of the first available byte in user memory. ### `hex ( -- )` set current base to hexadecimal. +### `if ( ? -- ) IMMEDIATE` +if the flag is true, execute the following if statement, +terminated by `else` or `then`. + ### `immediate ( -- )` mark the most recently defined word as immediate. -### `immediate? ( xt -- ? )` -true if xt is marked immediate, false otherwise. +### `immediate? ( ht -- ? )` +true if ht is marked immediate, false otherwise. ### `interpret ( -- )` interprets the contents of the terminal input buffer @@ -265,9 +297,15 @@ convert given string into a number along with a flag. if parsing a number fails then 0 (false) is returned and no number is provided. +### `octal ( -- )` +set current base to octal. + ### `or ( u1 u2 -- u )` perform bitwise OR on u1 and u2. +### `over ( u1 u2 -- u1 u2 u1 )` +copy the second-highest value on the stack and move it to the top of the stack. + ### `parse ( "name<c>" c -- a u )` parse one word from the input buffer, separated by a newline or the character c, @@ -285,6 +323,9 @@ move a value from the return stack to the working stack. ### `rdrop ( R: u -- )` remove the value at the top of the return stack. +### `repeat ( -- ) IMMEDIATE` +in a begin-while-repeat loop, loop back to the condition. + ### `rot ( u1 u2 u3 -- u2 u3 u1 )` rotate the top three values on the stack so that the third highest value is moved to the top. @@ -318,17 +359,21 @@ perform the syscall with the id in `rax`, taking three parameters placed in `rdi`, `rsi` and `rdx`, and push the value of the `rax` register to the stack. +### `then ( -- ) IMMEDIATE` +conclude an if statement. + ### `tib ( -- a )` a variable containing the address of the current input buffer. ### `type ( a u -- )` write u characters at a to output. -### `octal ( -- )` -set current base to octal. +### `until ( ? -- ) IMMEDIATE` +if the given flag is true, loop back to `begin`. -### `over ( u1 u2 -- u1 u2 u1 )` -copy the second-highest value on the stack and move it to the top of the stack. +### `while ( ? -- ) IMMEDIATE` +if given flag is true, continue the current begin-while-repeat loop, +otherwise branch to after. ### `xor ( u1 u2 -- u )` perform bitwise XOR on u1 and u2. diff --git a/sanctuary.fs b/sanctuary.fs index 9ed0e61..4fe9f8c 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -5,4 +5,20 @@ : octal 8 base ! ; : decimal 10 base ! ; : hex 16 base ! ; + +: <mark here ; +: <resolve here 4 + - d, ; +: >mark here 0 d, ; +: >resolve dup here swap - 4 - swap d! ; + +: begin <mark ; immediate +: again branch <resolve ; immediate +: until ?branch <resolve ; immediate +: if ?branch >mark ; immediate ( I: -- a ) +: else branch >mark swap >resolve ; immediate +: then >resolve ; immediate +: while ?branch >mark ; immediate +: repeat branch swap <resolve >resolve ; immediate + +: allot here swap dp +! ; bye diff --git a/sanctuary.s b/sanctuary.s index 53749cc..7c47326 100644 --- a/sanctuary.s +++ b/sanctuary.s @@ -513,16 +513,11 @@ defcode "char", char, 0 pspush r11 ret -defcode "(execute)", do_execute, 0 +defcode "execute", execute, 0 pspop r11 call r11 ret -defcode "execute", execute, 0 - call to_body - call do_execute - ret - ; number {{{ defcode "number", number, 0 ; ( c-addr u -- ?n flag ) pspop r11 ; u @@ -720,6 +715,12 @@ defcode "!", store, 0 mov qword [r11], r12 ret +defcode "d!", dstore, 0 + pspop r11 + pspop r12 + mov dword [r11], r12d + ret + defcode "c!", cstore, 0 pspop r11 pspop r12 @@ -740,26 +741,26 @@ defcode "-!", minusstore, 0 defcode ",", comma, 0 pspop r11 - mov r12, [here] + mov r12, [dp] mov qword [r12], r11 add r12, 8 - mov qword [here], r12 + mov qword [dp], r12 ret defcode "d,", d_comma, 0 pspop r11 - mov r12, [here] + mov r12, [dp] mov dword [r12], r11d - inc r12 - mov qword [here], r12 + add r12, 4 + mov qword [dp], r12 ret defcode "c,", c_comma, 0 pspop r11 - mov r12, [here] + mov r12, [dp] mov byte [r12], r11b inc r12 - mov qword [here], r12 + mov qword [dp], r12 ret defcode "cmove", _cmove, 0 @@ -825,21 +826,21 @@ defcode "/mod", divmod, 0 defcode "and", _and, 0 pspop r11 - and [r14], r11 + and [r15], r11 ret defcode "or", _or, 0 pspop r11 - or [r14], r11 + or [r15], r11 ret defcode "xor", _xor, 0 pspop r11 - xor [r14], r11 + xor [r15], r11 ret defcode "invert", invert, 0 - not qword [r14] + not qword [r15] ret defcode "*/mod", starslashmod, 0 @@ -970,20 +971,24 @@ defcode "0>=", zero_greatereq, 0 ; }}} defcode "branch", branch, 0 - mov r12, [here] + mov r12, [dp] mov byte [r12], 0xe9 inc r12 - mov qword [here], r12 + mov qword [dp], r12 ret +; 4d 8b 1f mov r11, qword [r15] +; 4d 8d 7f 08 lea r15, [r15+8] +; 4d 85 db test r11, r11 +; 0f 84 [REL] je [REL] defcode "?branch", q_branch, 0 - mov r12, [here] - mov r11, 0x4d08768d4d1e8b4d ; pspop r11, first bit of test r11, r11 + mov r12, [dp] + mov r11, 0x4d087f8d4d1f8b4d mov qword [r12], r11 add r12, 8 - mov dword [r12], 0x840fdb85 ; rest of ^, je + mov dword [r12], 0x840fdb85 add r12, 4 - mov qword [here], r12 + mov qword [dp], r12 ret ; error handling {{{ |